package debug; use strict; use warnings; our $VERSION = '0.04'; sub import { shift; my @packages = @_; # turn off strict refs # cause we are messing with stuff # and turn off warnings for redefine # cause we are redefining no strict 'refs'; no warnings 'redefine'; # are we turning the debugger on? # (meaning, have any package names been passed in) if (@packages) { # turn DEBUG on for each class in the package list *{"${_}::DEBUG"} = sub { 1 } foreach @packages; } else { # either that we are just registering # the module as debuggable, so we # need to find out the calling package # so that we can make a null DEBUG # subroutine my ($calling_package) = caller(); if ( ! defined &{"${calling_package}::DEBUG"} ) { *{"${calling_package}::DEBUG"} = sub { 0 }; } *{"${calling_package}::Dumper"} = sub { eval { require Data::Dumper }; return Data::Dumper::Dumper(@_) unless $@; }; } } sub on { shift if $_[0] eq __PACKAGE__; my @packages = @_; # turn off strict refs # cause we are messing with stuff # and turn off warnings for redefine # cause we are redefining no strict 'refs'; no warnings 'redefine'; *{"${_}::DEBUG"} = sub { 1 } foreach @packages; } sub off { shift if $_[0] eq __PACKAGE__; my @packages = @_; # turn off strict refs # cause we are messing with stuff # and turn off warnings for redefine # cause we are redefining no strict 'refs'; no warnings 'redefine'; *{"${_}::DEBUG"} = sub { 0 } foreach @packages; } # methods to inspect modules with sub is_debug_on { shift if $_[0] eq __PACKAGE__; my $package = shift; # this checks to see if debug is # on my returning the value of debug # for that package, convient isnt it :) no strict 'refs'; return 0 unless defined &{"${package}::DEBUG"}; return &{"${package}::DEBUG"}(); } # Debug Log Filters # -------------------------------- # this is a private hash # of package -> to -> filter mappings # so that every package can have its own # debugging filter. # hash of filters for packages my $log_filters = { __DEFAULT__ => sub { print STDERR "debug->log + ", @_, "\n" } }; # this function is essentially a dispatcher # for the log filter table above sub log { shift if $_[0] eq __PACKAGE__; # the filter key is the name of the calling package my ($log_filter_key) = caller(); # if a specialized filter does not exist for the package # then the default one is used $log_filter_key = "__DEFAULT__" unless exists ${$log_filters}{$log_filter_key}; # the filter is then executed on the arguments to this function $log_filters->{$log_filter_key}->(@_); } # this allows for the setting of # a log filter for a specific package sub set_log_filter { shift if $_[0] eq __PACKAGE__; my ($package, $filter) = @_; (ref($filter) eq "CODE") || die "debug module exception: the filter must be a subroutine reference"; # if all is okay then put it in the hash $log_filters->{$package} = $filter; } # setting the default log filter for all sub set_default_log_filter { shift if $_[0] eq __PACKAGE__; my ($filter) = @_; (ref($filter) eq "CODE") || die "debug module exception: the filter must be a subroutine reference"; $log_filters->{__DEFAULT__} = $filter; } # this allows you to remove a filter # entirely if you want sub remove_log_filter { shift if $_[0] eq __PACKAGE__; my $package = shift; # delete it if it exists delete $log_filters->{$package} if exists ${$log_filters}{$package}; } 1; __END__ =head1 NAME debug - Perl pragma for debugging and logging of debug lines. =head1 SYNOPSIS package Foo; # start by embedding calls to # debug::log inside your module # of package. # use the pragma use debug; sub bar { # call debug::log if you have # something to say, but don't # forget "if DEBUG" debug::log("entering Foo::bar") if DEBUG; print "foo"; # you can also call it with the # object '->' syntax if you like. debug->log("leaving Foo::bar") if DEBUG; } 1; # then in your main script, you # can do one of the following things # use your module use Foo; # turn debug on for the Foo package (at compile-time) use debug qw(Foo); # you can also do it this way (at run-time) debug->on("Foo"); # now comes your code ... Foo::bar(); # your would then look like this: debug-log + entering Foo::bar foo debug-log + leaving Foo::bar =head1 DESCRIPTION The B pragma provides a very simple way of turning on and off your debugging lines, as well as a very flexible way of logging those lines to literally anywhere you want. =head2 Register Your Module You need to register a module for debugging by placing C at the top of you module. Then you can embed calls to C within your code making sure to surround them with conditional checks for the value of the C constant. See the SYNOPSIS section for an example. After that you can turn the debugging on and off from any other module or namespace. You can do this one of 2 ways: # compile-time way use debug qw(Foo Bar Baz); # add as many modules as you like # run-time way debug->on qw(Foo Bar Baz); # add as many modules as you like =head2 Debug Log Filters Now comes the debug log filters. If you do nothing else, your debug lines will look like the example in the SYNOPSIS section. But you can change that very easily. By changing the default log filter with (what else) the C function. Here is an example: debug::set_default_log_filter(sub { print STDERR "debugging : ", @_ }); This will send all the C calls to STDERR and prepend the string "debugging : " to them all. Any anyonomous subroutine or subroutine reference will do. But the default filter is not the only one you can change, you can also assign a specific filter for each package you are debugging. Here is an example: debug::set_log_filter(Foo => sub { print "Debugging Foo >> ", @_ }); This log filter will only be called from the C package. And just as you can add them, you can take them away. Use the C function. Again, an example: debug::remove_log_filter("Foo"); All C calls in Foo will now go through the default log filter again. =head2 More Complex Filter Examples A debug log filter which prints the name of package it was called in. sub my_calling_package_filter { print "debugging -> ", (caller(1))[0], " : ", @_, "\n"; } debug->set_log_filter(Foo => \&my_calling_package_filter); A debug log filter to convert things to HTML. sub my_HTML_log_filter { # first we need to join the arguements into a single string my $output = join "" => @_; # then we replace any \n (newlines) with an HTML
tag $output =~ s/\n/\/g; # then we replace any tabs with 4 " "s $output =~ s/\t/\ \;\ \;\ \;\ \;/g; # then we wrap the output in

tags and return it return "

$output

"; } debug->set_log_filter(Foo => \&my_HTML_log_filter); A debug log filter which will print a basic date stamp. debug->set_log_filter(Foo => sub { "[" . localtime() . "]: ", @_ } ); Here is a filter which appends to a file. sub append_to_file { open LOG, ">>", "/tmp/debug.log"; print LOG "debug->log : ", @_; close LOG; } debug->set_log_filter(Foo => \&append_to_file); =head1 FUNCTIONS =over 4 =item B This will turn debugging on for all the packages given in the C<@packages> arguement. =item B This will turn debugging off for all the packages given in the C<@packages> arguement. =item B This will return true (1) if debugging is on for that module and false (0) otherwise. =item B An array of strings and variables (C<@statements>) which will be logged. These values are fead through either the current default log filter or the one assigned specifically to the current package. =item B The C<$log_filter> argument is expected to be a subroutine reference, and if it is not, an exception is thrown. For information about how to create the log filters see the above sections. =item B This assigns a specific C<$log_filter> to a particular C<$package>, from then on all Clog()> calls from within that package will go through this filter. The C<$log_filter> argument is expected to be a subroutine reference, and if it is not, an exception is thrown. For information about how to create the log filters see the above sections. =item B This will remove the log filter for the specific C<$package>, thereby returning it to using the default log filter. =back =head1 EXPORTS This module exports two functions: =over 4 =item B This is just a boolean flag, so that you can write: debug->log("This line should work") if DEBUG; =item B This is a lazily loaded C wrapper. Why? Well, to start with, someone suggested it to me (see L), and secondly I realized how many times I have done this: use Data::Dumper; debug->log(Dumper(\%strucutre)) if DEBUG; And how much nicer it would be if I could do this: debug->log(Dumper(\%strucutre)) if DEBUG; The reason we lazily load L is that it will take up a lot of memory, so we don't load it unless we absolutely have to. If you do not have L installed (for some strange reason), this function will basically return undef. =back =head1 BUGS None that I am aware of. Of course, if you find a bug, let me know, and I will be sure to fix it. This module has been used in several production sites for over 2 years now without incident, the code released here has only been slightly modified, and documentation and tests added. =head1 CODE COVERAGE I use B to test the code coverage of my tests, below is the B report on this module test suite. ------------------------ ------ ------ ------ ------ ------ ------ ------ File stmt branch cond sub pod time total ------------------------ ------ ------ ------ ------ ------ ------ ------ debug.pm 100.0 96.4 n/a 100.0 100.0 100.0 99.3 ------------------------ ------ ------ ------ ------ ------ ------ ------ Total 100.0 96.4 n/a 100.0 100.0 100.0 99.3 ------------------------ ------ ------ ------ ------ ------ ------ ------ =head1 A NOTE ABOUT NAMING This module uses an all lowercase name, which is considered "wrong" by the perl-5-porters group. The idea is that all lowercase names are reserved for pragmas I create and which implement functionality missing in perl itself. I can understand their logic, and do not think that they are in the wrong in that stance. However, I do prefer to name my pragmas with lowercase names as well. That all said, I am making the choice to keep the lowercase name, and it is your choice as the user whether you want to use my module or not. I may be forcing my module to a life of obscurity by doing this, but so be it. =head1 SEE ALSO This module provides a simple flexible and lightweight means of logging your debug calls. If you have more sophisticated debugging/logging needs I suggest you look at L. While I have never used it myself, I have heard many good things about it. =head1 ACKNOWLEDGEMENTS =over 4 =item Thanks to Tom Shinnick for the loading order fix. =item Thanks to Terrence Brannon (metaperl) for suggesting the lazily loaded C trick. =item Thanks to Mark Lawrence (nomad@null.net) for the patch to add debian/* files to allow for Debian users to easily install the module. =back =head1 AUTHOR stevan little, Estevan@iinteractive.comE =head1 COPYRIGHT AND LICENSE Copyright 2004-2007 by Infinity Interactive, Inc. L This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut