}
}
-=head2 add_package_symbol $variable $value $filename $firstlinenum $lastlinenum
+=head2 add_package_symbol $variable $value %opts
Adds a new package symbol, for the symbol given as C<$variable>, and optionally
gives it an initial value of C<$value>. C<$variable> should be the name of
will create C<%Foo::foo>.
-The optional $filename, $firstlinenum, and $lastlinenum arguments can be used
-to indicate where the symbol should be regarded as having been defined.
+Valid options (all optional) are C<filename>, C<first_line_num>, and
+C<last_line_num>.
+
+C<$opts{filename}>, C<$opts{first_line_num}>, and C<$opts{last_line_num}> can
+be used to indicate where the symbol should be regarded as having been defined.
Currently these values are only used if the symbol is a subroutine ('C<&>'
-sigil) and only if C<$^P & 0x10> is true. In which case the special
-C<%DB::sub> hash is updated to record the values of $filename, $firstlinenum,
-and $lastlinenum for the subroutine.
+sigil) and only if C<$^P & 0x10> is true, in which case the special C<%DB::sub>
+hash is updated to record the values of C<filename>, C<first_line_num>, and
+C<last_line_num> for the subroutine. If these are not passed, their values are
+inferred (as much as possible) from C<caller> information.
This is especially useful for debuggers and profilers, which use C<%DB::sub> to
determine where the source code for a subroutine can be found. See
}
sub add_package_symbol {
- my ($self, $variable, $initial_value) = @_; # extra args unpacked below
+ my ($self, $variable, $initial_value, %opts) = @_;
my ($name, $sigil, $type) = ref $variable eq 'HASH'
? @{$variable}{qw[name sigil type]}
# cheap fail-fast check for PERLDBf_SUBLINE and '&'
if ($^P and $^P & 0x10 && $sigil eq '&') {
- my (undef, undef, undef, $filename, $firstlinenum, $lastlinenum) = @_;
+ my $filename = $opts{filename};
+ my $first_line_num = $opts{first_line_num};
- (undef, $filename, $firstlinenum) = caller
+ (undef, $filename, $first_line_num) = caller
if not defined $filename;
- $lastlinenum = $firstlinenum ||= 0
- if not defined $lastlinenum;
+
+ my $last_line_num = $opts{last_line_num} || ($first_line_num ||= 0);
# http://perldoc.perl.org/perldebguts.html#Debugger-Internals
- $DB::sub{$pkg . '::' . $name} = "$filename:$firstlinenum-$lastlinenum";
+ $DB::sub{$pkg . '::' . $name} = "$filename:$first_line_num-$last_line_num";
}
}