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