From f3b6cfbd01fad80cca688f62caac2da1034d2ed4 Mon Sep 17 00:00:00 2001
From: "Eric A. Miller" <emiller@cpan.org>
Date: Fri, 18 Oct 2013 19:02:46 -0400
Subject: [PATCH] [#49] Perl 5.18 UNIVERSAL::can change could cause infinite
 loop

---
 ChangeLog |  1 +
 Info.pm   | 20 +++++++++++---------
 2 files changed, 12 insertions(+), 9 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index cd9fc84e..849eb931 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -32,6 +32,7 @@ version 3.08 ()
     * [#68] Fix device_port entries for switches with non-unique
       ifDesc (Nic Bernstein)
     * Don't try to munge undef values
+    * [#49] Perl 5.18 UNIVERSAL::can change could cause infinite loop 
 
 version 3.07 (2013-10-01)
 
diff --git a/Info.pm b/Info.pm
index aa7c18d1..97b78cd0 100644
--- a/Info.pm
+++ b/Info.pm
@@ -4360,14 +4360,7 @@ sub can {
     my $method = shift;
 
     # use results of parent can()
-    my $meth_ref = $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$/ );
-    }
+    return $self->SUPER::can($method) if $self->SUPER::can($method);
 
     my $validated = $self->_validate_autoload_method($method);
     return unless $validated;
@@ -4434,7 +4427,7 @@ subclass.
 =cut
 
 sub AUTOLOAD {
-    my $self    = shift;
+    my $self = shift;
     my ($sub_name) = $AUTOLOAD =~ /::(\w+)$/;
 
     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 $self->$meth_ref(@_);
 
 }
+
 1;
 
 =head1 COPYRIGHT AND LICENSE