[libyaml-perl] 01/02: Inhibit blessing only if the class has a DESTROY method

[Christoph Biedl]

This is an automated email from the git hooks/post-receive script.

cbiedl-guest pushed a commit to branch yaml-unsafe
in repository libyaml-perl.

commit 91c01aaaa12a20b954e15590b5e7fbb3c42a9d19
Author: Christoph Biedl <debian.axhn at manchmal.in-ulm.de>
Date:   Sat May 20 11:47:23 2017 +0200

    Inhibit blessing only if the class has a DESTROY method
---
 debian/patches/control-blessing.patch | 12 ++++++------
 debian/rules                          |  2 --
 2 files changed, 6 insertions(+), 8 deletions(-)

diff --git a/debian/patches/control-blessing.patch b/debian/patches/control-blessing.patch
index 96b329d..8ab9cac 100644
--- a/debian/patches/control-blessing.patch
+++ b/debian/patches/control-blessing.patch
@@ -5,7 +5,7 @@
                  $node = \$copy;
              }
 -            CORE::bless $node, $class;
-+            CORE::bless $node, $class if $ENV{'PERL_USE_UNSAFE_YAML'};
++            CORE::bless $node, $class if (!$class->can('DESTROY') || $ENV{'PERL_USE_UNSAFE_YAML'});
          }
          else {
              $node = $self->_parse_explicit($node, $explicit);
@@ -14,7 +14,7 @@
  
          if ( length($class) ) {
 -            CORE::bless($node, $class);
-+            CORE::bless($node, $class) if ($ENV{'PERL_USE_UNSAFE_YAML'});
++            CORE::bless($node, $class) if (!$class->can('DESTROY') || $ENV{'PERL_USE_UNSAFE_YAML'});
          }
  
          return $node;
@@ -23,7 +23,7 @@
              return $class->yaml_load(YAML::Node->new($node, $explicit));
          }
 -        else {
-+        elsif ($ENV{'PERL_USE_UNSAFE_YAML'}) {
++        elsif (!$class->can('DESTROY') || $ENV{'PERL_USE_UNSAFE_YAML'}) {
              if (ref $node) {
                  return CORE::bless $node, $class;
              }
@@ -44,13 +44,13 @@
          }
          else {
 -            CORE::bless $code, $class if $class;
-+            CORE::bless $code, $class if $class && $ENV{'PERL_USE_UNSAFE_YAML'};
++            CORE::bless $code, $class if ($class && (!$class->can('DESTROY') || $ENV{'PERL_USE_UNSAFE_YAML'}));
              return $code;
          }
      }
      else {
 -        return CORE::bless sub {}, $class if $class;
-+        return CORE::bless sub {}, $class if $class && $ENV{'PERL_USE_UNSAFE_YAML'};
++        return CORE::bless sub {}, $class if ($class && (!$class->can('DESTROY') || $ENV{'PERL_USE_UNSAFE_YAML'}));
          return sub {};
      }
  }
@@ -59,7 +59,7 @@
      my $sub = _QR_TYPES->{$flags} || sub { qr{$_[0]} };
      my $qr = &$sub($re);
 -    bless $qr, $class if length $class;
-+    bless $qr, $class if length $class && $ENV{'PERL_USE_UNSAFE_YAML'};
++    bless $qr, $class if length $class && (!$class->can('DESTROY') || $ENV{'PERL_USE_UNSAFE_YAML'});
      return $qr;
  }
  
diff --git a/debian/rules b/debian/rules
index 63558e3..2d33f6a 100755
--- a/debian/rules
+++ b/debian/rules
@@ -1,6 +1,4 @@
 #!/usr/bin/make -f
 
-export PERL_USE_UNSAFE_YAML=1
-
 %:
 	dh $@

-- 
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libyaml-perl.git