package BFD;

$VERSION = 0.31;

=head1 NAME

  BFD - Impromptu dumping of data structures for debugging purposes

=head1 SYNOPSIS

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

=head1 DESCRIPTION

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.

=cut

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], @_ );
}


=head1 LIMITATIONS

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

=head1 AUTHOR

Barrie Slaymaker <barries@slaysys.com>

=head1 COPYRIGHT

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

=head1 LICENSE

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.

=cut

1 ;