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