1package BFD;
2
3$VERSION = 0.31;
4
5=head1 NAME
6
7  BFD - Impromptu dumping of data structures for debugging purposes
8
9=head1 SYNOPSIS
10
11   my $scary_structure1 = foo();
12   my $scary_structure2 = bar();
13   use BFD; d $scary_structure1, " hmmm ", $scary_structure2, ...;
14   ....
15
16=head1 DESCRIPTION
17
18Allows for impromptu dumping of output to STDERR.  Useful when you want
19to take a peek at a nest Perl data structure by emitting (relatively)
20nicely formatted output with filename and line number prefixed to each line.
21
22Basically,
23
24    use BFD;d $foo;
25
26is shorthand for
27
28    use Data::Dumper;
29    local $Data::Dumper::Indent    = 1;
30    local $Data::Dumper::Quotekeys = 0;
31    local $Data::Dumper::Terse     = 1;
32    local $Data::Dumper::Sortkeys  = 1;
33    my $msg = Dumper( $foo );
34    $msg =~ s/^/$where: /mg;
35    warn $msg;
36
37I use this incantation soooo often that a TLA version is warranted.
38YMMV.
39
40=cut
41
42use strict;
43use Cwd qw( cwd );
44use File::Spec;
45
46sub import {
47    no strict 'refs';
48    *{caller() . "::d"} = \&d;
49}
50
51
52sub dump_ref {
53    require Data::Dumper;
54    local $Data::Dumper::Indent    = 1;
55    local $Data::Dumper::Quotekeys = 0;
56    local $Data::Dumper::Terse     = 1;
57    local $Data::Dumper::Sortkeys  = 1;
58    Data::Dumper::Dumper( @_ )
59}
60
61
62my $start_dir;  ## Captured at compile time to use for shortening prefixes
63BEGIN {
64    $start_dir = cwd;
65};
66
67use vars qw( $LineNumberWidth );
68
69$LineNumberWidth = 4;
70
71sub format_msg {
72    my ( $fn, $ln ) = ( shift, shift );
73
74    ## Line number fields never get narrower so that you don't
75    ## get output that's all jaggy.
76    $LineNumberWidth = length $ln if length $ln > $LineNumberWidth;
77
78    if ( File::Spec->file_name_is_absolute( $fn ) ) {
79        if ( $fn =~ s/.*\b(site_perl)\b/$1/ ) {
80            ## Should use Config.pm's list of perl dirs, but hack for now
81        }
82        else {
83            my $rel_fn = File::Spec->abs2rel( $fn, $start_dir );
84            if ( 0 == index $rel_fn, File::Spec->updir ) {
85                $fn = $rel_fn;
86            }
87        }
88    }
89
90
91    my $where = sprintf "%s, %${LineNumberWidth}d:", $fn, $ln;
92
93    my $msg = join "", map {
94        ( my $out = $_ ) =~ s/^/$where/gm;
95        $out;
96    } join "", map
97        ! defined $_ ? "undef"
98        : ref $_     ? dump_ref $_
99                     : $_,
100    @_;
101
102    1 while chomp $msg;
103    return $msg;
104}
105
106
107sub d {
108    warn format_msg( (caller)[1,2], @_ );
109}
110
111
112sub d_to {
113    my $fh = shift;
114    print $fh format_msg( (caller)[1,2], @_ );
115}
116
117
118sub d_to_string {
119    format_msg( (caller)[1,2], @_ );
120}
121
122
123=head1 LIMITATIONS
124
125Uses Data::Dumper, which has varying degrees of stability and usefulness
126on different versions of perl.
127
128=head1 AUTHOR
129
130Barrie Slaymaker <barries@slaysys.com>
131
132=head1 COPYRIGHT
133
134Copyright (c) 2003, Barrie Slaymaker.  All Rights Reserved.
135
136=head1 LICENSE
137
138You may use this software under the terms of the GNU Public License, the
139Artistic License, the BSD license, or the MIT license.
140
141Good luck and God Speed.
142
143=cut
144
1451 ;
146