BFD - Impromptu dumping of data structures for debugging purposes

BFD documentation Contained in the BFD distribution.

Index

Code Index:

NAME

Top

  BFD - Impromptu dumping of data structures for debugging purposes

SYNOPSIS

Top

   my $scary_structure1 = foo();
   my $scary_structure2 = bar();
   use BFD; d $scary_structure1, " hmmm ", $scary_structure2, ...;
   ....

DESCRIPTION

Top

Allows for impromptu dumping of output to STDERR. Useful when you want to take a peek at a nest Perl data structure by emitting (relatively) nicely formatted output with filename and line number prefixed to each line.

Basically,

    use BFD;d $foo;

is shorthand for

    use Data::Dumper;
    local $Data::Dumper::Indent    = 1;
    local $Data::Dumper::Quotekeys = 0;
    local $Data::Dumper::Terse     = 1;
    local $Data::Dumper::Sortkeys  = 1;
    my $msg = Dumper( $foo );
    $msg =~ s/^/$where: /mg;
    warn $msg;

I use this incantation soooo often that a TLA version is warranted. YMMV.

LIMITATIONS

Top

Uses Data::Dumper, which has varying degrees of stability and usefulness on different versions of perl.

AUTHOR

Top

Barrie Slaymaker <barries@slaysys.com>

COPYRIGHT

Top

Copyright (c) 2003, Barrie Slaymaker. All Rights Reserved.

LICENSE

Top

You may use this software under the terms of the GNU Public License, the Artistic License, the BSD license, or the MIT license.

Good luck and God Speed.

BFD documentation Contained in the BFD distribution. 
package BFD;

$VERSION = 0.31;


use strict;
use Cwd qw( cwd );
use File::Spec;

sub import {
    no strict 'refs';
    *{caller() . "::d"} = \&d;
}


sub dump_ref {
    require Data::Dumper;
    local $Data::Dumper::Indent    = 1;
    local $Data::Dumper::Quotekeys = 0;
    local $Data::Dumper::Terse     = 1;
    local $Data::Dumper::Sortkeys  = 1;
    Data::Dumper::Dumper( @_ )
}


my $start_dir;  ## Captured at compile time to use for shortening prefixes
BEGIN {
    $start_dir = cwd;
};

use vars qw( $LineNumberWidth );

$LineNumberWidth = 4;

sub format_msg {
    my ( $fn, $ln ) = ( shift, shift );

    ## Line number fields never get narrower so that you don't
    ## get output that's all jaggy.
    $LineNumberWidth = length $ln if length $ln > $LineNumberWidth;

    if ( File::Spec->file_name_is_absolute( $fn ) ) {
        if ( $fn =~ s/.*\b(site_perl)\b/$1/ ) {
            ## Should use Config.pm's list of perl dirs, but hack for now
        }
        else {
            my $rel_fn = File::Spec->abs2rel( $fn, $start_dir );
            if ( 0 == index $rel_fn, File::Spec->updir ) {
                $fn = $rel_fn;
            }
        }
    }


    my $where = sprintf "%s, %${LineNumberWidth}d:", $fn, $ln;

    my $msg = join "", map {
        ( my $out = $_ ) =~ s/^/$where/gm;
        $out;
    } join "", map
        ! defined $_ ? "undef"
        : ref $_     ? dump_ref $_
                     : $_,
    @_;

    1 while chomp $msg;
    return $msg;
}


sub d {
    warn format_msg( (caller)[1,2], @_ );
}


sub d_to {
    my $fh = shift;
    print $fh format_msg( (caller)[1,2], @_ );
}


sub d_to_string {
    format_msg( (caller)[1,2], @_ );
}



1 ;