summaryrefslogtreecommitdiffstats
path: root/lib
diff options
context:
space:
mode:
authorJesse Luehrs <doy@tozt.net>2010-11-12 12:16:57 -0600
committerJesse Luehrs <doy@tozt.net>2010-11-12 12:16:57 -0600
commit76f7c3068e8bd63fcbac28758631fcda72596674 (patch)
tree8ce7295c60515515fb65ff4bb38e9a5833144e05 /lib
parent2033654760f55aa6b34262de791a32e98a33a046 (diff)
downloadpackage-stash-xs-76f7c3068e8bd63fcbac28758631fcda72596674.tar.gz
package-stash-xs-76f7c3068e8bd63fcbac28758631fcda72596674.zip
add_package_symbol (except the db bits, for now)
Diffstat (limited to 'lib')
-rw-r--r--lib/Package/Stash.pm48
1 files changed, 0 insertions, 48 deletions
diff --git a/lib/Package/Stash.pm b/lib/Package/Stash.pm
index 2015046..73e53ef 100644
--- a/lib/Package/Stash.pm
+++ b/lib/Package/Stash.pm
@@ -107,54 +107,6 @@ determine where the source code for a subroutine can be found. See
L<http://perldoc.perl.org/perldebguts.html#Debugger-Internals> for more
information about C<%DB::sub>.
-=cut
-
-sub _valid_for_type {
- my $self = shift;
- my ($value, $type) = @_;
- if ($type eq 'HASH' || $type eq 'ARRAY'
- || $type eq 'IO' || $type eq 'CODE') {
- return reftype($value) eq $type;
- }
- else {
- my $ref = reftype($value);
- return !defined($ref) || $ref eq 'SCALAR' || $ref eq 'REF' || $ref eq 'LVALUE';
- }
-}
-
-sub add_package_symbol {
- my ($self, $variable, $initial_value, %opts) = @_;
-
- my ($name, $sigil, $type) = ref $variable eq 'HASH'
- ? @{$variable}{qw[name sigil type]}
- : $self->_deconstruct_variable_name($variable);
-
- my $pkg = $self->name;
-
- if (@_ > 2) {
- $self->_valid_for_type($initial_value, $type)
- || confess "$initial_value is not of type $type";
-
- # cheap fail-fast check for PERLDBf_SUBLINE and '&'
- if ($^P and $^P & 0x10 && $sigil eq '&') {
- my $filename = $opts{filename};
- my $first_line_num = $opts{first_line_num};
-
- (undef, $filename, $first_line_num) = caller
- if not defined $filename;
-
- 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:$first_line_num-$last_line_num";
- }
- }
-
- no strict 'refs';
- no warnings 'redefine', 'misc', 'prototype';
- *{$pkg . '::' . $name} = ref $initial_value ? $initial_value : \$initial_value;
-}
-
=method remove_package_glob $name
Removes all package variables with the given name, regardless of sigil.