1#======================================================================== 2# 3# Badger::Debug 4# 5# DESCRIPTION 6# Mixin module implementing functionality for debugging. 7# 8# AUTHOR 9# Andy Wardley <abw@wardley.org> 10# 11#======================================================================== 12 13package Badger::Debug; 14 15use Carp; 16use Badger::Rainbow 17 ANSI => 'bold red yellow green cyan white'; 18use Scalar::Util qw( blessed refaddr ); 19use Badger::Class 20 base => 'Badger::Exporter', 21 version => 0.01, 22 constants => 'PKG REFS SCALAR ARRAY HASH CODE REGEX DELIMITER', 23 words => 'DEBUG', 24 import => 'class', 25 constant => { 26 UNDEF => '<undef>', 27 }, 28 exports => { 29 tags => { 30 debug => 'debugging debug debugf debug_up debug_at debug_caller 31 debug_callers debug_args', 32 dump => 'dump dump_data dump_data_inline 33 dump_ref dump_hash dump_list dump_text' 34 }, 35 hooks => { 36 color => \&enable_colour, 37 colour => \&enable_colour, 38 dumps => [\&_export_debug_dumps, 1], # expects 1 arguments 39 default => [\&_export_debug_default, 1], 40 modules => [\&_export_debug_modules, 1], 41 'DEBUG' => [\&_export_debug_constant, 1], 42 '$DEBUG' => [\&_export_debug_variable, 1], 43 }, 44 }; 45 46our $PAD = ' '; 47our $MAX_TEXT = 48; 48our $MAX_DEPTH = 3; # prevent runaways in debug/dump 49our $FORMAT = "[<where> line <line>]\n<msg>" 50 unless defined $FORMAT; 51our $PROMPT = '> ' 52 unless defined $PROMPT; 53our $MESSAGE = "$PROMPT%s"; 54our $HIDE_UNDER = 1; 55our $CALLER_UP = 0; # hackola to allow debug() to use a different caller 56our $CALLER_AT = { }; # ditto 57our $DUMPING = { }; 58our $DEBUG = 0 unless defined $DEBUG; 59our $DUMP_METHOD = 'dump'; 60 61#----------------------------------------------------------------------- 62# export hooks 63#----------------------------------------------------------------------- 64 65sub _export_debug_dumps { 66 my ($self, $target, $symbol, $value, $symbols) = @_; 67 $self->export_symbol($target, dumper => sub { 68 $_[0]->dump_hash($_[0],$_[1],$value); 69 }); 70 unshift(@$symbols, ':dump'); 71 return $self; 72} 73 74 75sub _export_debug_default { 76 my ($self, $target, $symbol, $value, $symbols) = @_; 77 unshift( 78 @$symbols, 79 '$DEBUG' => $value, 80 'DEBUG' => $value, 81 'debug', 82 'debugging' 83 ); 84 return $self; 85} 86 87 88sub _export_debug_variable { 89 my ($self, $target, $symbol, $value) = @_; 90 no strict REFS; 91 92 # use any existing value in $DEBUG 93 $value = ${ $target.PKG.DEBUG } 94 if defined ${ $target.PKG.DEBUG }; 95 96 $self->debug("$symbol option setting $target \$DEBUG to $value\n") if $DEBUG; 97 *{ $target.PKG.DEBUG } = \$value; 98} 99 100 101sub _export_debug_constant { 102 my ($self, $target, $symbol, $value) = @_; 103 no strict REFS; 104 105 # use any existing value in $DEBUG 106 $value = ${ $target.PKG.DEBUG } 107 if defined ${ $target.PKG.DEBUG }; 108 109 $self->debug("$symbol option setting $target DEBUG to $value\n") if $DEBUG; 110 my $temp = $value; # make sure this is a const sub on 5.22 111 *{ $target.PKG.DEBUG } = sub () { $temp }; 112} 113 114 115sub _export_debug_modules { 116 my ($self, $target, $symbol, $modules) = @_; 117 $self->debug_modules($modules); 118} 119 120 121#----------------------------------------------------------------------- 122# exportable debugging methods 123#----------------------------------------------------------------------- 124 125sub debugging { 126 my $self = shift; 127 my $pkg = ref $self || $self; 128 no strict REFS; 129 130 # return current $DEBUG value when called without args 131 return ${ $pkg.PKG.DEBUG } || 0 132 unless @_; 133 134 # set new debug value when called with an argument 135 my $debug = shift; 136 $debug = 0 if $debug =~ /^off$/i; 137 138 # TODO: consider setting different parts of the flag, like TT2, 139 140 $self->debug("debugging() Setting $pkg debug to $debug\n") if $DEBUG; 141 142 if (defined ${ $pkg.PKG.DEBUG }) { 143 # update existing variable 144 ${ $pkg.PKG.DEBUG } = $debug; 145 } 146 else { 147 # define new variable, poking it into the symbol table using 148 # *{...} rather than ${...} so that it's visible at compile time, 149 # thus preventing any "Variable $DEBUG not defined errors 150 *{ $pkg.PKG.DEBUG } = \$debug; 151 } 152 return $debug; 153} 154 155 156sub debug { 157 my $self = shift; 158 my $msg = join('', @_), 159 my $class = ref $self || $self; 160 my $format = $CALLER_AT->{ format } || $FORMAT; 161 my ($pkg, $file, $line) = caller($CALLER_UP); 162 my (undef, undef, undef, $sub) = caller($CALLER_UP + 1); 163 if (defined $sub) { 164 $sub =~ s/.*?([^:]+)$/::$1()/; 165 } 166 else { 167 $sub = ''; 168 } 169 my $where = ($class eq $pkg) 170 ? $class . $sub 171 : $pkg . $sub . " ($class)"; 172 173 $msg = join("\n", map { sprintf($MESSAGE, $_) } split("\n", $msg)); 174# $msg =~ s/^/$PROMPT/gm; 175 176 # We load this dynamically because it uses Badger::Debug and we don't 177 # want to end up in a gruesome birth spiral 178 require Badger::Timestamp; 179 my $now = Badger::Timestamp->now; 180 my $data = { 181 msg => $msg, 182 where => $where, 183 class => $class, 184 file => $file, 185 line => $line, 186 pkg => $pkg, 187 sub => $sub, 188 date => $now->date, 189 time => $now->time, 190 pid => $$, 191 %$CALLER_AT, 192 }; 193 $format =~ s/<(\w+)>/defined $data->{ $1 } ? $data->{ $1 } : "<$1 undef>"/eg; 194 $format .= "\n" unless $format =~ /\n$/; 195 196 print STDERR $format; 197} 198 199 200sub debugf { 201 local $CALLER_UP = 1; 202 shift->debug( sprintf(shift, @_) ); 203} 204 205 206sub debug_up { 207 my $self = shift; 208 local $CALLER_UP = shift; 209 $self->debug(@_); 210} 211 212 213sub debug_at { 214 my $self = shift; 215 local $CALLER_AT = shift; 216 local $CALLER_UP = 1; 217 $self->debug(@_); 218} 219 220 221sub debug_caller { 222 my $self = shift; 223 my ($pkg, $file, $line, $sub) = caller(1); 224 my $msg = "$sub called from "; 225 ($pkg, undef, undef, $sub) = caller(2); 226 $msg .= "$sub in $file at line $line\n"; 227 $self->debug($msg); 228} 229 230 231sub debug_callers { 232 my $self = shift; 233 my $msg = ''; 234 my $i = 1; 235 236 while (1) { 237 my @info = caller($i); 238 last unless @info; 239 my ($pkg, $file, $line, $sub) = @info; 240 $msg .= sprintf( 241 "%4s: Called from %s in %s at line %s\n", 242 '#' . $i++, $sub, $file, $line 243 ); 244 } 245 $self->debug($msg); 246} 247 248 249sub debug_args { 250 my $self = shift; 251 $self->debug_up( 252 2, "args: ", 253 join(', ', map { $self->dump_data_inline($_) } @_), 254 "\n" 255 ); 256} 257 258 259sub debug_modules { 260 my $self = shift; 261 my $modules = @_ == 1 ? shift : [ @_ ]; 262 my $debug = 1; 263 264 $modules = [ split(DELIMITER, $modules) ] 265 unless ref $modules eq ARRAY; 266 267 # TODO: handle other refs? 268 269 foreach my $pkg (@$modules) { 270 no strict REFS; 271 *{ $pkg.PKG.DEBUG } = \$debug; 272 } 273} 274 275 276#----------------------------------------------------------------------- 277# data dumping methods 278#----------------------------------------------------------------------- 279 280sub dump { 281 my $self = shift; 282 my $code = $self->can('dumper'); 283 return $code 284 ? $code->($self, @_) 285 : $self->dump_ref($self, @_); 286} 287 288 289sub dump_data { 290 local $DUMPING = { }; 291 _dump_data(@_); 292} 293 294 295sub _dump_data { 296 if (! defined $_[1]) { 297 return UNDEF; 298 } 299 elsif (! ref $_[1]) { 300 return $_[1]; 301 } 302 elsif (blessed($_[1]) && (my $code = $_[1]->can($DUMP_METHOD))) { 303 shift; # remove $self object, leave target object first 304 return $code->(@_); 305 } 306 else { 307 goto &dump_ref; 308 } 309} 310 311 312sub dump_ref { 313 my ($self, $data, $indent) = @_; 314 return "<$data>" if $DUMPING->{ $data }++; 315 316 # TODO: change these to reftype 317 if (UNIVERSAL::isa($data, HASH)) { 318 return dump_hash($self, $data, $indent); 319 } 320 elsif (UNIVERSAL::isa($data, ARRAY)) { 321 return dump_list($self, $data, $indent); 322 } 323 elsif (UNIVERSAL::isa($data, REGEX)) { 324 return dump_text($self, $data); 325 } 326 elsif (UNIVERSAL::isa($data, SCALAR)) { 327 return dump_text($self, $$data); 328 } 329 else { 330 return $data; 331 } 332} 333 334 335sub dump_data_inline { 336 local $PAD = ''; 337 my $text = shift->dump_data(@_); 338 $text =~ s/\n/ /g; 339 return $text; 340} 341 342 343sub dump_hash { 344 my ($self, $hash, $indent, $keys) = @_; 345 $indent ||= 0; 346 return "..." if $indent > $MAX_DEPTH; 347 my $pad = $PAD x $indent; 348 349 return '{ }' unless $hash && %$hash; 350 351 if ($keys) { 352 $keys = [ split(DELIMITER, $keys) ] 353 unless ref $keys; 354 $keys = { map { $_ => 1 } @$keys } 355 if ref $keys eq ARRAY; 356 return $self->error("Invalid keys passed to dump_hash(): $keys") 357 unless ref $keys eq HASH; 358 359 $self->debug("constructed hash keys: ", join(', ', %$keys)) if $DEBUG; 360 } 361 362 return "\{\n" 363 . join( ",\n", 364 map { "$pad$PAD$_ => " . _dump_data($self, $hash->{$_}, $indent + 1) } 365 sort 366 grep { $keys ? $keys->{ $_ } : 1 } 367 grep { (/^_/ && $HIDE_UNDER) ? 0 : 1 } 368 keys %$hash 369 ) 370 . "\n$pad}"; 371} 372 373 374sub dump_list { 375 my ($self, $list, $indent) = @_; 376 $indent ||= 0; 377 my $pad = $PAD x $indent; 378 379 return '[ ]' unless @$list; 380 return "\[\n$pad$PAD" 381 . ( @$list 382 ? join(",\n$pad$PAD", map { _dump_data($self, $_, $indent + 1) } @$list) 383 : '' ) 384 . "\n$pad]"; 385} 386 387 388sub dump_text { 389 my ($self, $text, $length) = @_; 390 $text = $$text if ref $text; 391 $length ||= $MAX_TEXT; 392 my $snippet = substr($text, 0, $length); 393 $snippet .= '...' if length $text > $length; 394 $snippet =~ s/\n/\\n/g; 395 return $snippet; 396} 397 398 399 400#----------------------------------------------------------------------- 401# enable_colour() 402# 403# Export hook which gets called when the Badger::Debug module is 404# used with the 'colour' or 'color' option. It redefines the formats 405# for $Badger::Base::DEBUG_FORMAT and $Badger::Exception::FORMAT 406# to display in glorious ANSI technicolor. 407#----------------------------------------------------------------------- 408 409sub enable_colour { 410 my ($class, $target, $symbol) = @_; 411 $target ||= (caller())[0]; 412 $symbol ||= 'colour'; 413 414 print bold green "Enabling debug in $symbol from $target\n"; 415 416 # colour the debug format 417 $MESSAGE = cyan($PROMPT) . yellow('%s'); 418 $FORMAT 419 = cyan('[<where> line <line>]') 420 . "\n<msg>"; 421 422 # exceptions are in red 423 $Badger::Exception::FORMAT 424 = bold red $Badger::Exception::FORMAT; 425 426 $Badger::Exception::MESSAGES->{ caller } 427 = yellow('<4>') . cyan(' called from ') 428 . yellow("<1>\n") . cyan(' in ') 429 . white('<2>') . cyan(' at line ') 430 . white('<3>'); 431} 432 433 434 4351; 436 437__END__ 438 439=head1 NAME 440 441Badger::Debug - base class mixin module implement debugging methods 442 443=head1 SYNOPSIS 444 445 package Your::Module; 446 447 use Badger::Debug 448 default => 0; # default value for $DEBUG and DEBUG 449 450 sub some_method { 451 my $self = shift; 452 453 # DEBUG is a compile-time constant, so very efficient 454 $self->debug("First Message") if DEBUG; 455 456 # $DEBUG is a runtime variable, so more flexible 457 $self->debug("Second Message") if $DEBUG; 458 } 459 460 package main; 461 use Your::Module; 462 463 Your::Module->some_method; # no output, debugging off by default 464 Your::Module->debugging(1); # turns runtime debugging on 465 Your::Module->some_method; # [Your::Module line 13] Second Message 466 467=head1 DESCRIPTION 468 469This mixin module implements a number of methods for debugging. Read L<The 470Whole Caboodle> if you just want to get started quickly. Read L<Picky Picky 471Picky> if you want to get all picky about what you want to use or want more 472information on the individual features. 473 474Note that all of the debugging methods described below work equally well as 475both object and class methods even if we don't explicitly show them being 476used both ways. 477 478 # class method 479 Your::Module->debug('called as a class method'); 480 481 # object method 482 my $object = Your::Module->new; 483 $object->debug('called as an object method'); 484 485=head2 The Whole Caboodle 486 487The L<default> import option is the all-in-one option that enables all 488debugging features. The value you specify with it will be used as the default 489debugging status. Use C<0> if you want debugging off by default, or any true 490value if you want it on. 491 492 package Your::Module; 493 494 use Badger::Debug 495 default => 0; 496 497The L<default> option imports the L<debug()> and L<debugging()> methods, 498the L<$DEBUG> package variable (set to the default value you specified 499unless it's already defined to be something else), and the L<DEBUG> 500constant subroutine (defined to have the same value as the L<$DEBUG> 501variable). 502 503In your module's methods you can call the L<debug()> method to generate 504debugging messages. You can use the L<DEBUG> constant or the L<$DEBUG> 505variable as a condition so that messages only get displayed when debugging is 506enbled. 507 508 sub some_method { 509 my $self = shift; 510 511 # DEBUG is a compile-time constant, so very efficient 512 $self->debug("First Message") if DEBUG; 513 514 # $DEBUG is a runtime variable, so more flexible 515 $self->debug("Second Message") if $DEBUG; 516 } 517 518The L<DEBUG> constant is resolved at compile time so it results in more 519efficient code. When debugging is off, Perl will completely eliminate the 520first call to the L<debug()> method in the above example. The end result 521is that there's no performance overhead incurred by including debugging 522statements like these. 523 524The L<$DEBUG> package variable is a little more flexible because you can 525change the value at any point during the execution of your program. You might 526want to do this from inside the module (say to enable debugging in one 527particular method that's causing problems), or outside the module from a 528calling program or another module. The L<debugging()> method is provided 529as a convenient way to change the C<$DEBUG> package variable for a module. 530 531 Your::Module->debugging(0); # turn runtime debugging off 532 Your::Module->debugging(1); # turn runtime debugging on 533 534The downside is that checking the L<$DEBUG> variable at runtime is less 535efficient than using the L<DEBUG> compile time constant. Unless you're working 536on performance critical code, it's probably not something that you should 537worry about. 538 539However, if you are the worrying type then you can use C<Badger::Debug> 540to get some of the best bits of both worlds. When your module is loaded, 541both L<DEBUG> and L<$DEBUG> will be set to the default value you specified 542I<< unless C<$DEBUG> is already defined >>. If it is defined then the 543L<DEBUG> constant will be set to whatever value it has. So if you define 544the L<$DEBUG> package variable I<before> loading the module then you'll 545be able to enable both run time and compile time debugging messages without 546having to go and edit the source code of your module. 547 548 $Your::Module::DEBUG = 1; 549 require Your::Module; 550 551Alternately, you can let C<Badger::Debug> do it for you. The L<modules> 552import option allows you to specify one or more modules that you want 553debugging enabled for. 554 555 use Badger::Debug 556 modules => 'My::Module::One My::Module::Two'; 557 558 use My::Module::One; # both runtime and compile time 559 use My::Module::Two; # debugging enabled in both modules 560 561The benefit of this approach is that it happens at compile time. 562If you do it I<before> you C<use> your modules, then you'll get 563both compile time and run time debugging enabled. If you do it after 564then you'll get just runtime debugging enabled. Best of all - you don't 565need to change any of your existing code to load modules via C<require> 566instead of C<use> 567 568=head2 Picky Picky Picky 569 570The C<Badger::Debug> module allow you to be more selective about what 571you want to use. This section described the individual debugging methods 572and the L<DEBUG> and L<$DEBUG> flags that can be used to control debugging. 573 574In the simplest case, you can import the L<debug()> method into your own 575module for generating debugging messages. 576 577 package Your::Module; 578 use Badger::Debug 'debug'; 579 580 sub some_method { 581 my $self = shift; 582 $self->debug("Hello from some_method()"); 583 } 584 585In most cases you'll want to be able to turn debugging messages on and off. 586You could do something like this: 587 588 # initialise $DEBUG if it's not already set 589 our $DEBUG = 0 unless defined $DEBUG; 590 591 sub some_method { 592 my $self = shift; 593 $self->debug("Hello from some_method()") if $DEBUG; 594 } 595 596If you use the C<unless defined $DEBUG> idiom shown in the example shown above 597then it will also allow you to set the C<$DEBUG> flag I<before> your module is 598loaded. This is particularly useful if the module is auto-loaded on demand by 599another module or your own code. 600 601 # set $DEBUG flag for your module 602 $Your::Module::DEBUG = 1; 603 604 # later... 605 require Your::Module; # debugging is enabled 606 607You can also achieve the same effect at compile time using the 608C<Badger::Debug> L<modules> export option. 609 610 use Badger::Debug 611 modules => 'Your::Module'; # sets $Your::Module::DEBUG = 1 612 use Your::Module; # debugging is enabled 613 614The advantage of using the L<$DEBUG> package variable is that you can change 615the value at any point to turn debugging on or off. For example, if you've got 616a section of code that requires debugging enabled to track down a particular 617bug then you can write something like this: 618 619 sub gnarly_method { 620 my $self = shift; 621 622 local $DEBUG = 1; 623 $self->debug("Trying to track down the cause bug 666"); 624 625 # the rest of your code... 626 $self->some_method; 627 } 628 629Making the change to C<$DEBUG> C<local> means that it'll only stay set to C<1> 630until the end of the C<gnarly_method()>. It's a good idea to add a debugging 631message any time you make temporary changes like this. The message generated 632will contain the file and line number so that you can easily find it later 633when the bug has been squashed and either comment it out (for next time) or 634remove it. 635 636The C<Badger::Debug> module has a L<$DEBUG> export hook which will define the 637the C<$DEBUG> variable for you. The value you provide will be used as the 638default for C<$DEBUG> if it isn't already defined. 639 640 package Your::Module; 641 642 use Badger::Debug 643 'debug', 644 '$DEBUG' => 0; 645 646 sub some_method { 647 my $self = shift; 648 $self->debug("Hello from some_method()") if $DEBUG; 649 } 650 651The L<debugging()> method can also be imported from C<Badger::Debug>. This 652provides a simple way to set the L<$DEBUG> variable. 653 654 Your::Module->debugging(1); # debugging on 655 Your::Module->debugging(0); # debugging off 656 657The downside to using a package variable is that it slows your code down 658every time you check the L<$DEBUG> flag. In all but the most extreme cases, 659this should be of no concern to you whatsoever. Write your code in the way 660that is most convenient for you, not the machine. 661 662B<WARNING:> Do not even begin to consider entertaining the merest thought of 663optimising your code to make it run faster until your company is on the verge 664of financial ruin due to your poorly performing application and your boss has 665told you (with confirmation in writing, countersigned by at least 3 members of 666the board of directors) that you will be fired first thing tomorrow morning 667unless you make the code run faster I<RIGHT NOW>. 668 669Another approach is to define a constant L<DEBUG> value. 670 671 package Your::Module; 672 673 use Badger::Debug 'debug'; 674 use constant DEBUG => 0; 675 676 sub some_method { 677 my $self = shift; 678 $self->debug("Hello from some_method()") if DEBUG; 679 } 680 681This is an all-or-nothing approach. Debugging is on or off and there's 682nothing you can do about it except for changing the constant definition 683in the source code and running the program again. The benefit of this 684approach is that L<DEBUG> is defined as a compile time constant. When 685L<DEBUG> is set to C<0>, Perl will effectively remove the entire debugging 686line at compile time because it's based on a premise (C<if DEBUG>) that 687is known to be false. The end result is that there's no runtime performance 688penalty whatsoever. 689 690C<Badger::Debug> also provides the L<DEBUG> hook if this is the kind of 691thing you want. 692 693 package Your::Module; 694 695 use Badger::Debug 696 'debug', 697 'DEBUG' => 0; 698 699 sub some_method { 700 my $self = shift; 701 $self->debug("Hello from some_method()") if DEBUG; 702 } 703 704What makes this extra-special is that you're only specifying the I<default> 705value for the C<DEBUG> constant. If the C<$DEBUG> package variable is defined 706when the module is loaded then that value will be used instead. So although 707it's not possible to enable or disable debugging for different parts of a 708module, you can still enable debugging for the whole module by setting the 709C<$DEBUG> package variable before loading it. 710 711 # set $DEBUG flag for your module 712 $Your::Module::DEBUG = 1; 713 714 # later... 715 require Your::Module; # debugging is enabled 716 717Here's a reminder of the other way to achieve the same thing at compile time 718using the C<Badger::Debug> L<modules> export option. 719 720 use Badger::Debug 721 modules => 'Your::Module'; # sets $Your::Module::DEBUG = 1 722 use Your::Module; # debugging is enabled 723 724You can combine the use of both L<$DEBUG> and L<DEBUG> in your code, for a 725two-level approach to debugging. The L<DEBUG> tests will always be resolved at 726compile time so they're suitable for low-level debugging that either has a 727performance impact or is rarely required. The L<$DEBUG> tests will be resolved 728at run time, so they can be enabled or disabled at any time or place. 729 730 sub some_method { 731 my $self = shift; 732 $self->debug("Hello from some_method()") if DEBUG; 733 $self->debug("Goodbye from some_method()") if $DEBUG; 734 } 735 736=head1 IMPORT OPTIONS 737 738All of the L<debugging methods|DEBUGGING METHODS> can be imported selectively 739into your module. For example: 740 741 use Badger::Debug 'debug debugging debug_caller'; 742 743The following import options are also provided. 744 745=head2 default 746 747Used to set the default debugging value and import various debugging methods 748and flags. 749 750 use Badger::Debug 751 default => 0; # debugging off by default 752 753It imports the L<debug()> and L<debugging()> methods along with the 754L<$DEBUG> package variable and L<DEBUG> constant. 755 756See L<The Whole Caboodle> for further discussion on using it. 757 758=head2 $DEBUG 759 760Used to define a C<$DEBUG> variable in your module. A default value 761should be specified which will be used to set the C<$DEBUG> value if 762it isn't already defined. 763 764 use Badger::Debug 765 '$DEBUG' => 0; # debugging off by default 766 767 print $DEBUG; # 0 768 769=head2 DEBUG 770 771Used to define a C<DEBUG> constant in your module. If the C<$DEBUG> 772package variable is defined then the C<DEBUG> constant will be set to 773whatever value it contains. Otherwise it will be set to the default 774value you provide. 775 776 use Badger::Debug 777 'DEBUG' => 0; # debugging off by default 778 779 print DEBUG; # 0 780 781=head2 modules 782 783This option can be used to set the C<$DEBUG> value true in one or more 784packages. This ensures that any debugging will be enabled in those modules. 785 786 use Badger::Debug 787 modules => 'My::Module::One My::Module::Two'; 788 789 use My::Module::One; # debugging enabled in both modules 790 use My::Module::Two; 791 792Modules that haven't yet been loaded will have both compile time (L<DEBUG>) 793and run time (L<$DEBUG>) debugging enabled. Modules that have already been 794loaded will only have run time debugging enabled. 795 796=head2 dumps 797 798This option can be used to construct a specialised L<dump()> method for 799your module. The method is used to display nested data in serialised 800text form for debugging purposes. The default L<dump()> method for an 801object will display all items stored within the object. The C<dumps> 802import option can be used to limit the dump to only display the fields 803specified. 804 805 package Your::Module; 806 use Badger::Debug dumps => 'foo bar baz'; 807 # ...more code... 808 809 package main; 810 my $object = Your::Module->new; 811 print $object->dump; # dumps foo, bar and baz 812 813=head2 colour / color 814 815Either of these (depending on your spelling preference) can be used to 816enable colourful (or colorful) debugging. 817 818 use Badger::Debug 'colour'; 819 820Debugging messages will then appear in colour (on a terminal supporting 821ANSI escape sequences). See the L<Badger::Test> module for an example 822of this in use. 823 824=head2 :debug 825 826Imports all of the L<debug()>, L<debugging()>, L<debug_up()>, 827L<debug_caller()>, L<debug_callers> and L<debug_args()> methods. 828 829=head2 :dump 830 831Imports all of the L<dump()>, L<dump_ref()>, L<dump_hash()>, L<dump_list()>, 832L<dump_text()>, L<dump_data()> and L<dump_data_inline()> methods. 833 834=head1 DEBUGGING METHODS 835 836=head2 debug($msg1, $msg2, ...) 837 838This method can be used to generate debugging messages. 839 840 $object->debug("Hello ", "World\n"); 841 842It prints all argument to STDERR with a prefix indicating the 843class name, file name and line number from where the C<debug()> method 844was called. 845 846 [Badger::Example line 42] Hello World 847 848At some point in the future this will be extended to allow you to tie in 849debug hooks, e.g. to forward to a logging module. 850 851=head2 debugf($format, $arg1, $arg2, ...) 852 853This method provides a C<printf()>-like wrapper around L<debug()>. 854 855 $object->debugf('%s is %s', e => 2.718); # e is 2.718 856 857=head2 debug_up($n, $msg1, $msg2, ...) 858 859The L<debug()> method generates a message showing the file and line number 860from where the method was called. The C<debug_up()> method can be used to 861report the error from somewhere higher up the call stack. This is typically 862used when you create your own debugging methods, as shown in the following 863example. 864 865 sub parse { 866 my $self = shift; 867 868 while (my ($foo, $bar) = $self->get_foo_bar) { 869 $self->trace($foo, $bar); # report line here 870 # do something 871 } 872 } 873 874 sub trace { 875 my ($self, $foo, $bar) = @_; 876 $self->debug_up(2, "foo: $foo bar: $bar"); # not here 877 } 878 879The C<trace()> method calls the L<debug_up()> method telling it to look I<two> 880levels up in the caller stack instead of the usual I<one> (thus 881C<debug_up(1,...)> has the same effect as C<debug(...)>). So instead of 882reporting the line number in the C<trace()> subroutine (which would be the 883case if we called C<debug(...)> or C<debug_up(1,...)>), it will correctly 884reporting the line number of the call to C<trace()> in the C<parse()> 885method. 886 887=head2 debug_at($info, $message) 888 889This method is a wrapper around L<debug()> that allows you to specify a 890different location to be added to the message generated. 891 892 $at->debug_at( 893 { 894 where => 'At the edge of time', 895 line => 420 896 }, 897 'Flying sideways' 898 ); 899 900This generates the following debug message: 901 902 [At the edge of time line 420] Flying sideways 903 904Far out, man! 905 906You can change the L<$FORMAT> package variable to define a different message 907structure. As well as the pre-defined placeholders (see the L<$FORMAT> 908documentation) you can also define your own custom placeholders like 909C<E<lt>serverE<gt>> in the following example. 910 911 $Badger::Debug::FORMAT = '<server>: <msg> at line <line> of <file>'; 912 913You must then provide values for the additional placeholder in the C<$info> 914hash array when you call the L<debug_at()> method. 915 916 $at->debug_at( 917 { server => 'Alpha' }, 918 'Normality is resumed' 919 ); 920 921You can also specify a custom format in the C<$info> hash array. 922 923 $at->debug_at( 924 { format => '<msg> at line <line> of <file>' }, 925 'Normality is resumed' 926 ); 927 928=head2 debug_caller() 929 930Prints debugging information about the current caller. 931 932 sub wibble { 933 my $self = shift; 934 $self->debug_caller; 935 } 936 937=head2 debug_callers() 938 939Prints debugging information about the complete call stack. 940 941 sub wibble { 942 my $self = shift; 943 $self->debug_callers; 944 } 945 946=head2 debug_args() 947 948Prints debugging information about the arguments passed. 949 950 sub wibble { 951 my $self = shift; 952 $self->debug_args(@_); 953 } 954 955=head2 debugging($flag) 956 957This method of convenience can be used to set the C<$DEBUG> variable for 958a module. It can be called as a class or object method. 959 960 Your::Module->debugging(1); # turn debugging on 961 Your::Module->debugging(0); # turn debugging off 962 963=head2 debug_modules(@modules) 964 965This method can be used to set the C<$DEBUG> true in one or more modules. 966Modules can be specified as a list of package names, a reference to a list, 967or a whitespace delimited string. 968 969 Badger::Debug->debug_modules('Your::Module::One Your::Module::Two'); 970 971The method is also accessible via the L<modules> import option. 972 973=head1 DATA INSPECTION METHODS 974 975These methods of convenience can be used to inspect data structures. 976The emphasis is on brevity for the sake of debugging rather than full 977blown inspection. Use L<Data::Dumper> or on of the other fine modules 978available from CPAN if you want something more thorough. 979 980The methods below are recursive, so L<dump_list()>, on finding a hash 981reference in the list will call L<dump_hash()> and so on. However, this 982recursion is deliberately limited to no more than L<$MAX_DEPTH> levels deep 983(3 by default). Remember, the emphasis here is on being able to see enough 984of the data you're dealing with, neatly formatted for debugging purposes, 985rather than being overwhelmed with the big picture. 986 987If any of the methods encounter an object then they will call its 988L<dump()> method if it has one. Otherwise they fall back on L<dump_ref()> 989to expose the internals of the underlying data type. You can create your 990own custom L<dump()> method for you objects or use the L<dumps> import 991option to have a custom L<dump()> method defined for you. 992 993=head2 dump() 994 995Debugging method which returns a text representation of the object internals. 996 997 print STDERR $object->dump(); 998 999You can define your own C<dump()> for an object and this will be called 1000whenever your object is dumped. The L<dumps> import option can be used 1001to generate a custom C<dump()> method. 1002 1003=head2 dump_ref($ref) 1004 1005Does The Right Thing to call the appropriate dump method for a reference 1006of some kind. 1007 1008=head2 dump_hash(\%hash) 1009 1010Debugging method which returns a text representation of the hash array passed 1011by reference as the first argument. 1012 1013 print STDERR $object->dump_hash(\%hash); 1014 1015=head2 dump_list(\@list) 1016 1017Debugging method which returns a text representation of the array 1018passed by reference as the first argument. 1019 1020 print STDERR $object->dump_list(\@list); 1021 1022=head2 dump_text($text) 1023 1024Debugging method which returns a truncated and sanitised representation of the 1025text string passed (directly or by reference) as the first argument. 1026 1027 print STDERR $object->dump_text($text); 1028 1029The string will be truncated to L<$MAX_TEXT> characters and any newlines 1030will be converted to C<\n> representations. 1031 1032=head2 dump_data($item) 1033 1034Debugging method which calls the appropriate dump method for the item passed 1035as the first argument. If it is an object with a L<dump()> method then that 1036will be called, otherwise it will fall back on L<dump_ref()>, as it will 1037for any other non-object references. Non-references are passed to the 1038L<dump_text()> method. 1039 1040 print STDERR $object->dump_data($item); 1041 1042=head2 dump_data_inline($item) 1043 1044Wrapper around L<dump_data()> which strips any newlines from the generated 1045output, suitable for a more compact debugging output. 1046 1047 print STDERR $object->dump_data_inline($item); 1048 1049=head1 MISCELLANEOUS METHODS 1050 1051=head2 enable_colour() 1052 1053Enables colourful debugging and error messages. 1054 1055 Badger::Debug->enable_colour; 1056 1057=head1 PACKAGE VARIABLES 1058 1059=head2 $FORMAT 1060 1061The L<debug()> method uses the message format in the C<$FORMAT> 1062package variable to generate debugging messages. The default value is: 1063 1064 [<where> line <line>] <msg> 1065 1066The C<E<lt>where<gt>>, C<E<lt>lineE<gt>> and C<E<lt>msgE<gt>> markers 1067denote the positions where the class name, line number and debugging 1068message are inserted. You can embed any of the following placeholders 1069into the message format: 1070 1071 msg The debugging message 1072 file The name of the file where the debug() method was called from 1073 line The line number that it was called from 1074 pkg The package that it was called from 1075 class The class name of the object that the method was called against 1076 where A summary of the package and class 1077 date The current date 1078 time The current time 1079 1080If the C<class> is the same as the C<pkg> then C<where> will contain the same 1081value. If they are different then C<where> will be set equivalent to "<pkg> 1082(<class>)". This is the case when the L<debug()> method is called from a base 1083class method (C<pkg> will be the base class name from where the call was made) 1084against a subclass object (C<class> will be the subclass name). 1085 1086See also the L<debug_at()> method which allows you to specify a custom format 1087and/or additional placeholder values. 1088 1089=head2 $MAX_DEPTH 1090 1091The maximum depth that the L<data inspection methods|DATA INSPECTION METHODS> 1092will recurse to. 1093 1094=head2 $MAX_TEXT 1095 1096The maximum length of text that will be returned by L<dump_text()>. 1097 1098=head1 AUTHOR 1099 1100Andy Wardley L<http://wardley.org/> 1101 1102=head1 COPYRIGHT 1103 1104Copyright (C) 1996-2009 Andy Wardley. All Rights Reserved. 1105 1106This module is free software; you can redistribute it and/or 1107modify it under the same terms as Perl itself. 1108 1109=cut 1110 1111# Local Variables: 1112# mode: perl 1113# perl-indent-level: 4 1114# indent-tabs-mode: nil 1115# End: 1116# 1117# vim: expandtab shiftwidth=4: 1118