package VCP::Debug ; =head1 NAME VCP::Debug - debugging support for VCP =head1 SYNOPSIS =head1 DESCRIPTION =head1 EXPORTS The following functions may be exported: L</debug>, L</enable_debug>, L</debugging> L</disable_debug>, along with the tags ':all' and ':debug'. Use the latter to head off future namespace pollution in case :all gets expanded in the future.. A warning will be emitted on program exit for any specs that aren't used, to help you make sure that you are using sensible specs. =over =cut use strict ; use vars qw( $VERSION @ISA @EXPORT_OK %EXPORT_TAGS ) ; use Exporter ; @ISA = qw( Exporter ) ; @EXPORT_OK = qw( debug enable_debug disable_debug debugging explicitly_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<use> and C<import> 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<before> C<use>ing 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 debug_some to avoid the "\n". Any undefined parameters will be displayed as C<E<lt>undefE<gt>>. =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 ; warn "vcp: 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 ) { warn "vcp: Undebugged things: ", join( ', ', @undebugged ), "\n" ; } else { warn "vcp: No undebugged things\n" ; } } } require Time::HiRes; my $start_time = Time::HiRes::time() if $ENV{VCPDEBUGHIRES}; my $last_time = $start_time; printf STDERR "%06.3f +%06.3f vcp: debug timer started\n", 0, 0; sub debug { return unless @debug_specs ; if ( @_ ) { my $t = join( '', map defined $_ ? $_ : "<undef>", @_ ) ; if ( length $t ) { if ( $ENV{VCPDEBUGHIRES} ) { my $t = Time::HiRes::time(); printf STDERR "%06.3f +%06.3f ", $t - $start_time, $t - $last_time; $last_time = $t; } print STDERR $t, substr( $t, -1 ) eq "\n" ? () : "\n" ; } } } sub debug_some { return unless @debug_specs ; print STDERR map defined $_ ? $_ : "<undef>", @_ if @_ ; } =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 ; print STDERR "Debugging ",join( ', ', map "/$_/", @report ),"\n" if @report ; $reported_specs = 1 ; } sub debugging { return undef unless @debug_specs ; my $result ; my @missed ; for my $where ( @_ ? map ref $_ || $_, @_ : scalar caller ) { if ( ! exists $debugging{$where} ) { # print STDERR "missed $where\n" ; ## If this is the first miss, then these may not have been reported. _report_specs unless $reported_specs ; ## We go ahead and evaluate all specs instead of returning when the ## first is found so that we can set $used_specs for all specs that ## match. $debugging{$where} = 0 ; for my $spec ( @debug_specs ) { next if $spec eq '##NEVER_MATCH##' ; # print STDERR " /$spec/:\n" ; if ( $where =~ /$spec/i ) { $debugging{$where} = 1 ; $used_specs{$spec} = 1 ; $result = 1 ; ## no last: we want to build up %used_specs. There ## aren't usually many specs anyway. } else { # print STDERR " ! /$spec/\n" ; } } } # print STDERR "$where ", $debugging{$where} ? 'yes' : 'no', "\n" ; return 1 if $debugging{$where} ; } return $result ; } =item explicitly_debugging debug "blah" if explicitly_debugging ; Returns TRUE if the caller's module is being debugged by a literal match instead of a pattern match. This is used when debugging output would normally be congested with too much crap from a particular subsystem when using a wildcard debug spec (like ".*"), but you want the ability to turn on debugging for that subsystem: debug "blah" if explicitly_debugging "VCP::Dest::sort" ; requires an explicit C<VCP::Dest::sort> to be given in the debug specs. debug "blah" if explicitly_debugging $self ; debug "blah" if explicitly_debugging $other, $self ; ## ORs the args Returns TRUE if any of the arguments are being debugged. Plain strings can be passed or blessed references. =cut my %explicitly_debugging ; sub explicitly_debugging { return undef unless @debug_specs ; my $result ; my @missed ; for my $where ( @_ ? map ref $_ || $_, @_ : scalar caller ) { if ( ! exists $explicitly_debugging{$where} ) { # print STDERR "missed $where\n" ; ## If this is the first miss, then these may not have been reported. _report_specs unless $reported_specs ; ## We go ahead and evaluate all specs instead of returning when the ## first is found so that we can set $used_specs for all specs that ## match. $explicitly_debugging{$where} = 0 ; for my $spec ( @debug_specs ) { next if $spec eq '##NEVER_MATCH##' ; # print STDERR " /$spec/:\n" ; if ( lc $where eq lc $spec ) { $explicitly_debugging{$where} = 1 ; $used_specs{$spec} = 1 ; $result = 1 ; ## no last: we want to build up %used_specs. There ## aren't usually many specs anyway. } else { # print STDERR " ! /$spec/\n" ; } } } # print STDERR "$where ", $debugging{$where} ? 'yes' : 'no', "\n" ; return 1 if $explicitly_debugging{$where} ; } return $result ; } =item disable_debug Disable all debugging. =cut sub disable_debug() { @debug_specs = () ; return ; } =item enable_debug enable_debug ; enable_debug( ...debug specs... ) ; A debug spec is a regular expression that matches the name of a module. =cut sub enable_debug { my %specs = map { ( $_ => 1 ) } @debug_specs, @_ ; my @new_debug_specs = %specs ? keys %specs : qr/^/ ; _report_specs if $reported_specs && @debug_specs != @new_debug_specs ; @debug_specs = map( /^what$/i && ( $dump_undebugged = 1 ) ? '##NEVER_MATCH##' : $_, @new_debug_specs ) ; return ; } =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<vcp>. =head1 AUTHOR Barrie Slaymaker <barries@slaysys.com> =cut 1
# | Change | User | Description | Committed | |
---|---|---|---|---|---|
#17 | 3825 | Barrie Slaymaker | - Debug lines now show the calling function name | ||
#16 | 3408 | Barrie Slaymaker | - debug() no longer emits anything if !debugging | ||
#15 | 3407 | Barrie Slaymaker | - debug() no longer emits anything if !debugging. | ||
#14 | 3243 | Barrie Slaymaker | Remove old code. | ||
#13 | 3168 | Barrie Slaymaker | Add a profiling line for all of VCP. | ||
#12 | 3167 | Barrie Slaymaker |
Add profiling report that details various chunks of time taken. |
||
#11 | 3158 | Barrie Slaymaker | Emit debugging enabled message to STDERR and log file, not STDOUT. | ||
#10 | 3155 | Barrie Slaymaker |
Convert to logging using VCP::Logger to reduce stdout/err spew. Simplify & speed up debugging quite a bit. Provide more verbose information in logs. Print to STDERR progress reports to keep users from wondering what's going on. Breaks test; halfway through upgrading run3() to an inline function for speed and for VCP specific features. |
||
#9 | 3020 | Barrie Slaymaker |
Note some changes, prevent hires debugging when "all" is provided and "hires" is not. |
||
#8 | 2293 | Barrie Slaymaker | Update CHANGES, TODO, improve .vcp files, add --init-cvs | ||
#7 | 2235 | Barrie Slaymaker | Debugging cvs speed reader. | ||
#6 | 2228 | Barrie Slaymaker | working checkin | ||
#5 | 1055 | Barrie Slaymaker |
add sorting, revamp test suite, misc cleanup. Dest/revml is not portable off my system yet (need to release ...::Diff) |
||
#4 | 688 | Barrie Slaymaker | Fixed docos for --debug. | ||
#3 | 628 | Barrie Slaymaker | Cleaned up POD in bin/vcp, added BSD-style license. | ||
#2 | 468 | Barrie Slaymaker |
- VCP::Dest::p4 now does change number aggregation based on the comment field changing or whenever a new revision of a file with unsubmitted changes shows up on the input stream. Since revisions of files are normally sorted in time order, this should work in a number of cases. I'm sure we'll need to generalize it, perhaps with a time thresholding function. - t/90cvs.t now tests cvs->p4 replication. - VCP::Dest::p4 now doesn't try to `p4 submit` when no changes are pending. - VCP::Rev now prevents the same label from being applied twice to a revision. This was occuring because the "r_1"-style label that gets added to a target revision by VCP::Dest::p4 could duplicate a label "r_1" that happened to already be on a revision. - Added t/00rev.t, the beginnings of a test suite for VCP::Rev. - Tweaked bin/gentrevml to comment revisions with their change number instead of using a unique comment for every revision for non-p4 t/test-*-in-0.revml files. This was necessary to test cvs->p4 functionality. |
||
#1 | 467 | Barrie Slaymaker | Version 0.01, initial checkin in perforce public depot. |