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