home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / tsw / TSW_3.4.0.exe / Apache2 / perl / TestPerlDB.pm < prev    next >
Encoding:
Text File  |  2001-08-23  |  875 b   |  39 lines
  1. #no 'package Apache::TestPerlDB.pm' here, else we change perldb's package
  2. use strict;
  3.  
  4. sub Apache::TestPerlDB::lwpd {
  5.     print Apache::TestRequest::lwp_debug(shift || 1);
  6. }
  7.  
  8. sub Apache::TestPerlDB::bok {
  9.     my $n = shift || 1;
  10.     print "breakpoint set at test $n\n";
  11.     DB::cmd_b_sub('ok', "\$Test::ntest == $n");
  12. }
  13.  
  14. my %help = (
  15.     lwpd => 'Set the LWP debug level for Apache::TestRequest',
  16.     bok  => 'Set breakpoint at test n',
  17. );
  18.  
  19. my $setup_db_aliases = sub {
  20.     my $package = 'Apache::TestPerlDB';
  21.     my @cmds;
  22.     no strict 'refs';
  23.  
  24.     while (my($name, $val) = each %{"$package\::"}) {
  25.         next unless defined &$val;
  26.         *{"main::$name"} = \&{$val};
  27.         push @cmds, $name;
  28.     }
  29.  
  30.     print "$package added perldb commands:\n",
  31.       map { "   $_ - $help{$_}\n" } @cmds;
  32.  
  33. };
  34.  
  35. $setup_db_aliases->();
  36.  
  37. 1;
  38. __END__
  39.