Crude Prototype for Adding Test Coverage Traces for lib/perl5db.pl.

add_perl5db_coverage.pl

#!/usr/bin/perl

use strict;
use warnings;

use IO::All;

my $func_name = "DB::db_foo_trace";

my @lines = io("lib/perl5db.pl")->getlines();

my %where_traces_put;

my @indexes = (grep { $lines[$_] =~ /\A\s*push/ .. $lines[$_] =~ /;\s*\n?\z/ } keys(@lines));

my %ignore = (map { $_ => 1 } @indexes);

foreach my $i (keys(@lines))
{
    if ($lines[$i] =~ m/;\s*\z/ and
        ($lines[$i] !~ /\Apackage / or $lines[$i] =~ /\A1;\s*\z/)
    )
    {
        my $j = $i-1;
        my $line_num = $i+1;
        my $trace = "$func_name($line_num);";

        my $ws_re = qr/\s*(?:#.*)?\n?/;
        while (
            exists($ignore{$j}) or
            ( not (
                ( $lines[$j] =~ s/(;)($ws_re)\z/$1$trace$2/)
                or ( $lines[$j] =~ m/\{$ws_re\z/ and $lines[$j] !~ m/(?:=>)/
                    and $lines[$j] =~ s/(\{)($ws_re)\z/$1$trace$2/ )
                or ( $lines[$j] =~ m/\}$ws_re\z/ and
                    $lines[$j] !~ m/(?:\{|=>|,)/ and
                    $lines[$j] =~ s/(\})($ws_re)\z/$1$trace$2/)
               )
           )
        )
        {
            $j--;
        }
        $where_traces_put{$line_num} = 1;
    }
}

io("perl5db_coverage_all_lines.txt")->print(
    join '', map { "$_\n"} sort { $a <=> $b } keys(%where_traces_put)
);

my $big_string = join('', @lines);

my $code_to_add = "sub $func_name " . <<'EOF';
{
    my ($line_num) = @_;
    open my $append_fh, '>>', 'perl5db_coverage_trace.txt'
        or die "Cannot open 'perl5db_coverage_trace.txt' - $!.";
    print {$append_fh} "$line_num\n";
    close($append_fh);
}
EOF

$code_to_add =~ s/\n//g;

# $big_string =~ s/\A/BEGIN{ $code_to_add ; };/ms;
$big_string =~ s/\A/$code_to_add ;/ms;
io("lib/perl5db.pl")->print($big_string);