Devel::LineTrace - Apply traces to individual lines.


Devel-LineTrace documentation Contained in the Devel-LineTrace distribution.

Index


Code Index:

NAME

Top

Devel::LineTrace - Apply traces to individual lines.

SYNPOSIS

Top

    perl -d:LineTrace myscript.pl [args ...]

DESCRIPTION

Top

This is a class that enables assigning Perl code callbacks to certain lines in the original code without modifying it.

To do so prepare a file with the following syntax:

    [source_filename]:[line]
        [CODE]
        [CODE]
        [CODE]
    [source_filename]:[line]
        [CODE]
        [CODE]
        [CODE]

Which will assign the [CODE] blocks to the filename and line combinations. The [CODE] sections are indented from the main blocks. To temporarily cancel a callback put a pound-sign (#) right at the start of the line (without whitespace beforehand).

The location of the file should be specified by the PERL5DB_LT environment variable (or else it defaults to perl-line-traces.txt.)

Then invoke the perl interpreter like this:

    perl -d:LineTrace myprogram.pl

SEE ALSO

Top

Devel::Trace, Debug::Trace

COPYRIGHT & LICENSE

Top

AUTHORS

Top

Shlomi Fish ( http://www.shlomifish.org/ ).


Devel-LineTrace documentation Contained in the Devel-LineTrace distribution.

package Devel::LineTrace;

use strict;
use warnings;

use vars (qw($VERSION));
$VERSION = '0.1.7';

package DB;


my (%files);
sub BEGIN
{
    local (*I);
    my $filename = $ENV{'PERL5DB_LT'} || "perl-line-traces.txt";
    open I, "<", $filename
        or return;
    my $line;
    $line = <I>;
    while($line)
    {
        chomp $line;
        if (($line =~ /^\s+/) || ($line =~ /^#/))
        {
            $line = <I>;
            next;
        }
        $line =~ /^(.+):(\d+)$/;
        my $filename = $1;
        my $line_num = $2;
        my $callback = "";
        while ($line = <I>)
        {
            if ($line =~ /^\s/)
            {
                $callback .= $line;
            }
            else
            {
                last;
            }
        }
        $files{$filename}{$line_num} = $callback;
    }
    close(I);
}

use vars qw(@saved $package $filename $line $usercontext);

sub DB
{
    local @saved = ($@, $!, $^E, $,, $/, $\, $^W);
    local($package, $filename, $line) = caller;
    local $usercontext = '($@, $!, $^E, $,, $/, $\, $^W) = @saved;' .
      "package $package;";	# this won't let them modify, alas
    if (exists($files{$filename}{$line}))
    {
        eval $usercontext . " " . $files{$filename}{$line};
    }
}

1;