import YAML-Syck 0.86 from CPAN

git-cpan-module: YAML-Syck git-cpan-version: 0.86 git-cpan-authorid: AUDREYT git-cpan-file: authors/id/A/AU/AUDREYT/YAML-Syck-0.86.tar.gz
cpan-authors · Dec 14, 2009 · a86614a · a86614a
1 parent d7c97cb
commit a86614a
Show file tree

Hide file tree

Showing 9 changed files with 162 additions and 65 deletions.
diff --git a/COMPATIBILITY b/COMPATIBILITY
@@ -1,5 +1,5 @@
-YAML.pm 0.60 breaks compatability with older version by changing the
-tags that are output for serialized objects.
+YAML::Syck and YAML.pm 0.60 breaks compatibility with older versions by
+changing the tags that are output for serialized objects.
 
 This was the old way:
 
@@ -14,7 +14,7 @@ New way:
     --- !!perl/scalar:Quux ""
 
 * This change was made after discussions with the Python and Ruby
-  implementors to standardize on this form.
+  implementers to standardize on this form.
 * YAML::Syck was updated at the same time as YAML.pm so that they
   serialize objects the same way.
 * YAML.pm roundtrips the new format and still parses the old (now

diff --git a/Changes b/Changes
@@ -1,3 +1,9 @@
+[Changes for 0.86 (JSON::Syck 0.24) - 2007-06-16]
+
+* Support for dumping and loading regexps created by qr//, including
+  blessed once.  Note that loading Regexp values dumped by YAML.pm
+  currently discards modifiers.
+
 [Changes for 0.85 (JSON::Syck 0.24) - 2007-04-20]
 
 * Strings containing both single quotes and newlines were incorrectly 

diff --git a/META.yml b/META.yml
@@ -1,17 +1,17 @@
---- 
-abstract: Fast, lightweight YAML loader and dumper
-author: Audrey Tang <[email protected]>
+---
+abstract: 'Fast, lightweight YAML loader and dumper'
+author: 'Audrey Tang <[email protected]>'
 distribution_type: module
-generated_by: Module::Install version 0.64
+generated_by: 'Module::Install version 0.64'
 license: MIT
-meta-spec: 
+meta-spec:
   url: http://module-build.sourceforge.net/META-spec-v1.3.html
   version: 1.3
 name: YAML-Syck
-no_index: 
-  directory: 
+no_index:
+  directory:
     - inc
     - t
-requires: 
+requires:
   perl: 5.00307
-version: 0.85
+version: 0.86
diff --git a/Makefile.PL b/Makefile.PL
@@ -6,8 +6,8 @@ print << '_';
 
 *** WARNING ***
 
-This release breaks compatibility with versions earlier than version 0.60 of
-YAML::Syck and YAML.pm when serializing blessed references.
+YAML::Syck version >=0.60 breaks compatibility with earlier versions of
+YAML::Syck and YAML.pm (<0.60) when serializing blessed references.
 
 See the COMPATIBILITY file for more information.
 

diff --git a/SIGNATURE b/SIGNATURE
@@ -14,12 +14,12 @@ not run its Makefile.PL or Build.PL.
 -----BEGIN PGP SIGNED MESSAGE-----
 Hash: SHA1
 
-SHA1 04dd79e514dfd404ae0fa66c6e86db15ec165a96 COMPATIBILITY
+SHA1 266b208fdc19cae4b9355a2cabd18c336d6e1997 COMPATIBILITY
 SHA1 3710975c0e6727079e17c6d1f27948c40729d710 COPYING
-SHA1 aa45e7ff83aee9fefc01b3aa4447c704426e2e82 Changes
+SHA1 af53d2befa060b484e1ee9487888afdb2088f6e0 Changes
 SHA1 a21d762d2a8a269f70b8ebb13aa2a88b37417cf1 MANIFEST
-SHA1 d930bc7ebbae1c7ebc619eceee0cd3582d0fc66d META.yml
-SHA1 0580343d0970b444f3d33516084840dd06a09452 Makefile.PL
+SHA1 a37e5e92a896d112eb4f26f90d57cf60a4858548 META.yml
+SHA1 f4bc8b1d6ffdd5ae2c592303af7c8a3936140381 Makefile.PL
 SHA1 4ff9b64038872c3d255b9c000a1f9fb2d000ea29 README
 SHA1 33c36d61607a784b206df02e9508c31649106d77 Syck.xs
 SHA1 e8f69df417217515647747d232d15520ac59f6cc bytecode.c
@@ -44,11 +44,11 @@ SHA1 45d0149fee8d12082d0aa00fd9202f4b29126824 inc/Test/More.pm
 SHA1 c974fe452f5e7ddb37d0a7b9acd15ba69c87173a lib/JSON/Syck.pm
 SHA1 2c2459b2b5cf94a7f9cd1905a242d7d01616ee0b lib/YAML/Dumper/Syck.pm
 SHA1 534000ebfb91c993f5344ae4e34185d853954e6f lib/YAML/Loader/Syck.pm
-SHA1 6701b20ecb378f36b5c52e19f219ac4ea2ee7545 lib/YAML/Syck.pm
-SHA1 7ee26f05efb45a2b0e35fd28c41ffc5a9390ccf7 lib/YAML/Syck.pod
+SHA1 7e14187b7bdfe4a1344f35b16525ff4e14990737 lib/YAML/Syck.pm
+SHA1 cde76e6cc1e74544103f4ea888094061d1a30e2e lib/YAML/Syck.pod
 SHA1 118fa2ebec0e4625ec143d9264b2784dc6cfac21 node.c
 SHA1 7108100e0fec832b239e4242baa1b589fc7fe1b5 perl_common.h
-SHA1 5483f2be18f91443695dcd04ec770b57e2e11f64 perl_syck.h
+SHA1 77956cfc46e6876fffd7edc2d8bdb8d50776d483 perl_syck.h
 SHA1 b8b76e40ef700b2dec432593c3883b0c11636aff ppport.h
 SHA1 9c9255d4d1a4b4ce5aa75ae4220df496cf8e4a44 ppport_math.h
 SHA1 604dd165210e0209bc5464e9793cdd22d9c6e3fd ppport_sort.h
@@ -58,7 +58,7 @@ SHA1 c86fd38b50f37b1d7ab6ff67aaa7c96b546d68b2 syck_st.c
 SHA1 dcb50a2c553f7d65b8be60f28305409a4286528a syck_st.h
 SHA1 fb1887fc7f53fdc1aefcecf565e659fca05fbba1 t/1-basic.t
 SHA1 179c565d860e9d81f19a0bc3436949f7d3611e46 t/2-scalars.t
-SHA1 92e3ec103323d2ae1b3aa6187f7e0fe92c3c4045 t/3-objects.t
+SHA1 14d73e412c13a4c857ca5bf4fe8e1044eae0f0b9 t/3-objects.t
 SHA1 3d204931ed3bec06971a56a07fd3952c19330ccb t/4-perl_tag_scheme.t
 SHA1 d34d0ed79fa71e5beb8843ff857b9bb5c8cdd3ef t/TestYAML.pm
 SHA1 1a278cbeeaca14991216462b198b2dea08b8f5b8 t/json-basic.t
@@ -79,7 +79,7 @@ SHA1 b0528d36416a3650b8514d8f65093fe894adc3a5 yamlbyte.h
 -----BEGIN PGP SIGNATURE-----
 Version: GnuPG v1.4.3 (Darwin)
 
-iD8DBQFGKNKRtLPdNzw1AaARAsXGAJ92rvGp5OZT+DdyBgz0czc/d7GJowCfda9z
-PP2HDN1jZwCVSrkdqgN3Aw4=
-=Kff1
+iD8DBQFGc+KftLPdNzw1AaARAtRuAKCfk4hR2a85yA1YA/CYooBW0qhl3wCguof7
+2h0Emyf8lCgTaR4Uxwdg05M=
+=B7QH
 -----END PGP SIGNATURE-----
diff --git a/lib/YAML/Syck.pm b/lib/YAML/Syck.pm
@@ -11,7 +11,7 @@ use 5.00307;
 use Exporter;
 
 BEGIN {
-    $VERSION = '0.85';
+    $VERSION = '0.86';
     @EXPORT  = qw( Dump Load DumpFile LoadFile );
     @ISA     = qw( Exporter );
 
@@ -29,6 +29,16 @@ BEGIN {
     };
 }
 
+sub __qr_helper {
+    # XXX - Really bad idea - should split to MODIFIERS and REGEXP keys as per YAML.pm.
+    if (index($_[0], '(?-xism:') == 0) {
+        qr/${\substr($_[0], 8, -1)}/;
+    }
+    else {
+        qr/$_[0]/;
+    }
+}
+
 sub Dump {
     $#_ ? join('', map { YAML::Syck::DumpYAML($_) } @_)
         : YAML::Syck::DumpYAML($_[0]);

diff --git a/lib/YAML/Syck.pod b/lib/YAML/Syck.pod
@@ -6,7 +6,7 @@ YAML::Syck - Fast, lightweight YAML loader and dumper
 
 =head1 VERSION
 
-This document describes version 0.85 of YAML::Syck, released April 20, 2007.
+This document describes version 0.86 of YAML::Syck, released April 20, 2007.
 
 =head1 SYNOPSIS
 
@@ -84,12 +84,22 @@ scalars containing high-bit bytes.
 
 =head2 $YAML::Syck::DumpCode
 
-These control whether or not to try and eval/deparse perl source code.
+These flags control whether or not to try and eval/deparse perl source code;
+each of them defaults to false.
+
+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.
+
+=head1 BUGS
+
+Loading Regexp values dumped by YAML.pm currently discards modifiers.
+
+Dumping Glob/IO values does not work yet.
 
 =head1 CAVEATS
 
 The current implementation bundles libsyck source code; if your system has a
-side-wide shared libsyck, it will I<not> be used.
+site-wide shared libsyck, it will I<not> be used.
 
 Tag names such as C<!!perl/hash:Foo> is blessed into the package C<Foo>, but
 the C<!hs/foo> and C<!!hs/Foo> tags are blessed into C<hs::Foo>.  Note that

diff --git a/perl_syck.h b/perl_syck.h
@@ -37,6 +37,8 @@ static enum scalar_style json_quote_style = scalar_2quote;
 #  define PERL_SYCK_INDENT_LEVEL 0
 #else
 #  define PACKAGE_NAME  "YAML::Syck"
+#  define REGEXP_LITERAL  "REGEXP"
+#  define REGEXP_LITERAL_LENGTH 6
 #  define REF_LITERAL  "="
 #  define REF_LITERAL_LENGTH 1
 #  define NULL_LITERAL  "~"
@@ -354,6 +356,50 @@ yaml_syck_parser_handler
                     }
                 }
             }
