DBG - A collection of debugging functions


    version v0.4.1


      package Foo::Bar::Baz;
      use DBG;
      dbg "log this $message";
      png;                  # do I ever get here?
      trc;                  # how did I get here?
      dmp $obj;             # what is this?
      cyc $obj;             # does this have reference cycles?
      my $ts = ts;          # get me the current time
      rt $ts, ts;           # how long did that take?
      prp "is it so", $val; # prints message plus "yes" or "no"
      pkg $obj, 'doit';     # prints package providing obj's doit method


    This is just a collection of functions useful for debugging. Instead of

      use Data::Dumper;
      use B::Deparse;
      use Devel::Size qw(total_size);

    and so forth you can just type

      use DBG;

    at the top of the script. If you're using git, or another version
    control system with similar functionality, you can write a simple
    pre-commit hook to prevent yourself from committing debugging lines to
    the repository. Once you've deleted the use DBG; line you can find all
    the other stuff you may have left in by trying to compile the code and
    looking at the errors.

    All functions have short names to make debugging quick(er).

    All debugging messages are printed both to the screen and to a log. The
    log will be ~/DBG.log unless otherwise specified. See $ENV{DBG_LOG}.
    This facilitates examining debugging output at one's leisure without
    having to visually cull away any other output produced by the program.

    All debugging functions are exported by default.

    A timestamp will be printed before any debugging output to facilitate
    distinguising one debugging session from another.


 ts(;$) -- "get timestamp"

    Returns a DateTime-based timestamp. The optional argument is a label
    for the timestamp. The label will be accessible via the timestamp's
    text method.

      my $t = ts 'foo';
      say $t->text;  # foo
      say $t;        # 2014-05-31T22:31:52

 rt($$) -- "report timestamp"

    Report time difference. This function expects two objects generated by
    the ts function, the earlier first. It returns the second timestamp to
    facilitate the

       my $ts = ts;
       # some code
       $ts = rt $ts, ts


    The report will vary according to whether the first timestamp holds a

      my $t1 = ts 'foo';
      my $t2 = rt $t1, ts 'bar';
      sleep 1;
      my $t3 = rt $t2, ts;
      sleep 61;
      rt $t3, ts;
      # timestamp foo
      #     negligible time elapsed
      # timestamp bar
      #     1 second
      # 1 minute
      # 1 second

 trc() -- "trace"

    Prints a stack trace, skipping its own frame. Each line of the trace is
    formatted as

      frame number) code name (file:line)

    This involves munging the frames as returned by caller so instead of
    saying "you got here when called from here" it says simply "you are
    here". The next line says how you got here. That is, the code name is
    the name of the code you're in, not the code that just called you. I
    simply find this easier to follow.

      sub foo   { bar() }
      sub bar   { baz() }
      sub baz   { plugh() }
      sub plugh { trc }
      # TRACE
      # 1) main::plugh (
      # 2) main::baz (
      # 3) main::bar (
      # 4) main::foo (
      # END TRACE

 dmp($) -- "dump"

    Prints a pretty data dump. This uses a combination of Perl::Tidy and

      my $r = { a => [qw(1 2 3)], c => { d => undef, egg => [ {}, {} ] } };
      dmp $r;
      # {
      #     a => [ '1', '2', '3' ],
      #     c => {
      #         d   => undef,
      #         egg => [ {}, {} ]
      #     }
      # }

 dbg($) -- "debug"

    Prints a message to the debugging log.

      dbg 'foo';  # foo

 png(;$) -- "ping"

    Prints a ping message to the debugging log. If optional argument is
    true, just prints "in code <code name> -- <optional arg>", where code
    name is the name of the function or method minus the package. If the
    optional argument is just "1", it is not suffixed to the ping message.

      sub foo { png }
      sub bar { png 1 }
      sub baz { png 'la la la la la' }
      # PING main::foo (
      # in code bar
      # in code baz -- la la la la la

 cyc($) -- "cycles"

    Checks for cycles in a reference, teeing out the entire object graph.
    This is like a condensed dump concerning itself only with references.

      my $a = {};
      my $b = { b => $a };
      my $c = { c => $b };
      $a->{a} = $c;
      cyc $a;
      # HASH (140416464744656 <- base)
      #    HASH (140416464745304 <- 140416464744656)
      #       HASH (140416464744992 <- 140416464745304)
      #          HASH (140416464744656 <- 140416464744992) -- ref count: 2

 prp($$) -- "property"

    Takes a message and a scalar to be evaluated as a boolean and submits
    this to dbg as "$message? yes/no".

      prp 'true', 1;
      prp 'true', 0;
      # true? yes
      # true? no

 cnm($;$) -- "code name"

      cnm $ua->can('request');  # LWP::UserAgent::request

    Converts a code reference to the place in the source code it comes
    from. This uses B::svref_2object to do its magic. Sometimes it will
    provide the file and line number, sometimes not.

    If the optional second parameter is provided, the information is only
    returned, not teed out.

 pkg($$;$) -- "package"

    Determines the package providing a method to an object. The first
    parameter is the object and the second the method name. Unless the
    optional third parameter is true, the file and line are also provided.

      my $d = DateTime->now;
      pkg $d, 'ymd';
      # package: DateTime; file: /Users/houghton/perl5/lib/perl5/darwin-thread-multi-2level/; line: 820
      pkg $d, 'ymd', 1;
      # DateTime

 sz($;$) -- "size"

    Tees out the size of a scalar. If two arguments are given, the first is
    taken as a label and the second the scalar.

      sz {};         # 128
      sz 'foo', {};  # foo 128

    This delegates to the total_size function in Devel::Size. If you do not
    have Devel::Size, the sz will only emit a warning that it requires

 mtd($;$) -- "method"

    Dumps out a sorted list of the object's method names, fully qualified.
    If the optional parameter is provided, it also lists where the code for
    each method can be found.

      my $d = DateTime->now;
      mtd $d;
      # Class: DateTime
      # [
      #     'DateTime::DefaultLanguage',
      #     'DateTime::DefaultLocale',
      #     'DateTime::INFINITY',
      #     'DateTime::MAX_NANOSECONDS',
      #     ...                           # many lines omitted
      # ]
      mtd $d, 1;
      # Class: DateTime
      # DefaultLanguage                 : /Users/houghton/perl5/lib/perl5/darwin-thread-multi-2level/  106
      # DefaultLocale                   : /Users/houghton/perl5/lib/perl5/darwin-thread-multi-2level/  106
      # INFINITY                        : /Users/houghton/perl5/lib/perl5/  30
      # MAX_NANOSECONDS                 : /Users/houghton/perl5/lib/perl5/darwin-thread-multi-2level/Class/MOP/Mixin/  131
      # ...

 inh($) -- "inheritance"

    Takes an object or class and prints out a sorted list of all the
    classes in that object or class's inheritance tree.

      package Plugh;
      package Foo;
      our @ISA = qw(Plugh);
      package Bar;
      package Baz;
      our @ISA = qw(Foo Bar);
      package main;
      inh 'Baz';
      # Classes in the inheritance hierarchy of Baz:
      #   Bar
      #   Baz
      #   Foo
      #   Plugh

 dpr -- "deparse"

    Takes a code reference and any optional parameters to pass to
    B::Deparse. Tees out the result of deparsing this reference.

      my $foo = sub { print "foo\n" };
      dpr $foo;    # what is this mystery code ref?
      # {
      #     use warnings;
      #     use strict 'refs';
      #     print "foo\n";
      # }

 flt($;$) -- "flatten"

    Takes a parameter and flattens it. For an ordinary scalar this just
    means it returns it. For containers -- hash or array references -- it
    returns copies with flattened values. Anything blessed it stringifies.

      flt { bar => 1, baz => DateTime->now };
      # {
      #     'bar' => 1,
      #     'baz' => '2014-05-31T21:04:07'
      # };

    This is useful for dumping hashes containing huge objects whose innards
    you don't need to see.

    If the optional second parameter is provided, the information is only
    returned, not also dumped out via dmp.



    If the DBG_LOG environment variable is set and is not equal to 0, this
    will be understood as the file into which debugging output should be
    dumped. If it is set to 0, the debugging output will only be sent to
    STDERR. If it is undefined, the log will be ~/DBG.log.


    If the DBG_ON environment variable is set, its boolean value will be
    used to determine the value of $DBG::ON.


    If the DBG_HEADER environment variable is set, its boolean value will
    be used to determine the value of $DBG::HEADER.


    If $DBG::ON is true, which it is by default, all debugging code is
    executed. If it is false, debugging code is ignored (aside from the
    initial timestamp). The state of $ON can be manipulated
    programmatically or set by the $ENV{DBG_ON} environment variable. This
    can be used to constrain debugging output to a particular section of a
    program. For instance, one may set debugging to off and then locally
    set it to one within a particular method.

      sub foo {
          local $DBG::ON = 1;
          my self = shift;


    Unless $DBG::HEADER is false, a timestamp and process ID will be logged
    for a debugging process. The header is not printed until the first
    debugging line is logged, so this need not be set in a BEGIN block.


    You probably don't want debugging code, at least not that associated
    with DBG, getting into your repository. Here's a sample git pre-commit
    hook script for screening it out:

      my $rx = qr/
        ( (?&line){0,3} (?&dbg) (?&line){0,3} )
          (?<line> ^.*?(?:\R|\z) )
          (?<dbg>  ^\+\s*use\s+DBG\b.*?(?:\R|\z) )
      my $text = `git diff --staged`;
      if ( my @matches = $text =~ /$rx/g ) {
          @matches = grep defined, @matches;
          exit 0 unless @matches;
          print STDERR "DBG lines: \n\n" . join "\n", @matches;
          print STDERR "\nRun with --no-verify if you want to skip the DBG check.\n";
          print STDERR "Aborting commit.\n";
          exit 1;
      exit 0;


    Grant Street Group <>


    This software is Copyright (c) 2014 - 2020 by Grant Street Group.

    This is free software, licensed under:

      The Artistic License 2.0 (GPL Compatible)