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