genpng 9.5 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389
  1. #!/usr/bin/perl -w
  2. #
  3. # Copyright (c) International Business Machines Corp., 2002
  4. #
  5. # This program is free software; you can redistribute it and/or modify
  6. # it under the terms of the GNU General Public License as published by
  7. # the Free Software Foundation; either version 2 of the License, or (at
  8. # your option) any later version.
  9. #
  10. # This program is distributed in the hope that it will be useful, but
  11. # WITHOUT ANY WARRANTY; without even the implied warranty of
  12. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
  13. # General Public License for more details.
  14. #
  15. # You should have received a copy of the GNU General Public License
  16. # along with this program; if not, write to the Free Software
  17. # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
  18. #
  19. #
  20. # genpng
  21. #
  22. # This script creates an overview PNG image of a source code file by
  23. # representing each source code character by a single pixel.
  24. #
  25. # Note that the Perl module GD.pm is required for this script to work.
  26. # It may be obtained from http://www.cpan.org
  27. #
  28. # History:
  29. # 2002-08-26: created by Peter Oberparleiter <Peter.Oberparleiter@de.ibm.com>
  30. #
  31. use strict;
  32. use File::Basename;
  33. use Getopt::Long;
  34. # Constants
  35. our $lcov_version = 'LCOV version 1.10';
  36. our $lcov_url = "http://ltp.sourceforge.net/coverage/lcov.php";
  37. our $tool_name = basename($0);
  38. # Prototypes
  39. sub gen_png($$$@);
  40. sub check_and_load_module($);
  41. sub genpng_print_usage(*);
  42. sub genpng_process_file($$$$);
  43. sub genpng_warn_handler($);
  44. sub genpng_die_handler($);
  45. #
  46. # Code entry point
  47. #
  48. # Prettify version string
  49. $lcov_version =~ s/\$\s*Revision\s*:?\s*(\S+)\s*\$/$1/;
  50. # Check whether required module GD.pm is installed
  51. if (check_and_load_module("GD"))
  52. {
  53. # Note: cannot use die() to print this message because inserting this
  54. # code into another script via do() would not fail as required!
  55. print(STDERR <<END_OF_TEXT)
  56. ERROR: required module GD.pm not found on this system (see www.cpan.org).
  57. END_OF_TEXT
  58. ;
  59. exit(2);
  60. }
  61. # Check whether we're called from the command line or from another script
  62. if (!caller)
  63. {
  64. my $filename;
  65. my $tab_size = 4;
  66. my $width = 80;
  67. my $out_filename;
  68. my $help;
  69. my $version;
  70. $SIG{__WARN__} = \&genpng_warn_handler;
  71. $SIG{__DIE__} = \&genpng_die_handler;
  72. # Parse command line options
  73. if (!GetOptions("tab-size=i" => \$tab_size,
  74. "width=i" => \$width,
  75. "output-filename=s" => \$out_filename,
  76. "help" => \$help,
  77. "version" => \$version))
  78. {
  79. print(STDERR "Use $tool_name --help to get usage ".
  80. "information\n");
  81. exit(1);
  82. }
  83. $filename = $ARGV[0];
  84. # Check for help flag
  85. if ($help)
  86. {
  87. genpng_print_usage(*STDOUT);
  88. exit(0);
  89. }
  90. # Check for version flag
  91. if ($version)
  92. {
  93. print("$tool_name: $lcov_version\n");
  94. exit(0);
  95. }
  96. # Check options
  97. if (!$filename)
  98. {
  99. die("No filename specified\n");
  100. }
  101. # Check for output filename
  102. if (!$out_filename)
  103. {
  104. $out_filename = "$filename.png";
  105. }
  106. genpng_process_file($filename, $out_filename, $width, $tab_size);
  107. exit(0);
  108. }
  109. #
  110. # genpng_print_usage(handle)
  111. #
  112. # Write out command line usage information to given filehandle.
  113. #
  114. sub genpng_print_usage(*)
  115. {
  116. local *HANDLE = $_[0];
  117. print(HANDLE <<END_OF_USAGE)
  118. Usage: $tool_name [OPTIONS] SOURCEFILE
  119. Create an overview image for a given source code file of either plain text
  120. or .gcov file format.
  121. -h, --help Print this help, then exit
  122. -v, --version Print version number, then exit
  123. -t, --tab-size TABSIZE Use TABSIZE spaces in place of tab
  124. -w, --width WIDTH Set width of output image to WIDTH pixel
  125. -o, --output-filename FILENAME Write image to FILENAME
  126. For more information see: $lcov_url
  127. END_OF_USAGE
  128. ;
  129. }
  130. #
  131. # check_and_load_module(module_name)
  132. #
  133. # Check whether a module by the given name is installed on this system
  134. # and make it known to the interpreter if available. Return undefined if it
  135. # is installed, an error message otherwise.
  136. #
  137. sub check_and_load_module($)
  138. {
  139. eval("use $_[0];");
  140. return $@;
  141. }
  142. #
  143. # genpng_process_file(filename, out_filename, width, tab_size)
  144. #
  145. sub genpng_process_file($$$$)
  146. {
  147. my $filename = $_[0];
  148. my $out_filename = $_[1];
  149. my $width = $_[2];
  150. my $tab_size = $_[3];
  151. local *HANDLE;
  152. my @source;
  153. open(HANDLE, "<", $filename)
  154. or die("ERROR: cannot open $filename!\n");
  155. # Check for .gcov filename extension
  156. if ($filename =~ /^(.*).gcov$/)
  157. {
  158. # Assume gcov text format
  159. while (<HANDLE>)
  160. {
  161. if (/^\t\t(.*)$/)
  162. {
  163. # Uninstrumented line
  164. push(@source, ":$1");
  165. }
  166. elsif (/^ ###### (.*)$/)
  167. {
  168. # Line with zero execution count
  169. push(@source, "0:$1");
  170. }
  171. elsif (/^( *)(\d*) (.*)$/)
  172. {
  173. # Line with positive execution count
  174. push(@source, "$2:$3");
  175. }
  176. }
  177. }
  178. else
  179. {
  180. # Plain text file
  181. while (<HANDLE>) { push(@source, ":$_"); }
  182. }
  183. close(HANDLE);
  184. gen_png($out_filename, $width, $tab_size, @source);
  185. }
  186. #
  187. # gen_png(filename, width, tab_size, source)
  188. #
  189. # Write an overview PNG file to FILENAME. Source code is defined by SOURCE
  190. # which is a list of lines <count>:<source code> per source code line.
  191. # The output image will be made up of one pixel per character of source,
  192. # coloring will be done according to execution counts. WIDTH defines the
  193. # image width. TAB_SIZE specifies the number of spaces to use as replacement
  194. # string for tabulator signs in source code text.
  195. #
  196. # Die on error.
  197. #
  198. sub gen_png($$$@)
  199. {
  200. my $filename = shift(@_); # Filename for PNG file
  201. my $overview_width = shift(@_); # Imagewidth for image
  202. my $tab_size = shift(@_); # Replacement string for tab signs
  203. my @source = @_; # Source code as passed via argument 2
  204. my $height; # Height as define by source size
  205. my $overview; # Source code overview image data
  206. my $col_plain_back; # Color for overview background
  207. my $col_plain_text; # Color for uninstrumented text
  208. my $col_cov_back; # Color for background of covered lines
  209. my $col_cov_text; # Color for text of covered lines
  210. my $col_nocov_back; # Color for background of lines which
  211. # were not covered (count == 0)
  212. my $col_nocov_text; # Color for test of lines which were not
  213. # covered (count == 0)
  214. my $col_hi_back; # Color for background of highlighted lines
  215. my $col_hi_text; # Color for text of highlighted lines
  216. my $line; # Current line during iteration
  217. my $row = 0; # Current row number during iteration
  218. my $column; # Current column number during iteration
  219. my $color_text; # Current text color during iteration
  220. my $color_back; # Current background color during iteration
  221. my $last_count; # Count of last processed line
  222. my $count; # Count of current line
  223. my $source; # Source code of current line
  224. my $replacement; # Replacement string for tabulator chars
  225. local *PNG_HANDLE; # Handle for output PNG file
  226. # Handle empty source files
  227. if (!@source) {
  228. @source = ( "" );
  229. }
  230. $height = scalar(@source);
  231. # Create image
  232. $overview = new GD::Image($overview_width, $height)
  233. or die("ERROR: cannot allocate overview image!\n");
  234. # Define colors
  235. $col_plain_back = $overview->colorAllocate(0xff, 0xff, 0xff);
  236. $col_plain_text = $overview->colorAllocate(0xaa, 0xaa, 0xaa);
  237. $col_cov_back = $overview->colorAllocate(0xaa, 0xa7, 0xef);
  238. $col_cov_text = $overview->colorAllocate(0x5d, 0x5d, 0xea);
  239. $col_nocov_back = $overview->colorAllocate(0xff, 0x00, 0x00);
  240. $col_nocov_text = $overview->colorAllocate(0xaa, 0x00, 0x00);
  241. $col_hi_back = $overview->colorAllocate(0x00, 0xff, 0x00);
  242. $col_hi_text = $overview->colorAllocate(0x00, 0xaa, 0x00);
  243. # Visualize each line
  244. foreach $line (@source)
  245. {
  246. # Replace tabs with spaces to keep consistent with source
  247. # code view
  248. while ($line =~ /^([^\t]*)(\t)/)
  249. {
  250. $replacement = " "x($tab_size - ((length($1) - 1) %
  251. $tab_size));
  252. $line =~ s/^([^\t]*)(\t)/$1$replacement/;
  253. }
  254. # Skip lines which do not follow the <count>:<line>
  255. # specification, otherwise $1 = count, $2 = source code
  256. if (!($line =~ /(\*?)(\d*):(.*)$/)) { next; }
  257. $count = $2;
  258. $source = $3;
  259. # Decide which color pair to use
  260. # If this line was not instrumented but the one before was,
  261. # take the color of that line to widen color areas in
  262. # resulting image
  263. if (($count eq "") && defined($last_count) &&
  264. ($last_count ne ""))
  265. {
  266. $count = $last_count;
  267. }
  268. if ($count eq "")
  269. {
  270. # Line was not instrumented
  271. $color_text = $col_plain_text;
  272. $color_back = $col_plain_back;
  273. }
  274. elsif ($count == 0)
  275. {
  276. # Line was instrumented but not executed
  277. $color_text = $col_nocov_text;
  278. $color_back = $col_nocov_back;
  279. }
  280. elsif ($1 eq "*")
  281. {
  282. # Line was highlighted
  283. $color_text = $col_hi_text;
  284. $color_back = $col_hi_back;
  285. }
  286. else
  287. {
  288. # Line was instrumented and executed
  289. $color_text = $col_cov_text;
  290. $color_back = $col_cov_back;
  291. }
  292. # Write one pixel for each source character
  293. $column = 0;
  294. foreach (split("", $source))
  295. {
  296. # Check for width
  297. if ($column >= $overview_width) { last; }
  298. if ($_ eq " ")
  299. {
  300. # Space
  301. $overview->setPixel($column++, $row,
  302. $color_back);
  303. }
  304. else
  305. {
  306. # Text
  307. $overview->setPixel($column++, $row,
  308. $color_text);
  309. }
  310. }
  311. # Fill rest of line
  312. while ($column < $overview_width)
  313. {
  314. $overview->setPixel($column++, $row, $color_back);
  315. }
  316. $last_count = $2;
  317. $row++;
  318. }
  319. # Write PNG file
  320. open (PNG_HANDLE, ">", $filename)
  321. or die("ERROR: cannot write png file $filename!\n");
  322. binmode(*PNG_HANDLE);
  323. print(PNG_HANDLE $overview->png());
  324. close(PNG_HANDLE);
  325. }
  326. sub genpng_warn_handler($)
  327. {
  328. my ($msg) = @_;
  329. warn("$tool_name: $msg");
  330. }
  331. sub genpng_die_handler($)
  332. {
  333. my ($msg) = @_;
  334. die("$tool_name: $msg");
  335. }