135/snmp-info
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

[#49] Perl 5.18 UNIVERSAL::can change could cause infinite loop

Browse Source
This commit is contained in:
Eric A. Miller
2013-10-18 19:02:46 -04:00
parent e239a6057c
commit f3b6cfbd01
2 changed files with 12 additions and 9 deletions
Download Patch File Download Diff File Expand all files Collapse all files

1
ChangeLog
View File

@@ -32,6 +32,7 @@ version 3.08 ()
* [#68] Fix device_port entries for switches with non-unique * [#68] Fix device_port entries for switches with non-unique
ifDesc (Nic Bernstein) ifDesc (Nic Bernstein)
* Don't try to munge undef values * Don't try to munge undef values
* [#49] Perl 5.18 UNIVERSAL::can change could cause infinite loop
version 3.07 (2013-10-01) version 3.07 (2013-10-01)

20
Info.pm
View File

@@ -4360,14 +4360,7 @@ sub can {
my $method = shift; my $method = shift;
# use results of parent can() # use results of parent can()
my $meth_ref = $self->SUPER::can($method); return $self->SUPER::can($method) if $self->SUPER::can($method);
# Don't return if passed $super as it means we were called
# from AUTOLOAD for a method that hasn't been generated yet.
if ($meth_ref) {
return $meth_ref
unless ( defined $AUTOLOAD && $AUTOLOAD =~ /SUPER::$method$/ );
}
my $validated = $self->_validate_autoload_method($method); my $validated = $self->_validate_autoload_method($method);
return unless $validated; return unless $validated;
@@ -4434,7 +4427,7 @@ subclass.
=cut =cut
sub AUTOLOAD { sub AUTOLOAD {
my $self = shift; my $self = shift;
my ($sub_name) = $AUTOLOAD =~ /::(\w+)$/; my ($sub_name) = $AUTOLOAD =~ /::(\w+)$/;
return if $sub_name =~ /DESTROY$/; return if $sub_name =~ /DESTROY$/;
@@ -4452,10 +4445,19 @@ sub AUTOLOAD {
); );
} }
# This enables us to use SUPER:: for AUTOLOAD methods as well
# as the true OO methods. Method needs to be renamed to prevent
# namespace collision when we insert into the symbol table later.
if ( $AUTOLOAD =~ /SUPER::$sub_name$/ ) {
$AUTOLOAD =~ s/SUPER::$sub_name/orig_$sub_name/;
$sub_name = "orig_$sub_name";
}
return unless my $meth_ref = $self->can($sub_name, @_); return unless my $meth_ref = $self->can($sub_name, @_);
return $self->$meth_ref(@_); return $self->$meth_ref(@_);
} }
1; 1;
=head1 COPYRIGHT AND LICENSE =head1 COPYRIGHT AND LICENSE