summaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
authorShlomi Fish <shlomif@shlomifish.org>2012-10-29 10:56:53 +0200
committerRicardo Signes <rjbs@cpan.org>2012-11-12 09:18:44 -0500
commit83a917af3c0b08401f1f6bfa4920c058f23c4924 (patch)
treeed94a4f402ff01d1dcec48088715176d55b82ab8 /lib
parent6baf5dd0f73d7eded3db8b2383f2ea6f9b0eefbf (diff)
downloadperl-83a917af3c0b08401f1f6bfa4920c058f23c4924.tar.gz
[perl5db] Refactored cmd_b_sub.
Diffstat (limited to 'lib')
-rw-r--r--lib/perl5db.pl36
1 files changed, 21 insertions, 15 deletions
diff --git a/lib/perl5db.pl b/lib/perl5db.pl
index f50b608d05..11e7dca0cf 100644
--- a/lib/perl5db.pl
+++ b/lib/perl5db.pl
@@ -5056,40 +5056,46 @@ breakpoint.
=cut
sub cmd_b_sub {
- my ( $subname, $cond ) = @_;
-
- # Add always-true condition if we have none.
- $cond = 1 unless @_ >= 2;
+ my $subname = shift;
+ my $cond = @_ ? shift : 1;
# If the subname isn't a code reference, qualify it so that
# break_subroutine() will work right.
unless ( ref $subname eq 'CODE' ) {
- # Not Perl4.
- $subname =~ s/\'/::/g;
+ # Not Perl 4.
+ $subname =~ s/'/::/g;
my $s = $subname;
# Put it in this package unless it's already qualified.
- $subname = "${package}::" . $subname
- unless $subname =~ /::/;
+ if ($subname !~ /::/)
+ {
+ $subname = $package . '::' . $subname;
+ };
# Requalify it into CORE::GLOBAL if qualifying it into this
# package resulted in its not being defined, but only do so
# if it really is in CORE::GLOBAL.
- $subname = "CORE::GLOBAL::$s"
- if not defined &$subname
- and $s !~ /::/
- and defined &{"CORE::GLOBAL::$s"};
+ my $core_name = "CORE::GLOBAL::$s";
+ if ((!defined(&$subname))
+ and ($s !~ /::/)
+ and (defined &{$core_name}))
+ {
+ $subname = $core_name;
+ }
# Put it in package 'main' if it has a leading ::.
- $subname = "main" . $subname if substr( $subname, 0, 2 ) eq "::";
-
+ if ($subname =~ /\A::/)
+ {
+ $subname = "main" . $subname;
+ }
} ## end unless (ref $subname eq 'CODE')
# Try to set the breakpoint.
if (not eval { break_subroutine( $subname, $cond ); 1 }) {
local $\ = '';
- print $OUT $@ and return;
+ print {$OUT} $@;
+ return;
}
return;