| OLD | NEW | 
|---|
| 1 #!/usr/bin/perl -w | 1 #!/usr/bin/perl -w | 
| 2 # | 2 # | 
| 3 #   Copyright (c) International Business Machines  Corp., 2002 | 3 #   Copyright (c) International Business Machines  Corp., 2002 | 
| 4 # | 4 # | 
| 5 #   This program is free software;  you can redistribute it and/or modify | 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 | 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 | 7 #   the Free Software Foundation; either version 2 of the License, or (at | 
| 8 #   your option) any later version. | 8 #   your option) any later version. | 
| 9 # | 9 # | 
| 10 #   This program is distributed in the hope that it will be useful, but | 10 #   This program is distributed in the hope that it will be useful, but | 
| 11 #   WITHOUT ANY WARRANTY;  without even the implied warranty of | 11 #   WITHOUT ANY WARRANTY;  without even the implied warranty of | 
| 12 #   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU | 12 #   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU | 
| 13 #   General Public License for more details. | 13 #   General Public License for more details. | 
| 14 # | 14 # | 
| 15 #   You should have received a copy of the GNU General Public License | 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 | 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 | 17 #   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA | 
| 18 # | 18 # | 
| 19 # | 19 # | 
| 20 # genpng | 20 # genpng | 
| 21 # | 21 # | 
| 22 #   This script creates an overview PNG image of a source code file by | 22 #   This script creates an overview PNG image of a source code file by | 
| 23 #   representing each source code character by a single pixel. | 23 #   representing each source code character by a single pixel. | 
| 24 # | 24 # | 
| 25 #   Note that the PERL module GD.pm is required for this script to work. | 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 | 26 #   It may be obtained from http://www.cpan.org | 
| 27 # | 27 # | 
| 28 # History: | 28 # History: | 
| 29 #   2002-08-26: created by Peter Oberparleiter <Peter.Oberparleiter@de.ibm.com> | 29 #   2002-08-26: created by Peter Oberparleiter <Peter.Oberparleiter@de.ibm.com> | 
| 30 # | 30 # | 
| 31 | 31 | 
| 32 use strict; | 32 use strict; | 
| 33 use File::Basename; | 33 use File::Basename; | 
| 34 use Getopt::Long; | 34 use Getopt::Long; | 
| 35 | 35 | 
| 36 | 36 | 
| 37 # Constants | 37 # Constants | 
| 38 our $lcov_version»      = "LCOV version 1.7"; | 38 our $lcov_version»      = 'LCOV version 1.10'; | 
| 39 our $lcov_url           = "http://ltp.sourceforge.net/coverage/lcov.php"; | 39 our $lcov_url           = "http://ltp.sourceforge.net/coverage/lcov.php"; | 
| 40 our $tool_name          = basename($0); | 40 our $tool_name          = basename($0); | 
| 41 | 41 | 
| 42 | 42 | 
| 43 # Prototypes | 43 # Prototypes | 
| 44 sub gen_png($$$@); | 44 sub gen_png($$$@); | 
| 45 sub check_and_load_module($); | 45 sub check_and_load_module($); | 
| 46 sub genpng_print_usage(*); | 46 sub genpng_print_usage(*); | 
| 47 sub genpng_process_file($$$$); | 47 sub genpng_process_file($$$$); | 
| 48 sub warn_handler($); | 48 sub genpng_warn_handler($); | 
| 49 sub die_handler($); | 49 sub genpng_die_handler($); | 
| 50 | 50 | 
| 51 | 51 | 
| 52 # | 52 # | 
| 53 # Code entry point | 53 # Code entry point | 
| 54 # | 54 # | 
| 55 | 55 | 
|  | 56 # Prettify version string | 
|  | 57 $lcov_version =~ s/\$\s*Revision\s*:?\s*(\S+)\s*\$/$1/; | 
|  | 58 | 
| 56 # Check whether required module GD.pm is installed | 59 # Check whether required module GD.pm is installed | 
| 57 if (check_and_load_module("GD")) | 60 if (check_and_load_module("GD")) | 
| 58 { | 61 { | 
| 59         # Note: cannot use die() to print this message because inserting this | 62         # Note: cannot use die() to print this message because inserting this | 
| 60         # code into another script via do() would not fail as required! | 63         # code into another script via do() would not fail as required! | 
| 61         print(STDERR <<END_OF_TEXT) | 64         print(STDERR <<END_OF_TEXT) | 
| 62 ERROR: required module GD.pm not found on this system (see www.cpan.org). | 65 ERROR: required module GD.pm not found on this system (see www.cpan.org). | 
| 63 END_OF_TEXT | 66 END_OF_TEXT | 
| 64         ; | 67         ; | 
| 65         exit(2); | 68         exit(2); | 
| 66 } | 69 } | 
| 67 | 70 | 
| 68 # Check whether we're called from the command line or from another script | 71 # Check whether we're called from the command line or from another script | 
| 69 if (!caller) | 72 if (!caller) | 
| 70 { | 73 { | 
| 71         my $filename; | 74         my $filename; | 
| 72         my $tab_size = 4; | 75         my $tab_size = 4; | 
| 73         my $width = 80; | 76         my $width = 80; | 
| 74         my $out_filename; | 77         my $out_filename; | 
| 75         my $help; | 78         my $help; | 
| 76         my $version; | 79         my $version; | 
| 77 | 80 | 
| 78 »       $SIG{__WARN__} = \&warn_handler; | 81 »       $SIG{__WARN__} = \&genpng_warn_handler; | 
| 79 »       $SIG{__DIE__} = \&die_handler; | 82 »       $SIG{__DIE__} = \&genpng_die_handler; | 
| 80 | 83 | 
| 81         # Parse command line options | 84         # Parse command line options | 
| 82         if (!GetOptions("tab-size=i" => \$tab_size, | 85         if (!GetOptions("tab-size=i" => \$tab_size, | 
| 83                         "width=i" => \$width, | 86                         "width=i" => \$width, | 
| 84                         "output-filename=s" => \$out_filename, | 87                         "output-filename=s" => \$out_filename, | 
| 85                         "help" => \$help, | 88                         "help" => \$help, | 
| 86                         "version" => \$version)) | 89                         "version" => \$version)) | 
| 87         { | 90         { | 
| 88                 print(STDERR "Use $tool_name --help to get usage ". | 91                 print(STDERR "Use $tool_name --help to get usage ". | 
| 89                       "information\n"); | 92                       "information\n"); | 
| (...skipping 82 matching lines...) Expand 10 before | Expand all | Expand 10 after  Loading... | 
| 172 | 175 | 
| 173 sub genpng_process_file($$$$) | 176 sub genpng_process_file($$$$) | 
| 174 { | 177 { | 
| 175         my $filename            = $_[0]; | 178         my $filename            = $_[0]; | 
| 176         my $out_filename        = $_[1]; | 179         my $out_filename        = $_[1]; | 
| 177         my $width               = $_[2]; | 180         my $width               = $_[2]; | 
| 178         my $tab_size            = $_[3]; | 181         my $tab_size            = $_[3]; | 
| 179         local *HANDLE; | 182         local *HANDLE; | 
| 180         my @source; | 183         my @source; | 
| 181 | 184 | 
| 182 »       open(HANDLE, "<$filename") | 185 »       open(HANDLE, "<", $filename) | 
| 183                 or die("ERROR: cannot open $filename!\n"); | 186                 or die("ERROR: cannot open $filename!\n"); | 
| 184 | 187 | 
| 185         # Check for .gcov filename extension | 188         # Check for .gcov filename extension | 
| 186         if ($filename =~ /^(.*).gcov$/) | 189         if ($filename =~ /^(.*).gcov$/) | 
| 187         { | 190         { | 
| 188                 # Assume gcov text format | 191                 # Assume gcov text format | 
| 189                 while (<HANDLE>) | 192                 while (<HANDLE>) | 
| 190                 { | 193                 { | 
| 191                         if (/^\t\t(.*)$/) | 194                         if (/^\t\t(.*)$/) | 
| 192                         { | 195                         { | 
| (...skipping 35 matching lines...) Expand 10 before | Expand all | Expand 10 after  Loading... | 
| 228 # | 231 # | 
| 229 # Die on error. | 232 # Die on error. | 
| 230 # | 233 # | 
| 231 | 234 | 
| 232 sub gen_png($$$@) | 235 sub gen_png($$$@) | 
| 233 { | 236 { | 
| 234         my $filename = shift(@_);       # Filename for PNG file | 237         my $filename = shift(@_);       # Filename for PNG file | 
| 235         my $overview_width = shift(@_); # Imagewidth for image | 238         my $overview_width = shift(@_); # Imagewidth for image | 
| 236         my $tab_size = shift(@_);       # Replacement string for tab signs | 239         my $tab_size = shift(@_);       # Replacement string for tab signs | 
| 237         my @source = @_;        # Source code as passed via argument 2 | 240         my @source = @_;        # Source code as passed via argument 2 | 
| 238 »       my $height = scalar(@source);»  # Height as define by source size | 241 »       my $height;»    »       # Height as define by source size | 
| 239         my $overview;           # Source code overview image data | 242         my $overview;           # Source code overview image data | 
| 240         my $col_plain_back;     # Color for overview background | 243         my $col_plain_back;     # Color for overview background | 
| 241         my $col_plain_text;     # Color for uninstrumented text | 244         my $col_plain_text;     # Color for uninstrumented text | 
| 242         my $col_cov_back;       # Color for background of covered lines | 245         my $col_cov_back;       # Color for background of covered lines | 
| 243         my $col_cov_text;       # Color for text of covered lines | 246         my $col_cov_text;       # Color for text of covered lines | 
| 244         my $col_nocov_back;     # Color for background of lines which | 247         my $col_nocov_back;     # Color for background of lines which | 
| 245                                 # were not covered (count == 0) | 248                                 # were not covered (count == 0) | 
| 246         my $col_nocov_text;     # Color for test of lines which were not | 249         my $col_nocov_text;     # Color for test of lines which were not | 
| 247                                 # covered (count == 0) | 250                                 # covered (count == 0) | 
| 248         my $col_hi_back;        # Color for background of highlighted lines | 251         my $col_hi_back;        # Color for background of highlighted lines | 
| 249         my $col_hi_text;        # Color for text of highlighted lines | 252         my $col_hi_text;        # Color for text of highlighted lines | 
| 250         my $line;               # Current line during iteration | 253         my $line;               # Current line during iteration | 
| 251         my $row = 0;            # Current row number during iteration | 254         my $row = 0;            # Current row number during iteration | 
| 252         my $column;             # Current column number during iteration | 255         my $column;             # Current column number during iteration | 
| 253         my $color_text;         # Current text color during iteration | 256         my $color_text;         # Current text color during iteration | 
| 254         my $color_back;         # Current background color during iteration | 257         my $color_back;         # Current background color during iteration | 
| 255         my $last_count;         # Count of last processed line | 258         my $last_count;         # Count of last processed line | 
| 256         my $count;              # Count of current line | 259         my $count;              # Count of current line | 
| 257         my $source;             # Source code of current line | 260         my $source;             # Source code of current line | 
| 258         my $replacement;        # Replacement string for tabulator chars | 261         my $replacement;        # Replacement string for tabulator chars | 
| 259         local *PNG_HANDLE;      # Handle for output PNG file | 262         local *PNG_HANDLE;      # Handle for output PNG file | 
| 260 | 263 | 
|  | 264         # Handle empty source files | 
|  | 265         if (!@source) { | 
|  | 266                 @source = ( "" ); | 
|  | 267         } | 
|  | 268         $height = scalar(@source); | 
| 261         # Create image | 269         # Create image | 
| 262         $overview = new GD::Image($overview_width, $height) | 270         $overview = new GD::Image($overview_width, $height) | 
| 263                 or die("ERROR: cannot allocate overview image!\n"); | 271                 or die("ERROR: cannot allocate overview image!\n"); | 
| 264 | 272 | 
| 265         # Define colors | 273         # Define colors | 
| 266         $col_plain_back = $overview->colorAllocate(0xff, 0xff, 0xff); | 274         $col_plain_back = $overview->colorAllocate(0xff, 0xff, 0xff); | 
| 267         $col_plain_text = $overview->colorAllocate(0xaa, 0xaa, 0xaa); | 275         $col_plain_text = $overview->colorAllocate(0xaa, 0xaa, 0xaa); | 
| 268         $col_cov_back   = $overview->colorAllocate(0xaa, 0xa7, 0xef); | 276         $col_cov_back   = $overview->colorAllocate(0xaa, 0xa7, 0xef); | 
| 269         $col_cov_text   = $overview->colorAllocate(0x5d, 0x5d, 0xea); | 277         $col_cov_text   = $overview->colorAllocate(0x5d, 0x5d, 0xea); | 
| 270         $col_nocov_back = $overview->colorAllocate(0xff, 0x00, 0x00); | 278         $col_nocov_back = $overview->colorAllocate(0xff, 0x00, 0x00); | 
| (...skipping 81 matching lines...) Expand 10 before | Expand all | Expand 10 after  Loading... | 
| 352                 { | 360                 { | 
| 353                         $overview->setPixel($column++, $row, $color_back); | 361                         $overview->setPixel($column++, $row, $color_back); | 
| 354                 } | 362                 } | 
| 355 | 363 | 
| 356                 $last_count = $2; | 364                 $last_count = $2; | 
| 357 | 365 | 
| 358                 $row++; | 366                 $row++; | 
| 359         } | 367         } | 
| 360 | 368 | 
| 361         # Write PNG file | 369         # Write PNG file | 
| 362 »       open (PNG_HANDLE, ">$filename") | 370 »       open (PNG_HANDLE, ">", $filename) | 
| 363                 or die("ERROR: cannot write png file $filename!\n"); | 371                 or die("ERROR: cannot write png file $filename!\n"); | 
| 364         binmode(*PNG_HANDLE); | 372         binmode(*PNG_HANDLE); | 
| 365         print(PNG_HANDLE $overview->png()); | 373         print(PNG_HANDLE $overview->png()); | 
| 366         close(PNG_HANDLE); | 374         close(PNG_HANDLE); | 
| 367 } | 375 } | 
| 368 | 376 | 
| 369 sub warn_handler($) | 377 sub genpng_warn_handler($) | 
| 370 { | 378 { | 
| 371         my ($msg) = @_; | 379         my ($msg) = @_; | 
| 372 | 380 | 
| 373         warn("$tool_name: $msg"); | 381         warn("$tool_name: $msg"); | 
| 374 } | 382 } | 
| 375 | 383 | 
| 376 sub die_handler($) | 384 sub genpng_die_handler($) | 
| 377 { | 385 { | 
| 378         my ($msg) = @_; | 386         my ($msg) = @_; | 
| 379 | 387 | 
| 380         die("$tool_name: $msg"); | 388         die("$tool_name: $msg"); | 
| 381 } | 389 } | 
| OLD | NEW | 
|---|