# Licensed to the Apache Software Foundation (ASF) under one or more
# contributor license agreements. See the NOTICE file distributed with
# this work for additional information regarding copyright ownership.
# The ASF licenses this file to You under the Apache License, Version 2.0
# (the "License"); you may not use this file except in compliance with
# the License. You may obtain a copy of the License at
#
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
#
#no 'package Apache::TestPerlDB.pm' here, else we change perldb's package
use
strict;
sub
Apache::TestPerlDB::lwpd {
Apache::TestRequest::lwp_debug(
shift
|| 1);
}
sub
Apache::TestPerlDB::bok {
my
$n
=
shift
|| 1;
"breakpoint set at test $n\n"
;
DB::cmd_b_sub(
'ok'
,
"\$Test::ntest == $n"
);
}
my
%help
= (
lwpd
=>
'Set the LWP debug level for Apache::TestRequest'
,
bok
=>
'Set breakpoint at test n'
,
);
my
$setup_db_aliases
=
sub
{
my
$package
=
'Apache::TestPerlDB'
;
my
@cmds
;
no
strict
'refs'
;
while
(
my
(
$name
,
$val
) =
each
%{
"$package\::"
}) {
next
unless
defined
&$val
;
*{
"main::$name"
} = \&{
$val
};
push
@cmds
,
$name
;
}
"$package added perldb commands:\n"
,
map
{
" $_ - $help{$_}\n"
}
@cmds
;
};
$setup_db_aliases
->();
1;
__END__