home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / xampp / xampp-perl-addon-1.4.9-installer.exe / TestPerlDB.pm < prev    next >
Encoding:
Text File  |  2004-03-04  |  1.4 KB  |  53 lines
  1. # Copyright 2001-2004 The Apache Software Foundation
  2. #
  3. # Licensed under the Apache License, Version 2.0 (the "License");
  4. # you may not use this file except in compliance with the License.
  5. # You may obtain a copy of the License at
  6. #
  7. #     http://www.apache.org/licenses/LICENSE-2.0
  8. #
  9. # Unless required by applicable law or agreed to in writing, software
  10. # distributed under the License is distributed on an "AS IS" BASIS,
  11. # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
  12. # See the License for the specific language governing permissions and
  13. # limitations under the License.
  14. #
  15. #no 'package Apache::TestPerlDB.pm' here, else we change perldb's package
  16. use strict;
  17.  
  18. sub Apache::TestPerlDB::lwpd {
  19.     print Apache::TestRequest::lwp_debug(shift || 1);
  20. }
  21.  
  22. sub Apache::TestPerlDB::bok {
  23.     my $n = shift || 1;
  24.     print "breakpoint set at test $n\n";
  25.     DB::cmd_b_sub('ok', "\$Test::ntest == $n");
  26. }
  27.  
  28. my %help = (
  29.     lwpd => 'Set the LWP debug level for Apache::TestRequest',
  30.     bok  => 'Set breakpoint at test n',
  31. );
  32.  
  33. my $setup_db_aliases = sub {
  34.     my $package = 'Apache::TestPerlDB';
  35.     my @cmds;
  36.     no strict 'refs';
  37.  
  38.     while (my($name, $val) = each %{"$package\::"}) {
  39.         next unless defined &$val;
  40.         *{"main::$name"} = \&{$val};
  41.         push @cmds, $name;
  42.     }
  43.  
  44.     print "$package added perldb commands:\n",
  45.       map { "   $_ - $help{$_}\n" } @cmds;
  46.  
  47. };
  48.  
  49. $setup_db_aliases->();
  50.  
  51. 1;
  52. __END__
  53.