| #!/usr/bin/perl -w |
| # |
| # Copyright (c) International Business Machines Corp., 2002 |
| # |
| # This program is free software; you can redistribute it and/or modify |
| # it under the terms of the GNU General Public License as published by |
| # the Free Software Foundation; either version 2 of the License, or (at |
| # your option) any later version. |
| # |
| # This program is distributed in the hope that it will be useful, but |
| # WITHOUT ANY WARRANTY; without even the implied warranty of |
| # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
| # General Public License for more details. |
| # |
| # You should have received a copy of the GNU General Public License |
| # along with this program; if not, write to the Free Software |
| # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA |
| # |
| # |
| # genpng |
| # |
| # This script creates an overview PNG image of a source code file by |
| # representing each source code character by a single pixel. |
| # |
| # Note that the Perl module GD.pm is required for this script to work. |
| # It may be obtained from http://www.cpan.org |
| # |
| # History: |
| # 2002-08-26: created by Peter Oberparleiter <Peter.Oberparleiter@de.ibm.com> |
| # |
| |
| use strict; |
| use File::Basename; |
| use Getopt::Long; |
| |
| |
| # Constants |
| our $lcov_version = 'LCOV version 1.10'; |
| our $lcov_url = "http://ltp.sourceforge.net/coverage/lcov.php"; |
| our $tool_name = basename($0); |
| |
| |
| # Prototypes |
| sub gen_png($$$@); |
| sub check_and_load_module($); |
| sub genpng_print_usage(*); |
| sub genpng_process_file($$$$); |
| sub genpng_warn_handler($); |
| sub genpng_die_handler($); |
| |
| |
| # |
| # Code entry point |
| # |
| |
| # Prettify version string |
| $lcov_version =~ s/\$\s*Revision\s*:?\s*(\S+)\s*\$/$1/; |
| |
| # Check whether required module GD.pm is installed |
| if (check_and_load_module("GD")) |
| { |
| # Note: cannot use die() to print this message because inserting this |
| # code into another script via do() would not fail as required! |
| print(STDERR <<END_OF_TEXT) |
| ERROR: required module GD.pm not found on this system (see www.cpan.org). |
| END_OF_TEXT |
| ; |
| exit(2); |
| } |
| |
| # Check whether we're called from the command line or from another script |
| if (!caller) |
| { |
| my $filename; |
| my $tab_size = 4; |
| my $width = 80; |
| my $out_filename; |
| my $help; |
| my $version; |
| |
| $SIG{__WARN__} = \&genpng_warn_handler; |
| $SIG{__DIE__} = \&genpng_die_handler; |
| |
| # Parse command line options |
| if (!GetOptions("tab-size=i" => \$tab_size, |
| "width=i" => \$width, |
| "output-filename=s" => \$out_filename, |
| "help" => \$help, |
| "version" => \$version)) |
| { |
| print(STDERR "Use $tool_name --help to get usage ". |
| "information\n"); |
| exit(1); |
| } |
| |
| $filename = $ARGV[0]; |
| |
| # Check for help flag |
| if ($help) |
| { |
| genpng_print_usage(*STDOUT); |
| exit(0); |
| } |
| |
| # Check for version flag |
| if ($version) |
| { |
| print("$tool_name: $lcov_version\n"); |
| exit(0); |
| } |
| |
| # Check options |
| if (!$filename) |
| { |
| die("No filename specified\n"); |
| } |
| |
| # Check for output filename |
| if (!$out_filename) |
| { |
| $out_filename = "$filename.png"; |
| } |
| |
| genpng_process_file($filename, $out_filename, $width, $tab_size); |
| exit(0); |
| } |
| |
| |
| # |
| # genpng_print_usage(handle) |
| # |
| # Write out command line usage information to given filehandle. |
| # |
| |
| sub genpng_print_usage(*) |
| { |
| local *HANDLE = $_[0]; |
| |
| print(HANDLE <<END_OF_USAGE) |
| Usage: $tool_name [OPTIONS] SOURCEFILE |
| |
| Create an overview image for a given source code file of either plain text |
| or .gcov file format. |
| |
| -h, --help Print this help, then exit |
| -v, --version Print version number, then exit |
| -t, --tab-size TABSIZE Use TABSIZE spaces in place of tab |
| -w, --width WIDTH Set width of output image to WIDTH pixel |
| -o, --output-filename FILENAME Write image to FILENAME |
| |
| For more information see: $lcov_url |
| END_OF_USAGE |
| ; |
| } |
| |
| |
| # |
| # check_and_load_module(module_name) |
| # |
| # Check whether a module by the given name is installed on this system |
| # and make it known to the interpreter if available. Return undefined if it |
| # is installed, an error message otherwise. |
| # |
| |
| sub check_and_load_module($) |
| { |
| eval("use $_[0];"); |
| return $@; |
| } |
| |
| |
| # |
| # genpng_process_file(filename, out_filename, width, tab_size) |
| # |
| |
| sub genpng_process_file($$$$) |
| { |
| my $filename = $_[0]; |
| my $out_filename = $_[1]; |
| my $width = $_[2]; |
| my $tab_size = $_[3]; |
| local *HANDLE; |
| my @source; |
| |
| open(HANDLE, "<", $filename) |
| or die("ERROR: cannot open $filename!\n"); |
| |
| # Check for .gcov filename extension |
| if ($filename =~ /^(.*).gcov$/) |
| { |
| # Assume gcov text format |
| while (<HANDLE>) |
| { |
| if (/^\t\t(.*)$/) |
| { |
| # Uninstrumented line |
| push(@source, ":$1"); |
| } |
| elsif (/^ ###### (.*)$/) |
| { |
| # Line with zero execution count |
| push(@source, "0:$1"); |
| } |
| elsif (/^( *)(\d*) (.*)$/) |
| { |
| # Line with positive execution count |
| push(@source, "$2:$3"); |
| } |
| } |
| } |
| else |
| { |
| # Plain text file |
| while (<HANDLE>) { push(@source, ":$_"); } |
| } |
| close(HANDLE); |
| |
| gen_png($out_filename, $width, $tab_size, @source); |
| } |
| |
| |
| # |
| # gen_png(filename, width, tab_size, source) |
| # |
| # Write an overview PNG file to FILENAME. Source code is defined by SOURCE |
| # which is a list of lines <count>:<source code> per source code line. |
| # The output image will be made up of one pixel per character of source, |
| # coloring will be done according to execution counts. WIDTH defines the |
| # image width. TAB_SIZE specifies the number of spaces to use as replacement |
| # string for tabulator signs in source code text. |
| # |
| # Die on error. |
| # |
| |
| sub gen_png($$$@) |
| { |
| my $filename = shift(@_); # Filename for PNG file |
| my $overview_width = shift(@_); # Imagewidth for image |
| my $tab_size = shift(@_); # Replacement string for tab signs |
| my @source = @_; # Source code as passed via argument 2 |
| my $height; # Height as define by source size |
| my $overview; # Source code overview image data |
| my $col_plain_back; # Color for overview background |
| my $col_plain_text; # Color for uninstrumented text |
| my $col_cov_back; # Color for background of covered lines |
| my $col_cov_text; # Color for text of covered lines |
| my $col_nocov_back; # Color for background of lines which |
| # were not covered (count == 0) |
| my $col_nocov_text; # Color for test of lines which were not |
| # covered (count == 0) |
| my $col_hi_back; # Color for background of highlighted lines |
| my $col_hi_text; # Color for text of highlighted lines |
| my $line; # Current line during iteration |
| my $row = 0; # Current row number during iteration |
| my $column; # Current column number during iteration |
| my $color_text; # Current text color during iteration |
| my $color_back; # Current background color during iteration |
| my $last_count; # Count of last processed line |
| my $count; # Count of current line |
| my $source; # Source code of current line |
| my $replacement; # Replacement string for tabulator chars |
| local *PNG_HANDLE; # Handle for output PNG file |
| |
| # Handle empty source files |
| if (!@source) { |
| @source = ( "" ); |
| } |
| $height = scalar(@source); |
| # Create image |
| $overview = new GD::Image($overview_width, $height) |
| or die("ERROR: cannot allocate overview image!\n"); |
| |
| # Define colors |
| $col_plain_back = $overview->colorAllocate(0xff, 0xff, 0xff); |
| $col_plain_text = $overview->colorAllocate(0xaa, 0xaa, 0xaa); |
| $col_cov_back = $overview->colorAllocate(0xaa, 0xa7, 0xef); |
| $col_cov_text = $overview->colorAllocate(0x5d, 0x5d, 0xea); |
| $col_nocov_back = $overview->colorAllocate(0xff, 0x00, 0x00); |
| $col_nocov_text = $overview->colorAllocate(0xaa, 0x00, 0x00); |
| $col_hi_back = $overview->colorAllocate(0x00, 0xff, 0x00); |
| $col_hi_text = $overview->colorAllocate(0x00, 0xaa, 0x00); |
| |
| # Visualize each line |
| foreach $line (@source) |
| { |
| # Replace tabs with spaces to keep consistent with source |
| # code view |
| while ($line =~ /^([^\t]*)(\t)/) |
| { |
| $replacement = " "x($tab_size - ((length($1) - 1) % |
| $tab_size)); |
| $line =~ s/^([^\t]*)(\t)/$1$replacement/; |
| } |
| |
| # Skip lines which do not follow the <count>:<line> |
| # specification, otherwise $1 = count, $2 = source code |
| if (!($line =~ /(\*?)(\d*):(.*)$/)) { next; } |
| $count = $2; |
| $source = $3; |
| |
| # Decide which color pair to use |
| |
| # If this line was not instrumented but the one before was, |
| # take the color of that line to widen color areas in |
| # resulting image |
| if (($count eq "") && defined($last_count) && |
| ($last_count ne "")) |
| { |
| $count = $last_count; |
| } |
| |
| if ($count eq "") |
| { |
| # Line was not instrumented |
| $color_text = $col_plain_text; |
| $color_back = $col_plain_back; |
| } |
| elsif ($count == 0) |
| { |
| # Line was instrumented but not executed |
| $color_text = $col_nocov_text; |
| $color_back = $col_nocov_back; |
| } |
| elsif ($1 eq "*") |
| { |
| # Line was highlighted |
| $color_text = $col_hi_text; |
| $color_back = $col_hi_back; |
| } |
| else |
| { |
| # Line was instrumented and executed |
| $color_text = $col_cov_text; |
| $color_back = $col_cov_back; |
| } |
| |
| # Write one pixel for each source character |
| $column = 0; |
| foreach (split("", $source)) |
| { |
| # Check for width |
| if ($column >= $overview_width) { last; } |
| |
| if ($_ eq " ") |
| { |
| # Space |
| $overview->setPixel($column++, $row, |
| $color_back); |
| } |
| else |
| { |
| # Text |
| $overview->setPixel($column++, $row, |
| $color_text); |
| } |
| } |
| |
| # Fill rest of line |
| while ($column < $overview_width) |
| { |
| $overview->setPixel($column++, $row, $color_back); |
| } |
| |
| $last_count = $2; |
| |
| $row++; |
| } |
| |
| # Write PNG file |
| open (PNG_HANDLE, ">", $filename) |
| or die("ERROR: cannot write png file $filename!\n"); |
| binmode(*PNG_HANDLE); |
| print(PNG_HANDLE $overview->png()); |
| close(PNG_HANDLE); |
| } |
| |
| sub genpng_warn_handler($) |
| { |
| my ($msg) = @_; |
| |
| warn("$tool_name: $msg"); |
| } |
| |
| sub genpng_die_handler($) |
| { |
| my ($msg) = @_; |
| |
| die("$tool_name: $msg"); |
| } |