+            else if ( (id != NULL) && (strEQ(id, "perl/regexp") || strnEQ( id, "perl/regexp:", 12 ) ) ) {
+                /* handle regexp references, that are a weird type of mappings */
+                /* XXX - MODIFIERS support */
+
+                dSP;
+                SV* key = perl_syck_lookup_sym(p, syck_map_read(n, map_key, 0));
+                SV* val = perl_syck_lookup_sym(p, syck_map_read(n, map_value, 0));
+                char *ref_type = SvPVX(key);
+
+                ENTER;
+                SAVETMPS;
+                PUSHMARK(sp);
+                XPUSHs(val);
+                PUTBACK;
+                call_pv("YAML::Syck::__qr_helper", G_SCALAR);
+                SPAGAIN;
+
+                sv = newSVsv(POPs);
+
+                if (strnNE(ref_type, REGEXP_LITERAL, REGEXP_LITERAL_LENGTH+1)) {
+                    /* handle the weird audrey scalar ref stuff */
+                    sv_bless(sv, gv_stashpv(ref_type, TRUE));
+                }
+                else {
+                    /* bless it if necessary */
+                    char *lang = strtok(id, "/:");
+                    char *type = strtok(NULL, "");
+
+                    if ( type != NULL && strnEQ(type, "regexp:", 7)) {
+                        /* !perl/regexp:Foo::Bar blesses into Foo::Bar */
+                        type += 7;
+                    }
+
+                    if (lang == NULL || (strEQ(lang, "perl"))) {
+                        /* !perl/regexp on it's own causes no blessing */
+                        if ( (type != NULL) && strNE(type, "regexp") && (*type != '\0')) {
+                            sv_bless(sv, gv_stashpv(type, TRUE));
+                        }
+                    }
+                    else {
+                        sv_bless(sv, gv_stashpv(form((type == NULL) ? "%s" : "%s::%s", lang, type), TRUE));
+                    }
+                }
+            }
             else
 #endif
             {
@@ -499,15 +545,15 @@ static SV * LoadYAML (char *s) {
     SYMID v;
     SyckParser *parser;
     struct parser_xtra bonus;
-    SV *obj = &PL_sv_undef;
-    SV *use_code = GvSV(gv_fetchpv(form("%s::UseCode", PACKAGE_NAME), TRUE, SVt_PV));
-    SV *load_code = GvSV(gv_fetchpv(form("%s::LoadCode", PACKAGE_NAME), TRUE, SVt_PV));
-    SV *implicit_binary = GvSV(gv_fetchpv(form("%s::ImplicitBinary", PACKAGE_NAME), TRUE, SVt_PV));
-    SV *implicit_typing = GvSV(gv_fetchpv(form("%s::ImplicitTyping", PACKAGE_NAME), TRUE, SVt_PV));
+
+    SV *obj              = &PL_sv_undef;
+    SV *use_code         = GvSV(gv_fetchpv(form("%s::UseCode", PACKAGE_NAME), TRUE, SVt_PV));
+    SV *load_code        = GvSV(gv_fetchpv(form("%s::LoadCode", PACKAGE_NAME), TRUE, SVt_PV));
+    SV *implicit_binary  = GvSV(gv_fetchpv(form("%s::ImplicitBinary", PACKAGE_NAME), TRUE, SVt_PV));
+    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));
-    json_quote_char = (SvTRUE(singlequote) ? '\'' : '"' );
-/*    json_quote_style = (SvTRUE(singlequote) ? scalar_1quote : scalar_2quote ); */
+    SV *singlequote      = GvSV(gv_fetchpv(form("%s::SingleQuote", PACKAGE_NAME), TRUE, SVt_PV));
+    json_quote_char      = (SvTRUE(singlequote) ? '\'' : '"' );
 
     ENTER; SAVETMPS;
 
