File Coverage

Bio/Prospect/CBT/debug.pm
Criterion Covered Total %
statement 14 24 58.3
branch 1 8 12.5
condition 0 2 0.0
subroutine 5 7 71.4
pod 0 3 0.0
total 20 44 45.4


line stmt bran cond sub pod time code
1             # pm -- a perl package template
2             # $Id: debug.pm,v 1.1 2003/04/30 21:11:21 rkh Exp $
3             # @@banner@@
4              
5             package CBT::debug;
6             our $VERSION = '$Revision: 1.1 $ ';
7             our $level = $ENV{DEBUG} || 0;
8             our $trace_uses = exists $ENV{PERL_TRACE_USES} ? $ENV{PERL_TRACE_USES} : $level;
9             CBT::debug::identify_file() if ($CBT::debug::trace_uses);
10              
11 2     2   14 use warnings;
  2         3  
  2         53  
12 2     2   10 use strict;
  2         2  
  2         50  
13              
14              
15 2     2   10 use Exporter;
  2         3  
  2         186  
16             our @EXPORT = qw( advise );
17             our @EXPORT_OK = (@EXPORT, qw( advise ));
18             our %EXPORT_TAGS = qw( );
19              
20             #use Getopt::Long;
21             #our %options = ( debuglevel => $ENV{DEBUG} );
22             #our @options = ( 'debug|d+' => sub { $options{debuglevel}++ },
23             # 'debuglevel=i' => \$options{debuglevel} );
24             #my $p = new Getopt::Long::Parser;
25             #$p->configure( qw(gnu_getopt pass_through) );
26             #$p->getoptions( @options );
27             #use Data::Dumper;
28             #print Dumper(\%options), "\n";
29              
30 2     2   11 use Carp;
  2         4  
  2         724  
31              
32             sub identify_file
33             {
34 0     0 0 0 my ($p,$f,$l) = caller();
35 0   0     0 my $v = eval "return \$${p}::VERSION" || 'N/A';
36 0         0 print(STDERR "# use $p (f:$f, v:$v)\n");
37             }
38              
39             sub advise
40             {
41 0     0 0 0 my $level = shift;
42 0         0 my $pkg = (caller())[0];
43 0 0       0 carp( "$pkg ($level):", @_ ) if eval { $pkg::DEBUG >= $level }
  0         0  
44             }
45              
46             sub RCSVersion
47             {
48 2     2 0 4 my $rcsstring = shift;
49 2 50       33 return $1 if $rcsstring =~ m/\$\bRevision: (\d.+)\$/;
50 0 0         return $1 if $rcsstring =~ m/\$\bId: .+,v (\d.+)\$/;
51 0 0         return $1 if $rcsstring =~ m/^[\d.]+$/;
52 0           return undef;
53             }
54              
55             1;
56              
57             =head1 NAME
58              
59             pm -- a perl package template
60              
61             S<$Id: debug.pm,v 1.1 2003/04/30 21:11:21 rkh Exp $>
62              
63             =head1 SYNOPSIS
64              
65             C<pm [options]>
66              
67             =head1 DESCRIPTION
68              
69             B<program> does nothing particularly useful.
70              
71             =head1 INSTALLATION
72              
73             Put this file in your perl lib directory (usually /usr/local/perl5/lib) or
74             one of the directories in B<$PERL5LIB>.
75              
76             @@banner@@
77              
78             =cut