#!/usr/bin/perl -w # # Copyright (c) International Business Machines Corp., 2002 # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or (at # your option) any later version. # # This program is distributed in the hope that it will be useful, but # WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU # General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA # # # genflat # # This script generates std output from .info files as created by the # geninfo script. Call it with --help to get information on usage and # available options. This code is based on the lcov genhtml script # by Peter Oberparleiter <Peter.Oberparleiter@de.ibm.com> # # # History: # 2003-08-19 ripped up Peter's script James M Kenefick Jr. <jkenefic@us.ibm.com> # use strict; use File::Basename; use Getopt::Long; # Constants our $lcov_version = ""; our $lcov_url = ""; # Specify coverage rate limits (in %) for classifying file entries # HI: $hi_limit <= rate <= 100 graph color: green # MED: $med_limit <= rate < $hi_limit graph color: orange # LO: 0 <= rate < $med_limit graph color: red our $hi_limit = 50; our $med_limit = 15; # Data related prototypes sub print_usage(*); sub gen_html(); sub process_dir($); sub process_file($$$); sub info(@); sub read_info_file($); sub get_info_entry($); sub set_info_entry($$$$;$$); sub get_prefix(@); sub shorten_prefix($); sub get_dir_list(@); sub get_relative_base_path($); sub get_date_string(); sub split_filename($); sub subtract_counts($$); sub add_counts($$); sub apply_baseline($$); sub combine_info_files($$); sub combine_info_entries($$); sub apply_prefix($$); sub escape_regexp($); # HTML related prototypes sub write_file_table(*$$$$); # Global variables & initialization our %info_data; # Hash containing all data from .info file our $dir_prefix; # Prefix to remove from all sub directories our %test_description; # Hash containing test descriptions if available our $date = get_date_string(); our @info_filenames; # List of .info files to use as data source our $test_title; # Title for output as written to each page header our $output_directory; # Name of directory in which to store output our $base_filename; # Optional name of file containing baseline data our $desc_filename; # Name of file containing test descriptions our $css_filename; # Optional name of external stylesheet file to use our $quiet; # If set, suppress information messages our $help; # Help option flag our $version; # Version option flag our $show_details; # If set, generate detailed directory view our $no_prefix; # If set, do not remove filename prefix our $frames; # If set, use frames for source code view our $keep_descriptions; # If set, do not remove unused test case descriptions our $no_sourceview; # If set, do not create a source code view for each file our $tab_size = 8; # Number of spaces to use in place of tab our $cwd = `pwd`; # Current working directory chomp($cwd); our $tool_dir = dirname($0); # Directory where genhtml tool is installed # # Code entry point # # Add current working directory if $tool_dir is not already an absolute path if (! ($tool_dir =~ /^\/(.*)$/)) { $tool_dir = "$cwd/$tool_dir"; } # Parse command line options if (!GetOptions("output-directory=s" => \$output_directory, "css-file=s" => \$css_filename, "baseline-file=s" => \$base_filename, "prefix=s" => \$dir_prefix, "num-spaces=i" => \$tab_size, "no-prefix" => \$no_prefix, "quiet" => \$quiet, "help" => \$help, "version" => \$version )) { print_usage(*STDERR); exit(1); } @info_filenames = @ARGV; # Check for help option if ($help) { print_usage(*STDOUT); exit(0); } # Check for version option if ($version) { print($lcov_version."\n"); exit(0); } # Check for info filename if (!@info_filenames) { print(STDERR "No filename specified\n"); print_usage(*STDERR); exit(1); } # Generate a title if none is specified if (!$test_title) { if (scalar(@info_filenames) == 1) { # Only one filename specified, use it as title $test_title = basename($info_filenames[0]); } else { # More than one filename specified, used default title $test_title = "unnamed"; } } # Make sure tab_size is within valid range if ($tab_size < 1) { print(STDERR "ERROR: invalid number of spaces specified: ". "$tab_size!\n"); exit(1); } # Do something gen_html(); exit(0); # # print_usage(handle) # # Print usage information. # sub print_usage(*) { local *HANDLE = $_[0]; my $executable_name = basename($0); print(HANDLE <<END_OF_USAGE); Usage: $executable_name [OPTIONS] INFOFILE(S) Create HTML output for coverage data found in INFOFILE. Note that INFOFILE may also be a list of filenames. -h, --help Print this help, then exit -v, --version Print version number, then exit -q, --quiet Do not print progress messages -b, --baseline-file BASEFILE Use BASEFILE as baseline file -p, --prefix PREFIX Remove PREFIX from all directory names --no-prefix Do not remove prefix from directory names --no-source Do not create source code view --num-spaces NUM Replace tabs with NUM spaces in source view See $lcov_url for more information about this tool. END_OF_USAGE ; } # # gen_html() # # Generate a set of HTML pages from contents of .info file INFO_FILENAME. # Files will be written to the current directory. If provided, test case # descriptions will be read from .tests file TEST_FILENAME and included # in ouput. # # Die on error. # sub gen_html() { local *HTML_HANDLE; my %overview; my %base_data; my $lines_found; my $lines_hit; my $overall_found = 0; my $overall_hit = 0; my $dir_name; my $link_name; my @dir_list; my %new_info; # Read in all specified .info files foreach (@info_filenames) { info("Reading data file $_\n"); %new_info = %{read_info_file($_)}; # Combine %new_info with %info_data %info_data = %{combine_info_files(\%info_data, \%new_info)}; } info("Found %d entries.\n", scalar(keys(%info_data))); # Read and apply baseline data if specified if ($base_filename) { # Read baseline file info("Reading baseline file $base_filename\n"); %base_data = %{read_info_file($base_filename)}; info("Found %d entries.\n", scalar(keys(%base_data))); # Apply baseline info("Subtracting baseline data.\n"); %info_data = %{apply_baseline(\%info_data, \%base_data)}; } @dir_list = get_dir_list(keys(%info_data)); if ($no_prefix) { # User requested that we leave filenames alone info("User asked not to remove filename prefix\n"); } elsif (!defined($dir_prefix)) { # Get prefix common to most directories in list $dir_prefix = get_prefix(@dir_list); if ($dir_prefix) { info("Found common filename prefix \"$dir_prefix\"\n"); } else { info("No common filename prefix found!\n"); $no_prefix=1; } } else { info("Using user-specified filename prefix \"". "$dir_prefix\"\n"); } # Process each subdirectory and collect overview information foreach $dir_name (@dir_list) { ($lines_found, $lines_hit) = process_dir($dir_name); $overview{$dir_name} = "$lines_found,$lines_hit, "; $overall_found += $lines_found; $overall_hit += $lines_hit; } if ($overall_found == 0) { info("Warning: No lines found!\n"); } else { info("Overall coverage rate: %d of %d lines (%.1f%%)\n", $overall_hit, $overall_found, $overall_hit*100/$overall_found); } } # # process_dir(dir_name) # sub process_dir($) { my $abs_dir = $_[0]; my $trunc_dir; my $rel_dir = $abs_dir; my $base_dir; my $filename; my %overview; my $lines_found; my $lines_hit; my $overall_found=0; my $overall_hit=0; my $base_name; my $extension; my $testdata; my %testhash; local *HTML_HANDLE; # Remove prefix if applicable if (!$no_prefix) { # Match directory name beginning with $dir_prefix $rel_dir = apply_prefix($rel_dir, $dir_prefix); } $trunc_dir = $rel_dir; # Remove leading / if ($rel_dir =~ /^\/(.*)$/) { $rel_dir = substr($rel_dir, 1); } $base_dir = get_relative_base_path($rel_dir); $abs_dir = escape_regexp($abs_dir); # Match filenames which specify files in this directory, not including # sub-directories foreach $filename (grep(/^$abs_dir\/[^\/]*$/,keys(%info_data))) { ($lines_found, $lines_hit, $testdata) = process_file($trunc_dir, $rel_dir, $filename); $base_name = basename($filename); $overview{$base_name} = "$lines_found,$lines_hit"; $testhash{$base_name} = $testdata; $overall_found += $lines_found; $overall_hit += $lines_hit; } write_file_table($abs_dir, "./linux/", \%overview, \%testhash, 4); # Calculate resulting line counts return ($overall_found, $overall_hit); } # # process_file(trunc_dir, rel_dir, filename) # sub process_file($$$) { info("Processing file ".apply_prefix($_[2], $dir_prefix)."\n"); my $trunc_dir = $_[0]; my $rel_dir = $_[1]; my $filename = $_[2]; my $base_name = basename($filename); my $base_dir = get_relative_base_path($rel_dir); my $testdata; my $testcount; my $sumcount; my $funcdata; my $lines_found; my $lines_hit; my @source; my $pagetitle; ($testdata, $sumcount, $funcdata, $lines_found, $lines_hit) = get_info_entry($info_data{$filename}); return ($lines_found, $lines_hit, $testdata); } # # read_info_file(info_filename) # # Read in the contents of the .info file specified by INFO_FILENAME. Data will # be returned as a reference to a hash containing the following mappings: # # %result: for each filename found in file -> \%data # # %data: "test" -> \%testdata # "sum" -> \%sumcount # "func" -> \%funcdata # "found" -> $lines_found (number of instrumented lines found in file) # "hit" -> $lines_hit (number of executed lines in file) # # %testdata: name of test affecting this file -> \%testcount # # %testcount: line number -> execution count for a single test # %sumcount : line number -> execution count for all tests # %funcdata : line number -> name of function beginning at that line # # Note that .info file sections referring to the same file and test name # will automatically be combined by adding all execution counts. # # Note that if INFO_FILENAME ends with ".gz", it is assumed that the file # is compressed using GZIP. If available, GUNZIP will be used to decompress # this file. # # Die on error # sub read_info_file($) { my $tracefile = $_[0]; # Name of tracefile my %result; # Resulting hash: file -> data my $data; # Data handle for current entry my $testdata; # " " my $testcount; # " " my $sumcount; # " " my $funcdata; # " " my $line; # Current line read from .info file my $testname; # Current test name my $filename; # Current filename my $hitcount; # Count for lines hit my $count; # Execution count of current line my $negative; # If set, warn about negative counts local *INFO_HANDLE; # Filehandle for .info file # Check if file exists and is readable stat($_[0]); if (!(-r _)) { die("ERROR: cannot read file $_[0]!\n"); } # Check if this is really a plain file if (!(-f _)) { die("ERROR: not a plain file: $_[0]!\n"); } # Check for .gz extension if ($_[0] =~ /^(.*)\.gz$/) { # Check for availability of GZIP tool system("gunzip -h >/dev/null 2>/dev/null") and die("ERROR: gunzip command not available!\n"); # Check integrity of compressed file system("gunzip -t $_[0] >/dev/null 2>/dev/null") and die("ERROR: integrity check failed for ". "compressed file $_[0]!\n"); # Open compressed file open(INFO_HANDLE, "gunzip -c $_[0]|") or die("ERROR: cannot start gunzip to uncompress ". "file $_[0]!\n"); } else { # Open uncompressed file open(INFO_HANDLE, $_[0]) or die("ERROR: cannot read file $_[0]!\n"); } $testname = ""; while (<INFO_HANDLE>) { chomp($_); $line = $_; # Switch statement foreach ($line) { /^TN:(\w+)/ && do { # Test name information found $testname = $1; last; }; /^[SK]F:(.*)/ && do { # Filename information found # Retrieve data for new entry $filename = $1; $data = $result{$filename}; ($testdata, $sumcount, $funcdata) = get_info_entry($data); if (defined($testname)) { $testcount = $testdata->{$testname}; } else { my %new_hash; $testcount = \%new_hash; } last; }; /^DA:(\d+),(-?\d+)/ && do { # Fix negative counts $count = $2 < 0 ? 0 : $2; if ($2 < 0) { $negative = 1; } # Execution count found, add to structure # Add summary counts $sumcount->{$1} += $count; # Add test-specific counts if (defined($testname)) { $testcount->{$1} += $count; } last; }; /^FN:(\d+),([^,]+)/ && do { # Function data found, add to structure $funcdata->{$1} = $2; last; }; /^end_of_record/ && do { # Found end of section marker if ($filename) { # Store current section data if (defined($testname)) { $testdata->{$testname} = $testcount; } set_info_entry($data, $testdata, $sumcount, $funcdata); $result{$filename} = $data; } }; # default last; } } close(INFO_HANDLE); # Calculate lines_found and lines_hit for each file foreach $filename (keys(%result)) { $data = $result{$filename}; ($testdata, $sumcount, $funcdata) = get_info_entry($data); $data->{"found"} = scalar(keys(%{$sumcount})); $hitcount = 0; foreach (keys(%{$sumcount})) { if ($sumcount->{$_} >0) { $hitcount++; } } $data->{"hit"} = $hitcount; $result{$filename} = $data; } if (scalar(keys(%result)) == 0) { die("ERROR: No valid records found in tracefile $tracefile\n"); } if ($negative) { warn("WARNING: Negative counts found in tracefile ". "$tracefile\n"); } return(\%result); } # # get_info_entry(hash_ref) # # Retrieve data from an entry of the structure generated by read_info_file(). # Return a list of references to hashes: # (test data hash ref, sum count hash ref, funcdata hash ref, lines found, # lines hit) # sub get_info_entry($) { my $testdata_ref = $_[0]->{"test"}; my $sumcount_ref = $_[0]->{"sum"}; my $funcdata_ref = $_[0]->{"func"}; my $lines_found = $_[0]->{"found"}; my $lines_hit = $_[0]->{"hit"}; return ($testdata_ref, $sumcount_ref, $funcdata_ref, $lines_found, $lines_hit); } # # set_info_entry(hash_ref, testdata_ref, sumcount_ref, funcdata_ref[, # lines_found, lines_hit]) # # Update the hash referenced by HASH_REF with the provided data references. # sub set_info_entry($$$$;$$) { my $data_ref = $_[0]; $data_ref->{"test"} = $_[1]; $data_ref->{"sum"} = $_[2]; $data_ref->{"func"} = $_[3]; if (defined($_[4])) { $data_ref->{"found"} = $_[4]; } if (defined($_[5])) { $data_ref->{"hit"} = $_[5]; } } # # get_prefix(filename_list) # # Search FILENAME_LIST for a directory prefix which is common to as many # list entries as possible, so that removing this prefix will minimize the # sum of the lengths of all resulting shortened filenames. # sub get_prefix(@) { my @filename_list = @_; # provided list of filenames my %prefix; # mapping: prefix -> sum of lengths my $current; # Temporary iteration variable # Find list of prefixes foreach (@filename_list) { # Need explicit assignment to get a copy of $_ so that # shortening the contained prefix does not affect the list $current = shorten_prefix($_); while ($current = shorten_prefix($current)) { # Skip rest if the remaining prefix has already been # added to hash if ($prefix{$current}) { last; } # Initialize with 0 $prefix{$current}="0"; } } # Calculate sum of lengths for all prefixes foreach $current (keys(%prefix)) { foreach (@filename_list) { # Add original length $prefix{$current} += length($_); # Check whether prefix matches if (substr($_, 0, length($current)) eq $current) { # Subtract prefix length for this filename $prefix{$current} -= length($current); } } } # Find and return prefix with minimal sum $current = (keys(%prefix))[0]; foreach (keys(%prefix)) { if ($prefix{$_} < $prefix{$current}) { $current = $_; } } return($current); } # # shorten_prefix(prefix) # # Return PREFIX shortened by last directory component. # sub shorten_prefix($) { my @list = split("/", $_[0]); pop(@list); return join("/", @list); } # # get_dir_list(filename_list) # # Return sorted list of directories for each entry in given FILENAME_LIST. # sub get_dir_list(@) { my %result; foreach (@_) { $result{shorten_prefix($_)} = ""; } return(sort(keys(%result))); } # # get_relative_base_path(subdirectory) # # Return a relative path string which references the base path when applied # in SUBDIRECTORY. # # Example: get_relative_base_path("fs/mm") -> "../../" # sub get_relative_base_path($) { my $result = ""; my $index; # Make an empty directory path a special case if (!$_[0]) { return(""); } # Count number of /s in path $index = ($_[0] =~ s/\//\//g); # Add a ../ to $result for each / in the directory path + 1 for (; $index>=0; $index--) { $result .= "../"; } return $result; } # # get_date_string() # # Return the current date in the form: yyyy-mm-dd # sub get_date_string() { my $year; my $month; my $day; ($year, $month, $day) = (localtime())[5, 4, 3]; return sprintf("%d-%02d-%02d", $year+1900, $month+1, $day); } # # split_filename(filename) # # Return (path, filename, extension) for a given FILENAME. # sub split_filename($) { if (!$_[0]) { return(); } my @path_components = split('/', $_[0]); my @file_components = split('\.', pop(@path_components)); my $extension = pop(@file_components); return (join("/",@path_components), join(".",@file_components), $extension); } # # write_file_table(filehandle, base_dir, overview, testhash, fileview) # # Write a complete file table. OVERVIEW is a reference to a hash containing # the following mapping: # # filename -> "lines_found,lines_hit,page_link" # # TESTHASH is a reference to the following hash: # # filename -> \%testdata # %testdata: name of test affecting this file -> \%testcount # %testcount: line number -> execution count for a single test # # Heading of first column is "Filename" if FILEVIEW is true, "Directory name" # otherwise. # sub write_file_table(*$$$$) { my $dir = $_[0]; my $base_dir = $_[1]; my %overview = %{$_[2]}; my %testhash = %{$_[3]}; my $fileview = $_[4]; my $filename; my $hit; my $found; my $classification; my $rate_string; my $rate; my $junk; foreach $filename (sort(keys(%overview))) { ($found, $hit, $junk) = split(",", $overview{$filename}); #James I think this is right $rate = $hit * 100 / $found; $rate_string = sprintf("%.1f", $rate); if ($rate < 0.001) { $classification = "None"; } elsif ($rate < $med_limit) { $classification = "Lo"; } elsif ($rate < $hi_limit) { $classification = "Med"; } else { $classification = "Hi"; } print "$dir/$filename\t$classification\t$rate_string\n"; } } # # info(printf_parameter) # # Use printf to write PRINTF_PARAMETER to stdout only when the $quiet flag # is not set. # sub info(@) { if (!$quiet) { # Print info string printf(STDERR @_); } } # # subtract_counts(data_ref, base_ref) # sub subtract_counts($$) { my %data = %{$_[0]}; my %base = %{$_[1]}; my $line; my $data_count; my $base_count; my $hit = 0; my $found = 0; foreach $line (keys(%data)) { $found++; $data_count = $data{$line}; $base_count = $base{$line}; if (defined($base_count)) { $data_count -= $base_count; # Make sure we don't get negative numbers if ($data_count<0) { $data_count = 0; } } $data{$line} = $data_count; if ($data_count > 0) { $hit++; } } return (\%data, $found, $hit); } # # add_counts(data1_ref, data2_ref) # # DATA1_REF and DATA2_REF are references to hashes containing a mapping # # line number -> execution count # # Return a list (RESULT_REF, LINES_FOUND, LINES_HIT) where RESULT_REF # is a reference to a hash containing the combined mapping in which # execution counts are added. # sub add_counts($$) { my %data1 = %{$_[0]}; # Hash 1 my %data2 = %{$_[1]}; # Hash 2 my %result; # Resulting hash my $line; # Current line iteration scalar my $data1_count; # Count of line in hash1 my $data2_count; # Count of line in hash2 my $found = 0; # Total number of lines found my $hit = 0; # Number of lines with a count > 0 foreach $line (keys(%data1)) { $data1_count = $data1{$line}; $data2_count = $data2{$line}; # Add counts if present in both hashes if (defined($data2_count)) { $data1_count += $data2_count; } # Store sum in %result $result{$line} = $data1_count; $found++; if ($data1_count > 0) { $hit++; } } # Add lines unique to data2 foreach $line (keys(%data2)) { # Skip lines already in data1 if (defined($data1{$line})) { next; } # Copy count from data2 $result{$line} = $data2{$line}; $found++; if ($result{$line} > 0) { $hit++; } } return (\%result, $found, $hit); } # # apply_baseline(data_ref, baseline_ref) # # Subtract the execution counts found in the baseline hash referenced by # BASELINE_REF from actual data in DATA_REF. # sub apply_baseline($$) { my %data_hash = %{$_[0]}; my %base_hash = %{$_[1]}; my $filename; my $testname; my $data; my $data_testdata; my $data_funcdata; my $data_count; my $base; my $base_testdata; my $base_count; my $sumcount; my $found; my $hit; foreach $filename (keys(%data_hash)) { # Get data set for data and baseline $data = $data_hash{$filename}; $base = $base_hash{$filename}; # Get set entries for data and baseline ($data_testdata, undef, $data_funcdata) = get_info_entry($data); ($base_testdata, $base_count) = get_info_entry($base); # Sumcount has to be calculated anew $sumcount = {}; # For each test case, subtract test specific counts foreach $testname (keys(%{$data_testdata})) { # Get counts of both data and baseline $data_count = $data_testdata->{$testname}; $hit = 0; ($data_count, undef, $hit) = subtract_counts($data_count, $base_count); # Check whether this test case did hit any line at all if ($hit > 0) { # Write back resulting hash $data_testdata->{$testname} = $data_count; } else { # Delete test case which did not impact this # file delete($data_testdata->{$testname}); } # Add counts to sum of counts ($sumcount, $found, $hit) = add_counts($sumcount, $data_count); } # Write back resulting entry set_info_entry($data, $data_testdata, $sumcount, $data_funcdata, $found, $hit); $data_hash{$filename} = $data; } return (\%data_hash); } # # combine_info_entries(entry_ref1, entry_ref2) # # Combine .info data entry hashes referenced by ENTRY_REF1 and ENTRY_REF2. # Return reference to resulting hash. # sub combine_info_entries($$) { my $entry1 = $_[0]; # Reference to hash containing first entry my $testdata1; my $sumcount1; my $funcdata1; my $entry2 = $_[1]; # Reference to hash containing second entry my $testdata2; my $sumcount2; my $funcdata2; my %result; # Hash containing combined entry my %result_testdata; my $result_sumcount = {}; my %result_funcdata; my $lines_found; my $lines_hit; my $testname; # Retrieve data ($testdata1, $sumcount1, $funcdata1) = get_info_entry($entry1); ($testdata2, $sumcount2, $funcdata2) = get_info_entry($entry2); # Combine funcdata foreach (keys(%{$funcdata1})) { $result_funcdata{$_} = $funcdata1->{$_}; } foreach (keys(%{$funcdata2})) { $result_funcdata{$_} = $funcdata2->{$_}; } # Combine testdata foreach $testname (keys(%{$testdata1})) { if (defined($testdata2->{$testname})) { # testname is present in both entries, requires # combination ($result_testdata{$testname}) = add_counts($testdata1->{$testname}, $testdata2->{$testname}); } else { # testname only present in entry1, add to result $result_testdata{$testname} = $testdata1->{$testname}; } # update sum count hash ($result_sumcount, $lines_found, $lines_hit) = add_counts($result_sumcount, $result_testdata{$testname}); } foreach $testname (keys(%{$testdata2})) { # Skip testnames already covered by previous iteration if (defined($testdata1->{$testname})) { next; } # testname only present in entry2, add to result hash $result_testdata{$testname} = $testdata2->{$testname}; # update sum count hash ($result_sumcount, $lines_found, $lines_hit) = add_counts($result_sumcount, $result_testdata{$testname}); } # Calculate resulting sumcount # Store result set_info_entry(\%result, \%result_testdata, $result_sumcount, \%result_funcdata, $lines_found, $lines_hit); return(\%result); } # # combine_info_files(info_ref1, info_ref2) # # Combine .info data in hashes referenced by INFO_REF1 and INFO_REF2. Return # reference to resulting hash. # sub combine_info_files($$) { my %hash1 = %{$_[0]}; my %hash2 = %{$_[1]}; my $filename; foreach $filename (keys(%hash2)) { if ($hash1{$filename}) { # Entry already exists in hash1, combine them $hash1{$filename} = combine_info_entries($hash1{$filename}, $hash2{$filename}); } else { # Entry is unique in both hashes, simply add to # resulting hash $hash1{$filename} = $hash2{$filename}; } } return(\%hash1); } # # apply_prefix(filename, prefix) # # If FILENAME begins with PREFIX, remove PREFIX from FILENAME and return # resulting string, otherwise return FILENAME. # sub apply_prefix($$) { my $filename = $_[0]; my $prefix = $_[1]; my $clean_prefix = escape_regexp($prefix); if (defined($prefix) && ($prefix ne "")) { if ($filename =~ /^$clean_prefix\/(.*)$/) { return substr($filename, length($prefix) + 1); } } return $filename; } # # escape_regexp(string) # # Escape special characters in STRING which would be incorrectly interpreted # in a PERL regular expression. # sub escape_regexp($) { my $string = $_[0]; # Escape special characters $string =~ s/\\/\\\\/g; $string =~ s/\^/\\\^/g; $string =~ s/\$/\\\$/g; $string =~ s/\./\\\./g; $string =~ s/\|/\\\|/g; $string =~ s/\(/\\\(/g; $string =~ s/\)/\\\)/g; $string =~ s/\[/\\\[/g; $string =~ s/\]/\\\]/g; $string =~ s/\*/\\\*/g; $string =~ s/\?/\\\?/g; $string =~ s/\{/\\\{/g; $string =~ s/\}/\\\}/g; $string =~ s/\+/\\\+/g; return $string; }