@@ -531,10 +577,10 @@ static SV * LoadYAML (char *s) {
     syck_parser_implicit_typing(parser, SvTRUE(implicit_typing));
     syck_parser_taguri_expansion(parser, 0);
 
-    bonus.objects = (AV*)sv_2mortal((SV*)newAV());
+    bonus.objects          = (AV*)sv_2mortal((SV*)newAV());
     bonus.implicit_unicode = SvTRUE(implicit_unicode);
-    bonus.load_code = SvTRUE(use_code) || SvTRUE(load_code);
-    parser->bonus = &bonus;
+    bonus.load_code        = SvTRUE(use_code) || SvTRUE(load_code);
+    parser->bonus          = &bonus;
 
 #ifndef YAML_IS_JSON
     if (GIMME_V == G_ARRAY) {
@@ -643,14 +689,14 @@ yaml_syck_emitter_handler
 #endif
 (SyckEmitter *e, st_data_t data) {
     I32  len, i;
-    SV*  sv = (SV*)data;
+    SV*  sv                    = (SV*)data;
     struct emitter_xtra *bonus = (struct emitter_xtra *)e->bonus;
-    char* tag = bonus->tag;
-    svtype ty = SvTYPE(sv);
+    char* tag                  = bonus->tag;
+    svtype ty                  = SvTYPE(sv);
 #ifndef YAML_IS_JSON
-    char dump_code = bonus->dump_code;
-    char implicit_binary = bonus->implicit_binary;
-    char* ref = NULL;
+    char dump_code             = bonus->dump_code;
+    char implicit_binary       = bonus->implicit_binary;
+    char* ref                  = NULL;
 #endif
 
 #define OBJECT_TAG     "tag:!perl:"
@@ -675,15 +721,32 @@ yaml_syck_emitter_handler
 
             /* flatten scalar ref objects so that they dump as !perl/scalar:Foo::Bar foo */
             case SVt_PVMG: {
-                if ( !SvROK(SvRV(sv)) ) {
-                    strcat(tag, "scalar:");
-                    sv = SvRV(sv);
-                    ty = SvTYPE(sv);
-                    break;
-                } else {
+                if ( SvROK(SvRV(sv)) ) {
                     strcat(tag, "ref:");
                     break;
                 }
+                else {
+                    MAGIC *mg;
+                    if (mg = mg_find(SvRV(sv), PERL_MAGIC_qr)) {
+                        strcat(tag, "regexp:");
+                        if (strNE(ref, "Regexp")) {
+                            strcat(tag, ref);
+                        }
+                        /* XXX - Emit "MODIFIERS" key as well */
+                        syck_emit_map( e, tag, MAP_NONE);
+                        *tag = '\0';
+                        syck_emit_item( e, (st_data_t)newSVpvn_share(REGEXP_LITERAL, REGEXP_LITERAL_LENGTH, 0) );
+                        syck_emit_item( e, (st_data_t)newSVpvn(SvPV_nolen(sv), sv_len(sv)));
+                        syck_emit_end(e);
+                        return;
+                    }
+                    else {
+                        strcat(tag, "scalar:");
+                        sv = SvRV(sv);
+                        ty = SvTYPE(sv);
+                    }
+                    break;
+                }
             }
         }
         strcat(tag, ref);
@@ -938,22 +1001,22 @@ DumpYAML
 #endif
 (SV *sv) {
     struct emitter_xtra bonus;
-    SV* out = newSVpvn("", 0);
     SyckEmitter *emitter = syck_new_emitter();
-    SV *headless = GvSV(gv_fetchpv(form("%s::Headless", PACKAGE_NAME), TRUE, SVt_PV));
+    SV* out              = newSVpvn("", 0);
+    SV *headless         = GvSV(gv_fetchpv(form("%s::Headless", PACKAGE_NAME), TRUE, SVt_PV));
     SV *implicit_unicode = GvSV(gv_fetchpv(form("%s::ImplicitUnicode", PACKAGE_NAME), TRUE, SVt_PV));
-    SV *implicit_binary = GvSV(gv_fetchpv(form("%s::ImplicitBinary", PACKAGE_NAME), TRUE, SVt_PV));
-    SV *use_code = GvSV(gv_fetchpv(form("%s::UseCode", PACKAGE_NAME), TRUE, SVt_PV));
-    SV *dump_code = GvSV(gv_fetchpv(form("%s::DumpCode", PACKAGE_NAME), TRUE, SVt_PV));
-    SV *sortkeys = GvSV(gv_fetchpv(form("%s::SortKeys", PACKAGE_NAME), TRUE, SVt_PV));
+    SV *implicit_binary  = GvSV(gv_fetchpv(form("%s::ImplicitBinary", PACKAGE_NAME), TRUE, SVt_PV));
+    SV *use_code         = GvSV(gv_fetchpv(form("%s::UseCode", PACKAGE_NAME), TRUE, SVt_PV));
+    SV *dump_code        = GvSV(gv_fetchpv(form("%s::DumpCode", PACKAGE_NAME), TRUE, SVt_PV));
+    SV *sortkeys         = GvSV(gv_fetchpv(form("%s::SortKeys", PACKAGE_NAME), TRUE, SVt_PV));
 #ifdef YAML_IS_JSON
-    SV *singlequote = GvSV(gv_fetchpv(form("%s::SingleQuote", PACKAGE_NAME), TRUE, SVt_PV));
-    json_quote_char = (SvTRUE(singlequote) ? '\'' : '"' );
-    json_quote_style = (SvTRUE(singlequote) ? scalar_2quote_1 : scalar_2quote );
-    emitter->indent = PERL_SYCK_INDENT_LEVEL;
+    SV *singlequote      = GvSV(gv_fetchpv(form("%s::SingleQuote", PACKAGE_NAME), TRUE, SVt_PV));
+    json_quote_char      = (SvTRUE(singlequote) ? '\'' : '"' );
+    json_quote_style     = (SvTRUE(singlequote) ? scalar_2quote_1 : scalar_2quote );
+    emitter->indent      = PERL_SYCK_INDENT_LEVEL;
 #else
-    SV *singlequote = GvSV(gv_fetchpv(form("%s::SingleQuote", PACKAGE_NAME), TRUE, SVt_PV));
-    yaml_quote_style = (SvTRUE(singlequote) ? scalar_1quote : scalar_none);
+    SV *singlequote      = GvSV(gv_fetchpv(form("%s::SingleQuote", PACKAGE_NAME), TRUE, SVt_PV));
+    yaml_quote_style     = (SvTRUE(singlequote) ? scalar_1quote : scalar_none);
 #endif
 
     ENTER; SAVETMPS;

diff --git a/t/3-objects.t b/t/3-objects.t
@@ -1,4 +1,4 @@
-use t::TestYAML tests => 25;
+use t::TestYAML tests => 29;
 
 ok(YAML::Syck->VERSION);
 
@@ -24,6 +24,14 @@ run_ref_ok(qw(
     !!moose             moose
 ));
 
+my $rx = qr/123/;
+is(Dump($rx), "--- !!perl/regexp: \nREGEXP: (?-xism:123)\n");
+is(Dump(Load(Dump($rx))), "--- !!perl/regexp: \nREGEXP: (?-xism:123)\n");
+
+my $rx_obj = bless qr/123/ => 'Foo';
+is(Dump($rx_obj), "--- !!perl/regexp:Foo \nREGEXP: (?-xism:123)\n");
+is(Dump(Load(Dump($rx_obj))), "--- !!perl/regexp:Foo \nREGEXP: (?-xism:123)\n");
+
 my $obj = bless(\(my $undef) => 'Foo');
 is(Dump($obj), "--- !!perl/scalar:Foo ~\n");
 is(Dump(Load(Dump($obj))), "--- !!perl/scalar:Foo ~\n");