Debug-Statements

 view release on metacpan or  search on metacpan

META.yml  view on Meta::CPAN

license: perl
meta-spec:
  url: http://module-build.sourceforge.net/META-spec-v1.4.html
  version: '1.4'
name: Debug-Statements
requires:
  Carp: '0'
  Data::Dumper: '0'
  Dumpvalue: '0'
  Exporter: '0'
  PadWalker: '0'
  Test::Perl::Critic: '0'
  Test::Pod: '0'
  Time::HiRes: '0'
  base: '0'
  perl: '5.006'
  strict: '0'
  warnings: '0'
version: '1.008'
x_serialization_backend: 'YAML::Tiny version 1.73'

Makefile.PL  view on Meta::CPAN

  },
  "DISTNAME" => "Debug-Statements",
  "LICENSE" => "perl",
  "MIN_PERL_VERSION" => "5.006",
  "NAME" => "Debug::Statements",
  "PREREQ_PM" => {
    "Carp" => 0,
    "Data::Dumper" => 0,
    "Dumpvalue" => 0,
    "Exporter" => 0,
    "PadWalker" => 0,
    "Test::Perl::Critic" => 0,
    "Test::Pod" => 0,
    "Time::HiRes" => 0,
    "base" => 0,
    "strict" => 0,
    "warnings" => 0
  },
  "TEST_REQUIRES" => {
    "FindBin" => 0,
    "Getopt::Long" => 0,

Makefile.PL  view on Meta::CPAN

);


my %FallbackPrereqs = (
  "Carp" => 0,
  "Data::Dumper" => 0,
  "Dumpvalue" => 0,
  "Exporter" => 0,
  "FindBin" => 0,
  "Getopt::Long" => 0,
  "PadWalker" => 0,
  "Test::Fatal" => 0,
  "Test::More" => 0,
  "Test::Output" => 0,
  "Test::Perl::Critic" => 0,
  "Test::Pod" => 0,
  "Time::HiRes" => 0,
  "base" => 0,
  "lib" => 0,
  "strict" => 0,
  "warnings" => 0

dist.ini  view on Meta::CPAN

[PodSyntaxTests]
;[PodCoverageTests]
[Test::Perl::Critic]
[Test::Kwalitee]
skiptest = no_symlinks
;[@Git]
[MinimumPerl]
[AutoPrereqs]
[Prereqs]
;[Dist::Zilla::Plugin::MetaProvides]
PadWalker = 0
Test::Perl::Critic = 0
Test::Pod = 0
[TestRelease]
[ConfirmRelease]
;[UploadToCPAN]

lib/Debug/Statements.pm  view on Meta::CPAN

our @EXPORT    = qw( d d0 d2 d3 D );
our @EXPORT_OK = qw( d d0 d1 d2 d3 D ls LS cp CP Die );
our %EXPORT_TAGS = ( all => [qw(&d &d0 &d1 &d2 &d3 &D &ls &LS &cp &CP &Die)]);  # use Debug::Statements qw(:all)

my $VERSION = '1.005';

my $printdebug = "DEBUG:  ";    # print statement begins with this
my $id         = 0;             # If $d is negative, turn on $id (internal debug flag), and use the absolute value of $d.  For example:   $d = -1;
my $flag       = '$d';          # choose another variable besides '$d'
my $disable    = 0;             # disable all functionality (for performance)
if ( not eval "use PadWalker; 1" ) {  ## no critic
    $disable = 1;
    print "Did not find PadWalker so disabling Debug::Statements - d()\n";
    print "    Please install PadWalker from CPAN\n";
    eval 'sub d {}; sub d0 {}; sub d1 {} ; sub d2 {} ; sub d3 {} ; sub D {} ; sub ls {} ; sub LS {} ; sub cp {} ; sub CP {}';  ## no critic
}
my $data_printer_installed = 0; ### Disabled because it has problems printing %opt - $dump = '21/32'
if ( not eval "use Data::Printer; 1" ) {  ## no critic
    $data_printer_installed = 0;
    #print "Did not find Data::Printer so using Dumpvalue and Data::Dumper instead\n";
    #print "    Please install Data::Printer from CPAN\n";
}
my $truncateLines      = 10;
my $globalPrintCounter = 0;

lib/Debug/Statements.pm  view on Meta::CPAN

        return 0;
    }
}

