package VCP::Debug ; =head1 NAME VCP::Debug - debugging support for VCP =head1 SYNOPSIS =head1 DESCRIPTION Debugging support for VCP. Enabled by setting the environment variable VCPDEBUG=1. =over =cut use strict ; use vars qw( $VERSION @ISA @EXPORT_OK %EXPORT_TAGS ) ; use Exporter ; use VCP::Logger qw( lg pr log_file_name ); use constant debugging => $ENV{VCPDEBUG} || 0; BEGIN { print "debugging enabled, see ", log_file_name, "\n" if debugging } @ISA = qw( Exporter ) ; @EXPORT_OK = qw( debug debugging ) ; %EXPORT_TAGS = ( 'all' => \@EXPORT_OK, 'debug' => \@EXPORT_OK, ) ; $VERSION = 0.1 ; # TODO: #=item use #=item import # #In addition to all of the routines and tags that C and C normally #take (see above), you may also pass in pairwise debugging definitions like #so: # # use VCP::debug ( # ":all", # DEBUGGING_FOO => "foo,bar", # ) ; # #Any all caps export import requests are created as subroutines that may well be #optimized away at compile time if "enable_debugging" has not been called. This #requires a conspiracy between the author of a module and the author of the main #program to call enable_debugging I Cing any modules that leverage #this feature, otherwise compile-time optimizations won't occur. # =item debug debug $foo if debugging $self ; Emits a line of debugging (a "\n" will be appended). Use to avoid the "\n". Any undefined parameters will be displayed as CundefE>. =cut my $dump_undebugged ; my $reported_specs ; my @debug_specs ; my %used_specs ; my %debugging ; END { $used_specs{'##NEVER_MATCH##'} = 1 ; my @unused = grep ! $used_specs{$_}, @debug_specs ; pr "unused debug specs: ", join( ', ', map "/$_/", @unused ), "\n" if @unused ; if ( @unused || $dump_undebugged ) { my @undebugged = grep { my $name = $_ ; ! grep $name =~ /$_/i, keys %used_specs } map lc $_, sort keys %debugging ; if ( @undebugged ) { pr "undebugged things (possible debug specs): ", join( ', ', @undebugged ), "\n" ; } } } sub debug { return unless @debug_specs ; goto ≶ } =item debugging debug "blah" if debugging ; Returns TRUE if the caller's module is being debugged debug "blah" if debugging $self ; debug "blah" if debugging $other, $self ; ## ORs the arguments together Returns TRUE if any of the arguments are being debugged. Plain strings can be passed or blessed references. =cut sub _report_specs { my @report = grep ! /##NEVER_MATCH##/, @debug_specs ; pr "Debugging ",join( ', ', map "/$_/", @report ) if @report ; $reported_specs = 1 ; } =back =head1 COPYRIGHT Copyright 2000, Perforce Software, Inc. All Rights Reserved. This module and the VCP package are licensed according to the terms given in the file LICENSE accompanying this distribution, a copy of which is included in L. =head1 AUTHOR Barrie Slaymaker =cut 1