| Subject: | ability to disable blessing datastructures |
The attached patch gives YAML::Syck the ability to import a YAML
document without blessing datastructures that would normally be blessed
based on their taguri.
For example, the following document would normally load a blessed hash:
---
!foo/bar
a: b
Is loaded as
bless( {
'a' => 'b'
}, 'foo::bar' );
I needed the option to load that as a plain hash, instead.
Documentation from the patch:
=head2 $YAML::Syck::LoadBlessed
Defaults to true. Setting this to a false value will prevent C<Load>
from blessing tag names that do not begin with C<!!perl> or C<!perl>
| Subject: | syck.patch |
diff -ru YAML-Syck-1.04/lib/YAML/Syck.pm YAML-Syck-1.04-modified/lib/YAML/Syck.pm
--- YAML-Syck-1.04/lib/YAML/Syck.pm 2008-02-16 11:11:22.000000000 -0500
+++ YAML-Syck-1.04-modified/lib/YAML/Syck.pm 2008-05-29 18:49:04.000000000 -0400
@@ -7,7 +7,7 @@
$Headless $SortKeys $SingleQuote
$ImplicitBinary $ImplicitTyping $ImplicitUnicode
$UseCode $LoadCode $DumpCode
- $DeparseObject
+ $DeparseObject $LoadBlessed
);
use 5.00307;
use Exporter;
@@ -18,6 +18,7 @@
@ISA = qw( Exporter );
$SortKeys = 1;
+ $LoadBlessed = 1;
local $@;
eval {
@@ -221,6 +222,11 @@
Setting C<$YAML::Syck::UseCode> to a true value is equivalent to setting
both C<$YAML::Syck::LoadCode> and C<$YAML::Syck::DumpCode> to true.
+=head2 $YAML::Syck::LoadBlessed
+
+Defaults to true. Setting this to a false value will prevent C<Load> from
+blessing tag names that do not begin with C<!!perl> or C<!perl>; see below.
+
=head1 BUGS
Dumping Glob/IO values does not work yet.
@@ -237,7 +243,9 @@
the C<!hs/foo> and C<!!hs/Foo> tags are blessed into C<hs::Foo>. Note that
this holds true even if the tag contains non-word characters; for example,
C<!haskell.org/Foo> is blessed into C<haskell.org::Foo>. Please use
-L<Class::Rebless> to cast it into other user-defined packages.
+L<Class::Rebless> to cast it into other user-defined packages. You can also
+set the LoadBlessed flag false to disable blessing tag names that do not begin
+with C<!!perl> or C<!perl>.
=head1 SEE ALSO
diff -ru YAML-Syck-1.04/perl_common.h YAML-Syck-1.04-modified/perl_common.h
--- YAML-Syck-1.04/perl_common.h 2008-02-16 07:13:21.000000000 -0500
+++ YAML-Syck-1.04-modified/perl_common.h 2008-05-29 14:11:09.000000000 -0400
@@ -42,6 +42,7 @@
AV *objects;
bool implicit_unicode;
bool load_code;
+ bool load_blessed;
};
SV* perl_syck_lookup_sym( SyckParser *p, SYMID v) {
diff -ru YAML-Syck-1.04/perl_syck.h YAML-Syck-1.04-modified/perl_syck.h
--- YAML-Syck-1.04/perl_syck.h 2008-02-16 11:06:44.000000000 -0500
+++ YAML-Syck-1.04-modified/perl_syck.h 2008-05-29 14:18:42.000000000 -0400
@@ -81,6 +81,7 @@
#ifndef YAML_IS_JSON
struct parser_xtra *bonus = (struct parser_xtra *)p->bonus;
bool load_code = bonus->load_code;
+ bool load_blessed = bonus->load_blessed;
#endif
while (id && (*id == '!')) { id++; }
@@ -351,7 +352,7 @@
sv_bless(sv, gv_stashpv(type, TRUE));
}
}
- else {
+ else if (load_blessed) {
sv_bless(sv, gv_stashpv(form((type == NULL) ? "%s" : "%s::%s", lang, type), TRUE));
}
}
@@ -470,7 +471,7 @@
if ( (type != NULL) && strNE(type, "hash") && *type != '\0' ) {
sv_bless(sv, gv_stashpv(type, TRUE));
}
- } else {
+ } else if (load_blessed) {
sv_bless(sv, gv_stashpv(form((type == NULL) ? "%s" : "%s::%s", lang, type), TRUE));
}
}
@@ -593,6 +594,7 @@
SV *implicit_typing = GvSV(gv_fetchpv(form("%s::ImplicitTyping", PACKAGE_NAME), TRUE, SVt_PV));
SV *implicit_unicode = GvSV(gv_fetchpv(form("%s::ImplicitUnicode", PACKAGE_NAME), TRUE, SVt_PV));
SV *singlequote = GvSV(gv_fetchpv(form("%s::SingleQuote", PACKAGE_NAME), TRUE, SVt_PV));
+ SV *load_blessed = GvSV(gv_fetchpv(form("%s::LoadBlessed", PACKAGE_NAME), TRUE, SVt_PV));
json_quote_char = (SvTRUE(singlequote) ? '\'' : '"' );
ENTER; SAVETMPS;
@@ -620,6 +622,7 @@
bonus.objects = (AV*)sv_2mortal((SV*)newAV());
bonus.implicit_unicode = SvTRUE(implicit_unicode);
bonus.load_code = SvTRUE(use_code) || SvTRUE(load_code);
+ bonus.load_blessed = SvTRUE(load_blessed);
parser->bonus = &bonus;
#ifndef YAML_IS_JSON
diff -ru YAML-Syck-1.04/t/3-objects.t YAML-Syck-1.04-modified/t/3-objects.t
--- YAML-Syck-1.04/t/3-objects.t 2008-01-20 18:02:01.000000000 -0500
+++ YAML-Syck-1.04-modified/t/3-objects.t 2008-05-29 14:36:53.000000000 -0400
@@ -1,4 +1,4 @@
-use t::TestYAML tests => 29, (
+use t::TestYAML tests => 47, (
($] < 5.008) ? (todo => [19..20, 26..29])
: ()
);
@@ -25,6 +25,7 @@
!haskell.org/^Foo haskell.org::Foo
!!perl HASH
!!moose moose
+ !ruby/object:Test::Bear ruby::object:Test::Bear
));
my $rx = qr/123/;
@@ -61,4 +62,17 @@
is(eval { $sub->() }, 42, "it's a CODE");
}
+$YAML::Syck::LoadBlessed = 0;
+
+run_ref_ok(qw(
+ !!perl/hash:foo foo
+ !perl/foo foo
+ !hs/Foo HASH
+ !haskell.org/Foo HASH
+ !haskell.org/^Foo HASH
+ !!perl HASH
+ !!moose HASH
+ !ruby/object:Test::Bear HASH
+));
+
exit;