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