Home | History | Annotate | Download | only in bin 
      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 (at] de.ibm.com>
     30 #
     31 
     32 use strict;
     33 use File::Basename; 
     34 use Getopt::Long;
     35 
     36 
     37 # Constants
     38 our $lcov_version	= 'LCOV version 1.10';
     39 our $lcov_url		= "http://ltp.sourceforge.net/coverage/lcov.php";
     40 our $tool_name		= basename($0);
     41 
     42 
     43 # Prototypes
     44 sub gen_png($$$@);
     45 sub check_and_load_module($);
     46 sub genpng_print_usage(*);
     47 sub genpng_process_file($$$$);
     48 sub genpng_warn_handler($);
     49 sub genpng_die_handler($);
     50 
     51 
     52 #
     53 # Code entry point
     54 #
     55 
     56 # Prettify version string
     57 $lcov_version =~ s/\$\s*Revision\s*:?\s*(\S+)\s*\$/$1/;
     58 
     59 # Check whether required module GD.pm is installed
     60 if (check_and_load_module("GD"))
     61 {
     62 	# Note: cannot use die() to print this message because inserting this
     63 	# code into another script via do() would not fail as required!
     64 	print(STDERR <<END_OF_TEXT)
     65 ERROR: required module GD.pm not found on this system (see www.cpan.org).
     66 END_OF_TEXT
     67 	;
     68 	exit(2);
     69 }
     70 
     71 # Check whether we're called from the command line or from another script
     72 if (!caller)
     73 {
     74 	my $filename;
     75 	my $tab_size = 4;
     76 	my $width = 80;
     77 	my $out_filename;
     78 	my $help;
     79 	my $version;
     80 
     81 	$SIG{__WARN__} = \&genpng_warn_handler;
     82 	$SIG{__DIE__} = \&genpng_die_handler;
     83 
     84 	# Parse command line options
     85 	if (!GetOptions("tab-size=i" => \$tab_size,
     86 			"width=i" => \$width,
     87 			"output-filename=s" => \$out_filename,
     88 			"help" => \$help,
     89 			"version" => \$version))
     90 	{
     91 		print(STDERR "Use $tool_name --help to get usage ".
     92 		      "information\n");
     93 		exit(1);
     94 	}
     95 
     96 	$filename = $ARGV[0];
     97 
     98 	# Check for help flag
     99 	if ($help)
    100 	{
    101 		genpng_print_usage(*STDOUT);
    102 		exit(0);
    103 	}
    104 
    105 	# Check for version flag
    106 	if ($version)
    107 	{
    108 		print("$tool_name: $lcov_version\n");
    109 		exit(0);
    110 	}
    111 
    112 	# Check options
    113 	if (!$filename)
    114 	{
    115 		die("No filename specified\n");
    116 	}
    117 
    118 	# Check for output filename
    119 	if (!$out_filename)
    120 	{
    121 		$out_filename = "$filename.png";
    122 	}
    123 
    124 	genpng_process_file($filename, $out_filename, $width, $tab_size);
    125 	exit(0);
    126 }
    127 
    128 
    129 #
    130 # genpng_print_usage(handle)
    131 #
    132 # Write out command line usage information to given filehandle.
    133 #
    134 
    135 sub genpng_print_usage(*)
    136 {
    137 	local *HANDLE = $_[0];
    138 
    139 	print(HANDLE <<END_OF_USAGE)
    140 Usage: $tool_name [OPTIONS] SOURCEFILE
    141 
    142 Create an overview image for a given source code file of either plain text
    143 or .gcov file format.
    144 
    145   -h, --help                        Print this help, then exit
    146   -v, --version                     Print version number, then exit
    147   -t, --tab-size TABSIZE            Use TABSIZE spaces in place of tab
    148   -w, --width WIDTH                 Set width of output image to WIDTH pixel
    149   -o, --output-filename FILENAME    Write image to FILENAME
    150 
    151 For more information see: $lcov_url
    152 END_OF_USAGE
    153 	;
    154 }
    155 
    156 
    157 #
    158 # check_and_load_module(module_name)
    159 #
    160 # Check whether a module by the given name is installed on this system
    161 # and make it known to the interpreter if available. Return undefined if it
    162 # is installed, an error message otherwise.
    163 #
    164 
    165 sub check_and_load_module($)
    166 {
    167 	eval("use $_[0];");
    168 	return $@;
    169 }
    170 
    171 
    172 #
    173 # genpng_process_file(filename, out_filename, width, tab_size)
    174 #
    175 
    176 sub genpng_process_file($$$$)
    177 {
    178 	my $filename		= $_[0];
    179 	my $out_filename	= $_[1];
    180 	my $width		= $_[2];
    181 	my $tab_size		= $_[3];
    182 	local *HANDLE;
    183 	my @source;
    184 
    185 	open(HANDLE, "<", $filename)
    186 		or die("ERROR: cannot open $filename!\n");
    187 
    188 	# Check for .gcov filename extension
    189 	if ($filename =~ /^(.*).gcov$/)
    190 	{
    191 		# Assume gcov text format
    192 		while (<HANDLE>)
    193 		{
    194 			if (/^\t\t(.*)$/)
    195 			{
    196 				# Uninstrumented line
    197 				push(@source, ":$1");
    198 			}
    199 			elsif (/^      ######    (.*)$/)
    200 			{
    201 				# Line with zero execution count
    202 				push(@source, "0:$1");
    203 			}
    204 			elsif (/^( *)(\d*)    (.*)$/)
    205 			{
    206 				# Line with positive execution count
    207 				push(@source, "$2:$3");
    208 			}
    209 		}
    210 	}
    211 	else
    212 	{
    213 		# Plain text file
    214 		while (<HANDLE>) { push(@source, ":$_"); }
    215 	}
    216 	close(HANDLE);
    217 
    218 	gen_png($out_filename, $width, $tab_size, @source);
    219 }
    220 
    221 
    222 #
    223 # gen_png(filename, width, tab_size, source)
    224 #
    225 # Write an overview PNG file to FILENAME. Source code is defined by SOURCE
    226 # which is a list of lines <count>:<source code> per source code line.
    227 # The output image will be made up of one pixel per character of source,
    228 # coloring will be done according to execution counts. WIDTH defines the
    229 # image width. TAB_SIZE specifies the number of spaces to use as replacement
    230 # string for tabulator signs in source code text.
    231 #
    232 # Die on error.
    233 #
    234 
    235 sub gen_png($$$@)
    236 {
    237 	my $filename = shift(@_);	# Filename for PNG file
    238 	my $overview_width = shift(@_);	# Imagewidth for image
    239 	my $tab_size = shift(@_);	# Replacement string for tab signs
    240 	my @source = @_;	# Source code as passed via argument 2
    241 	my $height;		# Height as define by source size
    242 	my $overview;		# Source code overview image data
    243 	my $col_plain_back;	# Color for overview background
    244 	my $col_plain_text;	# Color for uninstrumented text
    245 	my $col_cov_back;	# Color for background of covered lines
    246 	my $col_cov_text;	# Color for text of covered lines
    247 	my $col_nocov_back;	# Color for background of lines which
    248 				# were not covered (count == 0)
    249 	my $col_nocov_text;	# Color for test of lines which were not
    250 				# covered (count == 0)
    251 	my $col_hi_back;	# Color for background of highlighted lines
    252 	my $col_hi_text;	# Color for text of highlighted lines
    253 	my $line;		# Current line during iteration
    254 	my $row = 0;		# Current row number during iteration
    255 	my $column;		# Current column number during iteration
    256 	my $color_text;		# Current text color during iteration
    257 	my $color_back;		# Current background color during iteration
    258 	my $last_count;		# Count of last processed line
    259 	my $count;		# Count of current line
    260 	my $source;		# Source code of current line
    261 	my $replacement;	# Replacement string for tabulator chars
    262 	local *PNG_HANDLE;	# Handle for output PNG file
    263 
    264 	# Handle empty source files
    265 	if (!@source) {
    266 		@source = ( "" );
    267 	}
    268 	$height = scalar(@source);
    269 	# Create image
    270 	$overview = new GD::Image($overview_width, $height)
    271 		or die("ERROR: cannot allocate overview image!\n");
    272 
    273 	# Define colors
    274 	$col_plain_back	= $overview->colorAllocate(0xff, 0xff, 0xff);
    275 	$col_plain_text	= $overview->colorAllocate(0xaa, 0xaa, 0xaa);
    276 	$col_cov_back	= $overview->colorAllocate(0xaa, 0xa7, 0xef);
    277 	$col_cov_text	= $overview->colorAllocate(0x5d, 0x5d, 0xea);
    278 	$col_nocov_back = $overview->colorAllocate(0xff, 0x00, 0x00);
    279 	$col_nocov_text = $overview->colorAllocate(0xaa, 0x00, 0x00);
    280 	$col_hi_back = $overview->colorAllocate(0x00, 0xff, 0x00);
    281 	$col_hi_text = $overview->colorAllocate(0x00, 0xaa, 0x00);
    282 
    283 	# Visualize each line
    284 	foreach $line (@source)
    285 	{
    286 		# Replace tabs with spaces to keep consistent with source
    287 		# code view
    288 		while ($line =~ /^([^\t]*)(\t)/)
    289 		{
    290 			$replacement = " "x($tab_size - ((length($1) - 1) %
    291 				       $tab_size));
    292 			$line =~ s/^([^\t]*)(\t)/$1$replacement/;
    293 		}
    294 
    295 		# Skip lines which do not follow the <count>:<line>
    296 		# specification, otherwise $1 = count, $2 = source code
    297 		if (!($line =~ /(\*?)(\d*):(.*)$/)) { next; }
    298 		$count = $2;
    299 		$source = $3;
    300 
    301 		# Decide which color pair to use
    302 
    303 		# If this line was not instrumented but the one before was,
    304 		# take the color of that line to widen color areas in
    305 		# resulting image
    306 		if (($count eq "") && defined($last_count) &&
    307 		    ($last_count ne ""))
    308 		{
    309 			$count = $last_count;
    310 		}
    311 
    312 		if ($count eq "")
    313 		{
    314 			# Line was not instrumented
    315 			$color_text = $col_plain_text;
    316 			$color_back = $col_plain_back;
    317 		}
    318 		elsif ($count == 0)
    319 		{
    320 			# Line was instrumented but not executed
    321 			$color_text = $col_nocov_text;
    322 			$color_back = $col_nocov_back;
    323 		}
    324 		elsif ($1 eq "*")
    325 		{
    326 			# Line was highlighted
    327 			$color_text = $col_hi_text;
    328 			$color_back = $col_hi_back;
    329 		}
    330 		else
    331 		{
    332 			# Line was instrumented and executed
    333 			$color_text = $col_cov_text;
    334 			$color_back = $col_cov_back;
    335 		}
    336 
    337 		# Write one pixel for each source character
    338 		$column = 0;
    339 		foreach (split("", $source))
    340 		{
    341 			# Check for width
    342 			if ($column >= $overview_width) { last; }
    343 
    344 			if ($_ eq " ")
    345 			{
    346 				# Space
    347 				$overview->setPixel($column++, $row,
    348 						    $color_back);
    349 			}
    350 			else
    351 			{
    352 				# Text
    353 				$overview->setPixel($column++, $row,
    354 						    $color_text);
    355 			}
    356 		}
    357 
    358 		# Fill rest of line		
    359 		while ($column < $overview_width)
    360 		{
    361 			$overview->setPixel($column++, $row, $color_back);
    362 		}
    363 
    364 		$last_count = $2;
    365 
    366 		$row++;
    367 	}
    368 
    369 	# Write PNG file
    370 	open (PNG_HANDLE, ">", $filename)
    371 		or die("ERROR: cannot write png file $filename!\n");
    372 	binmode(*PNG_HANDLE);
    373 	print(PNG_HANDLE $overview->png());
    374 	close(PNG_HANDLE);
    375 }
    376 
    377 sub genpng_warn_handler($)
    378 {
    379 	my ($msg) = @_;
    380 
    381 	warn("$tool_name: $msg");
    382 }
    383 
    384 sub genpng_die_handler($)
    385 {
    386 	my ($msg) = @_;
    387 
    388 	die("$tool_name: $msg");
    389 }
    390