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 32use strict; 33use File::Basename; 34use Getopt::Long; 35 36 37# Constants 38our $lcov_version = 'LCOV version 1.10'; 39our $lcov_url = "http://ltp.sourceforge.net/coverage/lcov.php"; 40our $tool_name = basename($0); 41 42 43# Prototypes 44sub gen_png($$$@); 45sub check_and_load_module($); 46sub genpng_print_usage(*); 47sub genpng_process_file($$$$); 48sub genpng_warn_handler($); 49sub 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 60if (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) 65ERROR: required module GD.pm not found on this system (see www.cpan.org). 66END_OF_TEXT 67 ; 68 exit(2); 69} 70 71# Check whether we're called from the command line or from another script 72if (!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 135sub genpng_print_usage(*) 136{ 137 local *HANDLE = $_[0]; 138 139 print(HANDLE <<END_OF_USAGE) 140Usage: $tool_name [OPTIONS] SOURCEFILE 141 142Create an overview image for a given source code file of either plain text 143or .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 151For more information see: $lcov_url 152END_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 165sub 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 176sub 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 235sub 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 377sub genpng_warn_handler($) 378{ 379 my ($msg) = @_; 380 381 warn("$tool_name: $msg"); 382} 383 384sub genpng_die_handler($) 385{ 386 my ($msg) = @_; 387 388 die("$tool_name: $msg"); 389} 390