15821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#!/usr/bin/perl -w
25821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#
35821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#   Copyright (c) International Business Machines  Corp., 2002
45821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#
55821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#   This program is free software;  you can redistribute it and/or modify
65821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#   it under the terms of the GNU General Public License as published by
75821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#   the Free Software Foundation; either version 2 of the License, or (at
85821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#   your option) any later version.
95821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#
105821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#   This program is distributed in the hope that it will be useful, but
115821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#   WITHOUT ANY WARRANTY;  without even the implied warranty of
125821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
135821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#   General Public License for more details.                 
145821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#
155821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#   You should have received a copy of the GNU General Public License
165821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#   along with this program;  if not, write to the Free Software
175821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
185821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#
195821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#
205821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)# genpng
215821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#
225821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#   This script creates an overview PNG image of a source code file by
235821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#   representing each source code character by a single pixel.
245821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#
253551c9c881056c480085172ff9840cab31610854Torne (Richard Coles)#   Note that the Perl module GD.pm is required for this script to work.
265821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#   It may be obtained from http://www.cpan.org
275821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#
285821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)# History:
295821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#   2002-08-26: created by Peter Oberparleiter <Peter.Oberparleiter@de.ibm.com>
305821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#
315821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)
325821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)use strict;
335821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)use File::Basename; 
345821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)use Getopt::Long;
355821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)
365821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)
375821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)# Constants
383551c9c881056c480085172ff9840cab31610854Torne (Richard Coles)our $lcov_version	= 'LCOV version 1.10';
395821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)our $lcov_url		= "http://ltp.sourceforge.net/coverage/lcov.php";
405821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)our $tool_name		= basename($0);
415821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)
425821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)
435821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)# Prototypes
445821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)sub gen_png($$$@);
455821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)sub check_and_load_module($);
465821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)sub genpng_print_usage(*);
475821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)sub genpng_process_file($$$$);
483551c9c881056c480085172ff9840cab31610854Torne (Richard Coles)sub genpng_warn_handler($);
493551c9c881056c480085172ff9840cab31610854Torne (Richard Coles)sub genpng_die_handler($);
505821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)
515821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)
525821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#
535821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)# Code entry point
545821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#
555821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)
563551c9c881056c480085172ff9840cab31610854Torne (Richard Coles)# Prettify version string
573551c9c881056c480085172ff9840cab31610854Torne (Richard Coles)$lcov_version =~ s/\$\s*Revision\s*:?\s*(\S+)\s*\$/$1/;
583551c9c881056c480085172ff9840cab31610854Torne (Richard Coles)
595821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)# Check whether required module GD.pm is installed
605821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)if (check_and_load_module("GD"))
615821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles){
625821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	# Note: cannot use die() to print this message because inserting this
635821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	# code into another script via do() would not fail as required!
645821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	print(STDERR <<END_OF_TEXT)
655821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)ERROR: required module GD.pm not found on this system (see www.cpan.org).
665821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)END_OF_TEXT
675821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	;
685821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	exit(2);
695821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)}
705821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)
715821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)# Check whether we're called from the command line or from another script
725821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)if (!caller)
735821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles){
745821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	my $filename;
755821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	my $tab_size = 4;
765821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	my $width = 80;
775821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	my $out_filename;
785821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	my $help;
795821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	my $version;
805821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)
813551c9c881056c480085172ff9840cab31610854Torne (Richard Coles)	$SIG{__WARN__} = \&genpng_warn_handler;
823551c9c881056c480085172ff9840cab31610854Torne (Richard Coles)	$SIG{__DIE__} = \&genpng_die_handler;
835821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)
845821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	# Parse command line options
855821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	if (!GetOptions("tab-size=i" => \$tab_size,
865821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)			"width=i" => \$width,
875821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)			"output-filename=s" => \$out_filename,
885821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)			"help" => \$help,
895821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)			"version" => \$version))
905821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	{
915821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)		print(STDERR "Use $tool_name --help to get usage ".
925821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)		      "information\n");
935821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)		exit(1);
945821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	}
955821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)
965821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	$filename = $ARGV[0];
975821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)
985821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	# Check for help flag
995821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	if ($help)
1005821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	{
1015821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)		genpng_print_usage(*STDOUT);
1025821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)		exit(0);
1035821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	}
1045821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)
1055821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	# Check for version flag
1065821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	if ($version)
1075821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	{
1085821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)		print("$tool_name: $lcov_version\n");
1095821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)		exit(0);
1105821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	}
1115821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)
1125821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	# Check options
1135821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	if (!$filename)
1145821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	{
1155821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)		die("No filename specified\n");
1165821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	}
1175821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)
1185821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	# Check for output filename
1195821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	if (!$out_filename)
1205821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	{
1215821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)		$out_filename = "$filename.png";
1225821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	}
1235821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)
1245821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	genpng_process_file($filename, $out_filename, $width, $tab_size);
1255821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	exit(0);
1265821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)}
1275821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)
1285821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)
1295821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#
1305821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)# genpng_print_usage(handle)
1315821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#
1325821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)# Write out command line usage information to given filehandle.
1335821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#
1345821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)
1355821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)sub genpng_print_usage(*)
1365821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles){
1375821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	local *HANDLE = $_[0];
1385821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)
1395821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	print(HANDLE <<END_OF_USAGE)
1405821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)Usage: $tool_name [OPTIONS] SOURCEFILE
1415821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)
1425821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)Create an overview image for a given source code file of either plain text
1435821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)or .gcov file format.
1445821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)
1455821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)  -h, --help                        Print this help, then exit
1465821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)  -v, --version                     Print version number, then exit
1475821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)  -t, --tab-size TABSIZE            Use TABSIZE spaces in place of tab
1485821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)  -w, --width WIDTH                 Set width of output image to WIDTH pixel
1495821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)  -o, --output-filename FILENAME    Write image to FILENAME
1505821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)
1515821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)For more information see: $lcov_url
1525821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)END_OF_USAGE
1535821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	;
1545821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)}
1555821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)
1565821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)
1575821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#
1585821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)# check_and_load_module(module_name)
1595821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#
1605821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)# Check whether a module by the given name is installed on this system
1615821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)# and make it known to the interpreter if available. Return undefined if it
1625821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)# is installed, an error message otherwise.
1635821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#
1645821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)
1655821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)sub check_and_load_module($)
1665821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles){
1675821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	eval("use $_[0];");
1685821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	return $@;
1695821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)}
1705821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)
1715821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)
1725821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#
1735821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)# genpng_process_file(filename, out_filename, width, tab_size)
1745821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#
1755821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)
1765821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)sub genpng_process_file($$$$)
1775821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles){
1785821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	my $filename		= $_[0];
1795821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	my $out_filename	= $_[1];
1805821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	my $width		= $_[2];
1815821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	my $tab_size		= $_[3];
1825821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	local *HANDLE;
1835821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	my @source;
1845821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)
1853551c9c881056c480085172ff9840cab31610854Torne (Richard Coles)	open(HANDLE, "<", $filename)
1865821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)		or die("ERROR: cannot open $filename!\n");
1875821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)
1885821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	# Check for .gcov filename extension
1895821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	if ($filename =~ /^(.*).gcov$/)
1905821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	{
1915821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)		# Assume gcov text format
1925821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)		while (<HANDLE>)
1935821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)		{
1945821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)			if (/^\t\t(.*)$/)
1955821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)			{
1965821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)				# Uninstrumented line
1975821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)				push(@source, ":$1");
1985821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)			}
1995821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)			elsif (/^      ######    (.*)$/)
2005821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)			{
2015821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)				# Line with zero execution count
2025821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)				push(@source, "0:$1");
2035821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)			}
2045821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)			elsif (/^( *)(\d*)    (.*)$/)
2055821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)			{
2065821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)				# Line with positive execution count
2075821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)				push(@source, "$2:$3");
2085821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)			}
2095821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)		}
2105821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	}
2115821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	else
2125821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	{
2135821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)		# Plain text file
2145821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)		while (<HANDLE>) { push(@source, ":$_"); }
2155821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	}
2165821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	close(HANDLE);
2175821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)
2185821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	gen_png($out_filename, $width, $tab_size, @source);
2195821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)}
2205821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)
2215821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)
2225821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#
2235821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)# gen_png(filename, width, tab_size, source)
2245821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#
2255821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)# Write an overview PNG file to FILENAME. Source code is defined by SOURCE
2265821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)# which is a list of lines <count>:<source code> per source code line.
2275821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)# The output image will be made up of one pixel per character of source,
2285821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)# coloring will be done according to execution counts. WIDTH defines the
2295821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)# image width. TAB_SIZE specifies the number of spaces to use as replacement
2305821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)# string for tabulator signs in source code text.
2315821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#
2325821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)# Die on error.
2335821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#
2345821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)
2355821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)sub gen_png($$$@)
2365821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles){
2375821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	my $filename = shift(@_);	# Filename for PNG file
2385821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	my $overview_width = shift(@_);	# Imagewidth for image
2395821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	my $tab_size = shift(@_);	# Replacement string for tab signs
2405821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	my @source = @_;	# Source code as passed via argument 2
2413551c9c881056c480085172ff9840cab31610854Torne (Richard Coles)	my $height;		# Height as define by source size
2425821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	my $overview;		# Source code overview image data
2435821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	my $col_plain_back;	# Color for overview background
2445821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	my $col_plain_text;	# Color for uninstrumented text
2455821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	my $col_cov_back;	# Color for background of covered lines
2465821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	my $col_cov_text;	# Color for text of covered lines
2475821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	my $col_nocov_back;	# Color for background of lines which
2485821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)				# were not covered (count == 0)
2495821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	my $col_nocov_text;	# Color for test of lines which were not
2505821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)				# covered (count == 0)
2515821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	my $col_hi_back;	# Color for background of highlighted lines
2525821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	my $col_hi_text;	# Color for text of highlighted lines
2535821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	my $line;		# Current line during iteration
2545821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	my $row = 0;		# Current row number during iteration
2555821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	my $column;		# Current column number during iteration
2565821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	my $color_text;		# Current text color during iteration
2575821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	my $color_back;		# Current background color during iteration
2585821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	my $last_count;		# Count of last processed line
2595821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	my $count;		# Count of current line
2605821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	my $source;		# Source code of current line
2615821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	my $replacement;	# Replacement string for tabulator chars
2625821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	local *PNG_HANDLE;	# Handle for output PNG file
2635821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)
2643551c9c881056c480085172ff9840cab31610854Torne (Richard Coles)	# Handle empty source files
2653551c9c881056c480085172ff9840cab31610854Torne (Richard Coles)	if (!@source) {
2663551c9c881056c480085172ff9840cab31610854Torne (Richard Coles)		@source = ( "" );
2673551c9c881056c480085172ff9840cab31610854Torne (Richard Coles)	}
2683551c9c881056c480085172ff9840cab31610854Torne (Richard Coles)	$height = scalar(@source);
2695821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	# Create image
2705821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	$overview = new GD::Image($overview_width, $height)
2715821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)		or die("ERROR: cannot allocate overview image!\n");
2725821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)
2735821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	# Define colors
2745821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	$col_plain_back	= $overview->colorAllocate(0xff, 0xff, 0xff);
2755821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	$col_plain_text	= $overview->colorAllocate(0xaa, 0xaa, 0xaa);
2765821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	$col_cov_back	= $overview->colorAllocate(0xaa, 0xa7, 0xef);
2775821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	$col_cov_text	= $overview->colorAllocate(0x5d, 0x5d, 0xea);
2785821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	$col_nocov_back = $overview->colorAllocate(0xff, 0x00, 0x00);
2795821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	$col_nocov_text = $overview->colorAllocate(0xaa, 0x00, 0x00);
2805821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	$col_hi_back = $overview->colorAllocate(0x00, 0xff, 0x00);
2815821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	$col_hi_text = $overview->colorAllocate(0x00, 0xaa, 0x00);
2825821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)
2835821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	# Visualize each line
2845821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	foreach $line (@source)
2855821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	{
2865821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)		# Replace tabs with spaces to keep consistent with source
2875821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)		# code view
2885821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)		while ($line =~ /^([^\t]*)(\t)/)
2895821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)		{
2905821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)			$replacement = " "x($tab_size - ((length($1) - 1) %
2915821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)				       $tab_size));
2925821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)			$line =~ s/^([^\t]*)(\t)/$1$replacement/;
2935821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)		}
2945821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)
2955821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)		# Skip lines which do not follow the <count>:<line>
2965821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)		# specification, otherwise $1 = count, $2 = source code
2975821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)		if (!($line =~ /(\*?)(\d*):(.*)$/)) { next; }
2985821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)		$count = $2;
2995821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)		$source = $3;
3005821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)
3015821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)		# Decide which color pair to use
3025821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)
3035821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)		# If this line was not instrumented but the one before was,
3045821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)		# take the color of that line to widen color areas in
3055821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)		# resulting image
3065821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)		if (($count eq "") && defined($last_count) &&
3075821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)		    ($last_count ne ""))
3085821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)		{
3095821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)			$count = $last_count;
3105821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)		}
3115821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)
3125821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)		if ($count eq "")
3135821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)		{
3145821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)			# Line was not instrumented
3155821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)			$color_text = $col_plain_text;
3165821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)			$color_back = $col_plain_back;
3175821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)		}
3185821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)		elsif ($count == 0)
3195821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)		{
3205821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)			# Line was instrumented but not executed
3215821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)			$color_text = $col_nocov_text;
3225821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)			$color_back = $col_nocov_back;
3235821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)		}
3245821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)		elsif ($1 eq "*")
3255821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)		{
3265821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)			# Line was highlighted
3275821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)			$color_text = $col_hi_text;
3285821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)			$color_back = $col_hi_back;
3295821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)		}
3305821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)		else
3315821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)		{
3325821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)			# Line was instrumented and executed
3335821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)			$color_text = $col_cov_text;
3345821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)			$color_back = $col_cov_back;
3355821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)		}
3365821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)
3375821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)		# Write one pixel for each source character
3385821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)		$column = 0;
3395821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)		foreach (split("", $source))
3405821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)		{
3415821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)			# Check for width
3425821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)			if ($column >= $overview_width) { last; }
3435821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)
3445821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)			if ($_ eq " ")
3455821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)			{
3465821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)				# Space
3475821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)				$overview->setPixel($column++, $row,
3485821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)						    $color_back);
3495821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)			}
3505821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)			else
3515821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)			{
3525821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)				# Text
3535821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)				$overview->setPixel($column++, $row,
3545821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)						    $color_text);
3555821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)			}
3565821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)		}
3575821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)
3585821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)		# Fill rest of line		
3595821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)		while ($column < $overview_width)
3605821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)		{
3615821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)			$overview->setPixel($column++, $row, $color_back);
3625821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)		}
3635821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)
3645821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)		$last_count = $2;
3655821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)
3665821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)		$row++;
3675821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	}
3685821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)
3695821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	# Write PNG file
3703551c9c881056c480085172ff9840cab31610854Torne (Richard Coles)	open (PNG_HANDLE, ">", $filename)
3715821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)		or die("ERROR: cannot write png file $filename!\n");
3725821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	binmode(*PNG_HANDLE);
3735821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	print(PNG_HANDLE $overview->png());
3745821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	close(PNG_HANDLE);
3755821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)}
3765821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)
3773551c9c881056c480085172ff9840cab31610854Torne (Richard Coles)sub genpng_warn_handler($)
3785821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles){
3795821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	my ($msg) = @_;
3805821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)
3815821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	warn("$tool_name: $msg");
3825821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)}
3835821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)
3843551c9c881056c480085172ff9840cab31610854Torne (Richard Coles)sub genpng_die_handler($)
3855821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles){
3865821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	my ($msg) = @_;
3875821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)
3885821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)	die("$tool_name: $msg");
3895821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)}
390