From 3508cc9962eb769ca4affdde9f1ba440b9a34880 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Tina=20M=C3=BCller?= <cpan2@tinita.de>
Date: Sun, 6 May 2018 10:59:15 +0200
Subject: [PATCH] Add $YAML::LoadBlessed

---
 lib/YAML.pm            |   4 +-
 lib/YAML/Loader.pm     |   7 ++-
 lib/YAML/Types.pm      |  14 ++++--
 test/no-load-blessed.t | 110 +++++++++++++++++++++++++++++++++++++++++
 4 files changed, 127 insertions(+), 8 deletions(-)
 create mode 100644 test/no-load-blessed.t

diff --git a/lib/YAML.pm b/lib/YAML.pm
index cd4ed8a..1638b91 100644
--- a/lib/YAML.pm
+++ b/lib/YAML.pm
@@ -13,9 +13,11 @@ our (
     $UseHeader, $UseVersion, $UseBlock, $UseFold, $UseAliases,
     $Indent, $SortKeys, $Preserve,
     $AnchorPrefix, $CompressSeries, $InlineSeries, $Purity,
-    $Stringify, $Numify
+    $Stringify, $Numify, $LoadBlessed,
 );
 
+$LoadBlessed = 1;
+
 
 use YAML::Node; # XXX This is a temp fix for Module::Build
 use Scalar::Util qw/ openhandle /;
diff --git a/lib/YAML/Loader.pm b/lib/YAML/Loader.pm
index a1e0675..d867aa6 100644
--- a/lib/YAML/Loader.pm
+++ b/lib/YAML/Loader.pm
@@ -268,7 +268,7 @@ sub _parse_explicit {
             $node = \$value;
         }
 
-        if ( length($class) ) {
+        if ( length($class) and $YAML::LoadBlessed ) {
             CORE::bless($node, $class);
         }
 
@@ -294,7 +294,7 @@ sub _parse_explicit {
             require YAML::Node;
             return $class->yaml_load(YAML::Node->new($node, $explicit));
         }
-        else {
+        elsif ($YAML::LoadBlessed) {
             if (ref $node) {
                 return CORE::bless $node, $class;
             }
@@ -302,6 +302,9 @@ sub _parse_explicit {
                 return CORE::bless \$node, $class;
             }
         }
+        else {
+            return $node;
+        }
     }
     elsif (ref $node) {
         require YAML::Node;
diff --git a/lib/YAML/Types.pm b/lib/YAML/Types.pm
index aa55892..64fffd7 100644
--- a/lib/YAML/Types.pm
+++ b/lib/YAML/Types.pm
@@ -99,7 +99,9 @@ sub yaml_load {
     }
     no strict 'refs';
     if (exists $node->{SCALAR}) {
-        *{"${package}::$name"} = \$node->{SCALAR};
+        if ($YAML::LoadBlessed) {
+            *{"${package}::$name"} = \$node->{SCALAR};
+        }
         delete $node->{SCALAR};
     }
     for my $elem (qw(ARRAY HASH CODE IO)) {
@@ -109,7 +111,9 @@ sub yaml_load {
                 delete $node->{IO};
                 next;
             }
-            *{"${package}::$name"} = $node->{$elem};
+            if ($YAML::LoadBlessed) {
+                *{"${package}::$name"} = $node->{$elem};
+            }
             delete $node->{$elem};
         }
     }
@@ -166,12 +170,12 @@ sub yaml_load {
             return sub {};
         }
         else {
-            CORE::bless $code, $class if $class;
+            CORE::bless $code, $class if ($class and $YAML::LoadBlessed);
             return $code;
         }
     }
     else {
-        return CORE::bless sub {}, $class if $class;
+        return CORE::bless sub {}, $class if ($class and $YAML::LoadBlessed);
         return sub {};
     }
 }
@@ -228,7 +232,7 @@ sub yaml_load {
     $flags =~ s/^\^//;
     my $sub = _QR_TYPES->{$flags} || sub { qr{$_[0]} };
     my $qr = &$sub($re);
-    bless $qr, $class if length $class;
+    bless $qr, $class if (length $class and $YAML::LoadBlessed);
     return $qr;
 }
 
diff --git a/test/no-load-blessed.t b/test/no-load-blessed.t
new file mode 100644
index 0000000..c55b0c9
--- /dev/null
+++ b/test/no-load-blessed.t
@@ -0,0 +1,110 @@
+use strict;
+use lib -e 't' ? 't' : 'test';
+use TestYAML tests => 10;
+use Test::Deep;
+use YAML ();
+$YAML::LoadBlessed = 0;
+
+run {
+    my $block = shift;
+    my @result = eval {
+        Load($block->yaml)
+    };
+    my $error1 = $@ || '';
+    if ( $error1 ) {
+        # $error1 =~ s{line: (\d+)}{"line: $1   ($0:".($1+$test->{lines}{yaml}-1).")"}e;
+    }
+    my @expect = eval $block->perl;
+    my $error2 = $@ || '';
+    if (my $errors = $error1 . $error2) {
+        fail($block->description
+              . $errors);
+        next;
+    }
+    cmp_deeply(
+        \@result,
+        \@expect,
+        $block->description,
+    ) or do {
+        require Data::Dumper;
+        diag("Wanted: ".Data::Dumper::Dumper(\@expect));
+        diag("Got: ".Data::Dumper::Dumper(\@result));
+    }
+};
+
+{
+    local $YAML::LoadCode = 1;
+    my $data = YAML::Load(<<'EOM');
+--- !!perl/code:Foo::Bar |
+{
+    return $_[0] * 2
+}
+EOM
+    my $ref = ref $data;
+    cmp_ok($ref, 'eq', 'CODE', "Coderef loaded, but not blessed");
+    my $result = $data->(2);
+    cmp_ok($result, 'eq', 4, "Coderef works");
+}
+
+{
+    $main::foo = 23;
+    my $data = YAML::Load(<<'EOM');
+--- !!perl/glob:moose
+  PACKAGE: main
+  NAME: foo
+  SCALAR: 42
+EOM
+    my $ref = ref $data;
+    cmp_ok($main::foo, '==', 23, "Glob did not set variable");
+}
+
+__DATA__
+=== an array of assorted junk
++++ yaml
+---
+# a private Perl XYZ object
+- !perl/XYZ {small: object}
+# an object containing objects
+- !perl/ABC [!perl/@DEF [a,b,c],!perl/GHI {do: re, mi: fa, so: la,ti: do}]
++++ perl
+my $i = {small => 'object'};
+my $j = [[qw(a b c)],
+            {do => 're', mi => 'fa', so => 'la', ti => 'do'},
+          ];
+[ $i, $j ]
+=== !!perl/array:moose
++++ yaml
+--- !!perl/array:moose
+- 1
++++ perl
+[ 1 ]
+=== !!perl/hash:moose
++++ yaml
+--- !!perl/hash:moose
+foo: bar
++++ perl
+{ foo => "bar" }
+=== !!perl/ref:moose
++++ yaml
+--- !!perl/ref:moose
+=: 1
++++ perl
+do { my $x = 1; \$x}
+=== !!perl/scalar:moose
++++ yaml
+--- !!perl/scalar:moose 1
++++ perl
+do { my $x = 1; \$x}
+=== !!perl/regexp:moose
++++ yaml
+--- !!perl/regexp:moose (?-xism:foo$)
++++ perl
+qr{foo$}
+=== !!perl/glob:moose
++++ yaml
+--- !!perl/glob:moose
+  PACKAGE: main
+  NAME: foo
+  SCALAR: 0
++++ perl
+*main::foo