File Coverage

blib/lib/Test/Unit/Debug.pm
Criterion Covered Total %
statement 12 22 54.5
branch 1 4 25.0
condition 0 3 0.0
subroutine 5 12 41.6
pod 4 8 50.0
total 22 49 44.9


line stmt bran cond sub pod time code
1             package Test::Unit::Debug;
2             BEGIN {
3 2     2   582 $Test::Unit::Debug::VERSION = '0.25_1325'; # added by dist-tools/SetVersion.pl
4             }
5              
6             =head1 NAME
7              
8             Test::Unit::Debug - framework debugging control
9              
10             =head1 SYNOPSIS
11              
12             package MyRunner;
13              
14             use Test::Unit::Debug qw(debug_to_file debug_pkg);
15              
16             debug_to_file('foo.log');
17             debug_pkg('Test::Unit::TestCase');
18              
19             =cut
20              
21 2     2   12 use strict;
  2         3  
  2         70  
22              
23 2     2   11 use base 'Exporter';
  2         4  
  2         315  
24 2     2   13 use vars qw(@EXPORT_OK);
  2         4  
  2         1280  
25             @EXPORT_OK = qw(debug debug_to_file
26             debug_pkg no_debug_pkg debug_pkgs no_debug_pkgs debugged);
27              
28             my %DEBUG = ();
29             my $out = \*STDERR;
30              
31             =head1 ROUTINES
32              
33             =head2 debug_to_file($file)
34              
35             Switch debugging to C<$file>.
36              
37             =cut
38              
39             sub debug_to_file {
40 0     0 1 0 my ($file) = @_;
41 0 0       0 open(DEBUG, ">$file") or die "Couldn't open $file for writing";
42 0         0 $out = \*DEBUG;
43             }
44              
45             =head2 debug_to_stderr()
46              
47             Switch debugging to STDERR (this is the default).
48              
49             =cut
50              
51             sub debug_to_stderr {
52 0     0 1 0 $out = \*STDERR;
53             }
54              
55             sub debug {
56 2110     2110 0 6169 my ($package, $filename, $line) = caller();
57 2110 50       7541 print $out @_ if $DEBUG{$package};
58             }
59              
60             =head2 debug_pkg($pkg)
61              
62             Enable debugging in package C<$pkg>.
63              
64             =cut
65              
66             sub debug_pkg {
67 0     0 1   $DEBUG{$_[0]} = 1;
68             }
69              
70             =head2 debug_pkgs(@pkgs)
71              
72             Enable debugging in the packages C<@pkgs>.
73              
74             =cut
75              
76             sub debug_pkgs {
77 0     0 1   $DEBUG{$_} = 1 foreach @_;
78             }
79              
80             =head2 debug_pkg($pkg)
81              
82             Enable debugging in package C<$pkg>.
83              
84             =cut
85              
86             sub no_debug_pkg {
87 0     0 0   $DEBUG{$_[0]} = 0;
88             }
89              
90             =head2 debug_pkgs(@pkgs)
91              
92             Disable debugging in the packages C<@pkgs>.
93              
94             =cut
95              
96             sub no_debug_pkgs {
97 0     0 0   $DEBUG{$_} = 0 foreach @_;
98             }
99              
100             sub debugged {
101 0     0 0   my ($package, $filename, $line) = caller();
102 0   0       return $DEBUG{$_[0] || $package};
103             }
104              
105              
106             =head1 AUTHOR
107              
108             Copyright (c) 2000-2002, 2005 the PerlUnit Development Team
109             (see L or the F file included in this
110             distribution).
111              
112             All rights reserved. This program is free software; you can
113             redistribute it and/or modify it under the same terms as Perl itself.
114              
115             =head1 SEE ALSO
116              
117             L
118              
119             =cut
120              
121             1;