sub dx {
    my ( $caller, $vars, $options ) = @_;

    if ($id) { print "\n\n\n\n\n\n\n\n--------------- sub dx() ---------------\n" }
    if ($id) { print "internaldebug:  \@_ = '@_'\n" }

    my $h = PadWalker::peek_my(2);
    if ($id) { print "\n\ninternaldebug:  Dumping \$h:\n"; Dumpvalue->new->dumpValue($h) }

    # Parse options
    my %opt = %globalOpt;
    $opt{level} = 1;
    if ($id) { print "internaldebug:  \$options = '$options'\n" }
    for my $o ( split //, $options ) {
        if ( $o =~ /([0-9])/ ) {
            $opt{level} = $1;
        } elsif ( $o =~ /[bcenqrstxz]/ ) {

lib/Debug/Statements.pm  view on Meta::CPAN

sub ls {
    my ( $filenames, $options, $level, $peek_my_parameter ) = @_;
    #my $id = 1;
    # $options affect unix 'ls', not windows 'dir'
    $options = '-l' if ! defined $options;
    $options = "-$options" if ! $options =~ /^-/;
    return if $disable;
    $peek_my_parameter = 1 if ! defined $peek_my_parameter;
    $level = 1 if ! defined $level;
    if ($id) { print "internaldebug ls:  \$level = '$level'\n" }
    my $h = PadWalker::peek_my($peek_my_parameter);
    # print Dumper($h);
    return if not checkLevel( $h, $level );
    my $windows = ($^O =~ /Win/) ? 1 : 0;
    my $command;
    for my $file ( split /\s+/, $filenames ) {
        my $lsl;
        if ( -e $file ) {
            if ( $windows ) {
                $command = "dir $file";
            } else {

lib/Debug/Statements.pm  view on Meta::CPAN

# cp($filename) 
# cp($filename, $level)
# cp("$filename1 filename2", $level)
sub cp {
    my ( $filenames, $level, $peek_my_parameter ) = @_;
    return if $disable;
    $peek_my_parameter = 1 if ! defined $peek_my_parameter;
    $level = 1 if ! defined $level;
    if ($id) { print "internaldebug cp  \$level = '$level'\n" }
    my $h = PadWalker::peek_my($peek_my_parameter);
    # print Dumper($h);
    return if not checkLevel( $h, $level );
    my $windows = ($^O =~ /Win/) ? 1 : 0;
    my $command;
    for my $file ( split /\s+/, $filenames ) {
        if ( -e $file ) {
            if ( $windows ) {
                $command = "copy $file /tmp";
                ### directory probably does not work
            } else {

lib/Debug/Statements.pm  view on Meta::CPAN

For example, to set timestamp globally
	
   d('$var', 't*');
	
For example, to unset timestamp globally
    
   '$var', 'T*');

=head1 REQUIREMENTS

B<L<PadWalker> must be installed>

In addition, the test suites require Test::Fatal, Test::More, and Test::Output
  
=head2 $d variable   

B<Your code must have a variable '$d' defined to enable the debug statements>

Exception:  C<D()> does not require the $d variable to exist.
It always prints.  See "Multiple debug levels" above.

lib/Debug/Statements.pm  view on Meta::CPAN

=item *
Windows 5.20

=back

=head1 GORY DETAILS
      
=head2 How it works

C<PadWalker::peek_my()> gets the value of $d and the contents of your variables
(from outside its scope!)  The variable values are stored in an internal hash reference

It does NOT change the values of your variables.

C<caller()[3]> gets the name of subroutine which encloses your code

C<Data::Dumper> pretty-prints the contents of your variable

=head2 Performance

For performance-critical applications,
frequent calls to C<PadWalker::peek_my()> and C<caller()> may be too intensive

=head3 Solutions

=over

=item *
Globally disable all functionality by calling C<Debug::Statements::disable();>
The PadWalker and caller functions will not be called.  Debug statements will not be printed.

=item *
OR comment out some of your calls to C<d()> within performance-critical loops

=item *
OR completely disable this code is to define you own empty d() subroutines.

    #use Debug::Statements qw(d d2);
    sub d{}; sub d2{};

t/DebugStatementsTest.t  view on Meta::CPAN

my $rh    = qr($header${vr}${h}); # hash
my $rhd2  = qr($header2${vr}${h}); # hash with DEBUG2
my $rh1   = qr($header${vr}\{ 'one' => 2, 'three' => 4 \});  # uncompressed
my $rhe   = qr($header${vr}.*\d+.*\s+${h}); # hash with number of elements
my $rhs   = qr($header${vr}${h}); # hash sorted

if ( runtests('use') ) {
    use_ok('Test::More') or die; 
    use_ok('Test::Fatal') or die; 
    use_ok('Test::Output') or die; 
    use_ok('PadWalker') or die; 
    use_ok('Debug::Statements') or die; 
}

# All these are equivalent:
#     tdd { d('$scalar')  } $exp, 'scalar';
#     tsub 'd', '$scalar', $exp, '';
#     td '$scalar', $exp, '';

# These subs are listed early so that they can be used without parentheses
# td() is the easiest to use since it assumes d() with one argument.  Internally it calls tsub().  td0() td1() td2() also call tsub().