package yDebug;
BEGIN {
    $file = 'trace.out';
    # disable tracing while setting things up
    $Devel::Trace::TRACE = 0;
}
sub import { shift; $file = shift if @_ }
CHECK {
    $Devel::Trace::FORMAT = "# line %d %s: %s";
    @Devel::Trace::ORDER  = (2,0,3);
    open MYFH, '>', $file or die "open '$file': $!";
    $Devel::Trace::FH = *MYFH;
    # enable tracing for package Foo
    $Devel::Trace::PKG{Foo}++;
    # done, enable tracing
    $Devel::Trace::TRACE = 1;
}
1;

##</code><code>##

# -*- perl -*-

package Devel::Trace;

$VERSION = '0.13';
# these might have been set elsewhere already
$TRACE   = 1              unless $TRACE == 0;
$FH      = \*STDERR       unless $FH;
$FORMAT  = ">> %s:%d: %s" unless $FORMAT;
@ORDER   = (1,2,3)        unless @ORDER;
our %PKG;
# This is the important part.  The rest is just fluff.
sub DB::DB {
  return unless $TRACE;
  my @caller = caller;
  if (%PKG) {
    my $p = $caller[0];
    return if ! exists $PKG{$p} or (exists $PKG{$p} and ! $PKG{$p});
  }
  push @caller, (@{"::_<$caller[1]"})[$caller[2]];
  printf $FH $FORMAT, @caller[@ORDER];
}


sub import {
  my $package = shift;
  foreach (@_) {
    if ($_ eq 'trace') {
      my $caller = caller;
      *{$caller . '::trace'} = \&{$package . '::trace'};
    } else {
      # all other arguments are package names
      $PKG{$_}++;
    }
  }
}

my %tracearg = ('on' => 1, 'off' => 0);
sub trace {
  my $arg = shift;
  $arg = $tracearg{$arg} while exists $tracearg{$arg};
  if(@_) {
    for (@_) {
      $PKG{$_} = $arg;
    }
  } else {
    $TRACE = $arg;
  }
}

1;


=head1 NAME

Devel::Trace - Print out each line before it is executed (like C<sh -x>)

=head1 SYNOPSIS

  perl -d:Trace program

=head1 DESCRIPTION

If you run your program with C<perl -d:Trace program>, this module
will print a message to standard error just before each line is executed.  
For example, if your program looks like this:

        #!/usr/bin/perl
        
        
        print "Statement 1 at line 4\n";
        print "Statement 2 at line 5\n";
        print "Call to sub x returns ", &x(), " at line 6.\n";
        
        exit 0;
        
        
        sub x {
          print "In sub x at line 12.\n";
          return 13;
        }

Then  the C<Trace> output will look like this:

        >> ./test:4: print "Statement 1 at line 4\n";
        >> ./test:5: print "Statement 2 at line 5\n";
        >> ./test:6: print "Call to sub x returns ", &x(), " at line 6.\n";
        >> ./test:12:   print "In sub x at line 12.\n";
        >> ./test:13:   return 13;
        >> ./test:8: exit 0;

This is something like the shell's C<-x> option.

=head1 DETAILS

Inside your program, you can enable and disable tracing by doing

    $Devel::Trace::TRACE = 1;   # Enable
    $Devel::Trace::TRACE = 0;   # Disable

or

    Devel::Trace::trace('on');  # Enable
    Devel::Trace::trace('off'); # Disable


C<Devel::Trace> exports the C<trace> function if you ask it to:

    import Devel::Trace 'trace';

Then if you want you just say

    trace 'on';                 # Enable
    trace 'off';                # Disable

You can limit the trace to namespaces by assigning to C<%Devel::Trace::PKG>:

    $Devel::Trace::PKG{$_} = 1 for @namespaces;

or by adding them to the call to trace:

   trace 'on',  qw( Foo::Bar Net::LDAP ); # Enable
   trace 'off', qw( Foo::Bar main ); # Disable

This works also with imports. Thus,

   perl -d:Trace=Foo::Bar,MIME::Base64 foo.pl

will trace only code executed in Foo::Bar and MIME::Base64.

Note that if the hash %Devel::Trace::PKG holds keys, but none has a true value,
tracing is globally disabled, even if $Devel::Trace::TRACE is true.

Setting $Devel::Trace::TRACE to false also disables tracing globally.

=head1 Trace Format and Filehandle

You can change the format by assigning a C<sprintf> compatible format string
to C<$Devel::Trace::Format>. The elements available for each trace line are

        0        1      2      3
   ( $package, $file, $line, $code )

and the order by which they are fed into sprintf is in the array C<@Devel::Trace::ORDER>.

The default format settings are:

=over 4

=item $FORMAT = ">> %s:%d: %s";

=item @ORDER  = (1,2,3);

=back

The default filehandle for trace messages is STDERR. You can change that by
assigning an open filehandle to C<$Devel::Trace::FH>.

If you want to capture the trace into a string, open a file handle to a scalar reference.

=head1 EXAMPLE

This example shows all the above tweaks.

   # file Foo.pm
   package Foo;
   sub slt(;$){my$t=localtime(shift||time);$t}
   END { print "bye...\n" }
   1;

   #!/usr/bin/perl
   # file foo.pl
   BEGIN{
     $Devel::Trace::FORMAT = "# line %d %s: %s";
     @Devel::Trace::ORDER  = (2,0,3); # line, package, code
     open my $fh, '>', \$foo;
     $Devel::Trace::FH = $fh;
   }
   use Foo;
   print Foo::slt(123456789),"\n";
   print "Hello World!\n";

   END { print "TRACE:\n$foo"; }

Running C<perl -d:Trace=Foo foo.pl> produces the output:

   Thu Nov 29 22:33:09 1973
   Hello World!
   TRACE:
   # line 3 Foo: sub slt(;$){my$t=localtime(shift||time);$t}
   # line 3 Foo: sub slt(;$){my$t=localtime(shift||time);$t}
   bye...

Note that when capturing the output into a string, the END block ouput
in the Foo package is not included in the $foo variable output, since this
block is executed last, after $foo has already been output.

=head1 LICENSE

Devel::Trace 0.13 and its source code are hereby placed in the public domain.

=head1 Author

=begin text

Mark-Jason Dominus (C<mjd-perl-trace@plover.com>), Plover Systems co.

See the C<Devel::Trace.pm> Page at http://www.plover.com/~mjd/perl/Trace
for news and upgrades.  

=end text

=begin man

Mark-Jason Dominus (C<mjd-perl-trace@plover.com>), Plover Systems co.

See the C<Devel::Trace.pm> Page at http://www.plover.com/~mjd/perl/Trace
for news and upgrades.  

=end man

=begin html
<p>Mark-Jason Dominus (<a href="mailto:mjd-perl-trace@plover.com"><tt>mjd-perl-trace@plover.com</tt></a>), Plover Systems co.</p>
<p>See <a href="http://www.plover.com/~mjd/perl/Trace/">The <tt>Devel::Trace.pm</tt> Page</a> for news and upgrades.</p>

=end html


=cut