import YAML 0.60 from CPAN

git-cpan-module: YAML git-cpan-version: 0.60 git-cpan-authorid: INGY
ingydotnet · Dec 6, 2009 · 0d9e6c1 · 0d9e6c1
1 parent 97afbb7
commit 0d9e6c1
Show file tree

Hide file tree

Showing 42 changed files with 681 additions and 458 deletions.
diff --git a/COMPATIBILITY b/COMPATIBILITY
@@ -0,0 +1,25 @@
+YAML.pm 0.60 breaks compatability with older version by changing the
+tags that are output for serialized objects.
+
+This was the old way:
+
+    --- !perl/Foo::Bar {}
+    --- !perl/@Baz []
+    --- !perl/$Quux ""
+
+New way:
+
+    --- !!perl/hash:Foo::Bar {}
+    --- !!perl/array:Baz []
+    --- !!perl/scalar:Quux ""
+
+* This change was made after discussions with the Python and Ruby
+  implementors 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
+  deprecated) format.
+* The best strategy is to update to the latest version.
+* There are potential problems if you use YAML for RPC and the server
+  and client versions don't match.
+
diff --git a/Changes b/Changes
@@ -1,3 +1,12 @@
+---
+version: 0.60
+date:    Fri Jun 30 21:55:55 CDT 2006
+changes:
+- Changed object tag format in non backwards compatible way
+- Removed support for folded scalar emission
+- Added new tests
+- Sync with YAML::Syck
+
 ---
 version: 0.58
 date:    Tue Feb 14 12:42:34 PST 2006

diff --git a/MANIFEST b/MANIFEST
@@ -1,4 +1,5 @@
 Changes
+COMPATIBILITY
 inc/Module/Install.pm
 inc/Module/Install/Base.pm
 inc/Module/Install/Can.pm
@@ -63,6 +64,7 @@ t/marshall.t
 t/meta-yml.t
 t/node-info.t
 t/pugs-objects.t
+t/references.t
 t/svk-config.yaml
 t/svk.t
 t/test.t

diff --git a/META.yml b/META.yml
@@ -1,16 +1,13 @@
-
+abstract: YAML Ain't Markup Language (tm)
+author: "Ingy d\xC3\xB6t Net <ingy@cpan.org>"
+distribution_type: module
+generated_by: Module::Install version 0.61
+license: perl
+name: YAML
 no_index: 
   directory: 
     - inc
     - t
-generated_by: Module::Install version 0.54
-distribution_type: module
-version: 0.58
-name: YAML
-author: "Ingy d\xC3\xB6t Net <ingy@cpan.org>"
-license: perl
-build_requires: 
-  Test::Base: 0.49
 requires: 
   perl: 5.6.1
-abstract: YAML Ain't Markup Language (tm)
+version: 0.60
diff --git a/Makefile.PL b/Makefile.PL
@@ -1,5 +1,20 @@
 use inc::Module::Install;
 
+print << '_';
+
+*** WARNING ***
+
+This release breaks compatibility with versions earlier than version 0.60 of
+YAML::Syck and YAML.pm when serializing blessed references.
+
+See the COMPATIBILITY file for more information.
+
+_
+
+if (!is_admin()) {
+    exit() unless prompt("Continue installing YAML.pm?", 'y') =~ /^y/i;
+}
+
 name            'YAML';
 all_from        'lib/YAML.pm';
 

diff --git a/inc/Module/Install.pm b/inc/Module/Install.pm
@@ -1,16 +1,44 @@
-#line 1 "/Users/ingy/src/ingy/YAML/inc/Module/Install.pm - /Users/ingy/local/lib/perl5/site_perl/5.8.6/Module/Install.pm"
+#line 1
 package Module::Install;
 
+# For any maintainers:
+# The load order for Module::Install is a bit magic.
+# It goes something like this...
+#
+# IF ( host has Module::Install installed, creating author mode ) {
+#     1. Makefile.PL calls "use inc::Module::Install"
+#     2. $INC{inc/Module/Install.pm} set to installed version of inc::Module::Install
+#     3. The installed version of inc::Module::Install loads
+#     4. inc::Module::Install calls "require Module::Install"
+#     5. The ./inc/ version of Module::Install loads
+# } ELSE {
+#     1. Makefile.PL calls "use inc::Module::Install"
+#     2. $INC{inc/Module/Install.pm} set to ./inc/ version of Module::Install
+#     3. The ./inc/ version of Module::Install loads
+# }
+
 use 5.004;
 use strict 'vars';
+
 use vars qw{$VERSION};
 BEGIN {
-    # Don't forget to update Module::Install::Admin too!
-    $VERSION = '0.54';
+    # All Module::Install core packages now require synchronised versions.
+    # This will be used to ensure we don't accidentally load old or
+    # different versions of modules.
+    # This is not enforced yet, but will be some time in the next few
+    # releases once we can make sure it won't clash with custom
+    # Module::Install extensions.
+    $VERSION = '0.61';
 }
 
-# inc::Module::Install must be loaded first
-unless ( $INC{join('/', inc => split(/::/, __PACKAGE__)).'.pm'} ) {
+# Whether or not inc::Module::Install is actually loaded, the
+# $INC{inc/Module/Install.pm} is what will still get set as long as
+# the caller loaded module this in the documented manner.
+# If not set, the caller may NOT have loaded the bundled version, and thus
+# they may not have a MI version that works with the Makefile.PL. This would
+# result in false errors or unexpected behaviour. And we don't want that.
+my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm';
+unless ( $INC{$file} ) {
     die <<"END_DIE";
 Please invoke ${\__PACKAGE__} with:
 
@@ -24,26 +52,25 @@ END_DIE
 }
 
 use Cwd        ();
-use FindBin;
 use File::Find ();
 use File::Path ();
+use FindBin;
 
 *inc::Module::Install::VERSION = *VERSION;
-@inc::Module::Install::ISA     = 'Module::Install';
+@inc::Module::Install::ISA     = __PACKAGE__;
 
 sub autoload {
-    my $self   = shift;
-    my $caller = $self->_caller;
-    my $cwd    = Cwd::cwd();
-    my $sym    = "$caller\::AUTOLOAD";
-
+    my $self = shift;
+    my $who  = $self->_caller;
+    my $cwd  = Cwd::cwd();
+    my $sym  = "${who}::AUTOLOAD";
     $sym->{$cwd} = sub {
         my $pwd = Cwd::cwd();
         if ( my $code = $sym->{$pwd} ) {
             # delegate back to parent dirs
             goto &$code unless $cwd eq $pwd;
         }
-        $$sym =~ /([^:]+)$/ or die "Cannot autoload $caller - $sym";
+        $$sym =~ /([^:]+)$/ or die "Cannot autoload $who - $sym";
         unshift @_, ($self, $1);
         goto &{$self->can('call')} unless uc($1) eq $1;
     };
@@ -52,18 +79,18 @@ sub autoload {
 sub import {
     my $class = shift;
     my $self  = $class->new(@_);
+    my $who   = $self->_caller;
 
     unless ( -f $self->{file} ) {
         require "$self->{path}/$self->{dispatch}.pm";
         File::Path::mkpath("$self->{prefix}/$self->{author}");
-        $self->{admin} = 
-          "$self->{name}::$self->{dispatch}"->new(_top => $self);
+        $self->{admin} = "$self->{name}::$self->{dispatch}"->new( _top => $self );
         $self->{admin}->init;
         @_ = ($class, _self => $self);
         goto &{"$self->{name}::import"};
     }
 
-    *{$self->_caller . "::AUTOLOAD"} = $self->autoload;
+    *{"${who}::AUTOLOAD"} = $self->autoload;
     $self->preload;
 
     # Unregister loader and worker packages so subdirs can use them again
@@ -74,33 +101,33 @@ sub import {
 sub preload {
     my ($self) = @_;
 
-        unless ( $self->{extentions} ) {
-                $self->load_extensions(
-                        "$self->{prefix}/$self->{path}", $self
-                        );
-        }
+    unless ( $self->{extensions} ) {
+        $self->load_extensions(
+            "$self->{prefix}/$self->{path}", $self
+        );
+    }
 
     my @exts = @{$self->{extensions}};
     unless ( @exts ) {
         my $admin = $self->{admin};
         @exts = $admin->load_all_extensions;
     }
 
-    my %seen_method;
+    my %seen;
     foreach my $obj ( @exts ) {
         while (my ($method, $glob) = each %{ref($obj) . '::'}) {
-            next unless defined *{$glob}{CODE};
+            next unless exists &{ref($obj).'::'.$method};
             next if $method =~ /^_/;
             next if $method eq uc($method);
-            $seen_method{$method}++;
+            $seen{$method}++;
         }
     }
 
-    my $caller = $self->_caller;
-    foreach my $name (sort keys %seen_method) {
-        *{"${caller}::$name"} = sub {
-            ${"${caller}::AUTOLOAD"} = "${caller}::$name";
-            goto &{"${caller}::AUTOLOAD"};
+    my $who = $self->_caller;
+    foreach my $name ( sort keys %seen ) {
+        *{"${who}::$name"} = sub {
+            ${"${who}::AUTOLOAD"} = "${who}::$name";
+            goto &{"${who}::AUTOLOAD"};
         };
     }
 }
@@ -118,30 +145,26 @@ sub new {
 
     $args{dispatch} ||= 'Admin';
     $args{prefix}   ||= 'inc';
-    $args{author}   ||= '.author';
+    $args{author}   ||= ($^O eq 'VMS' ? '_author' : '.author');
     $args{bundle}   ||= 'inc/BUNDLES';
     $args{base}     ||= $base_path;
-
     $class =~ s/^\Q$args{prefix}\E:://;
     $args{name}     ||= $class;
     $args{version}  ||= $class->VERSION;
-
-    unless ($args{path}) {
+    unless ( $args{path} ) {
         $args{path}  = $args{name};
         $args{path}  =~ s!::!/!g;
     }
     $args{file}     ||= "$args{base}/$args{prefix}/$args{path}.pm";
 
-    bless(\%args, $class);
+    bless( \%args, $class );
 }
 
 sub call {
-    my $self   = shift;
-    my $method = shift;
-    my $obj    = $self->load($method) or return;
-
-    unshift @_, $obj;
-    goto &{$obj->can($method)};
+	my ($self, $method) = @_;
+	my $obj = $self->load($method) or return;
+        splice(@_, 0, 2, $obj);
+	goto &{$obj->can($method)};
 }
 
 sub load {
@@ -167,13 +190,13 @@ END_DIE
 }
 
 sub load_extensions {
-    my ($self, $path, $top_obj) = @_;
+    my ($self, $path, $top) = @_;
 
-    unshift @INC, $self->{prefix}
-        unless grep { $_ eq $self->{prefix} } @INC;
+    unless ( grep { lc $_ eq lc $self->{prefix} } @INC ) {
+        unshift @INC, $self->{prefix};
+    }
 
-    local @INC = ($path, @INC);
-    foreach my $rv ($self->find_extensions($path)) {
+    foreach my $rv ( $self->find_extensions($path) ) {
         my ($file, $pkg) = @{$rv};
         next if $self->{pathnames}{$pkg};
 
@@ -184,7 +207,7 @@ sub load_extensions {
             next;
         }
         $self->{pathnames}{$pkg} = delete $INC{$file};
-        push @{$self->{extensions}}, &{$new}($pkg, _top => $top_obj );
+        push @{$self->{extensions}}, &{$new}($pkg, _top => $top );
     }
 
     $self->{extensions} ||= [];
@@ -197,26 +220,46 @@ sub find_extensions {
     File::Find::find( sub {
         my $file = $File::Find::name;
         return unless $file =~ m!^\Q$path\E/(.+)\.pm\Z!is;
-        return if $1 eq $self->{dispatch};
+        my $subpath = $1;
+        return if lc($subpath) eq lc($self->{dispatch});
+
+        $file = "$self->{path}/$subpath.pm";
+        my $pkg = "$self->{name}::$subpath";
+        $pkg =~ s!/!::!g;
+
+        # If we have a mixed-case package name, assume case has been preserved
+        # correctly.  Otherwise, root through the file to locate the case-preserved
+        # version of the package name.
+        if ( $subpath eq lc($subpath) || $subpath eq uc($subpath) ) {
+            open PKGFILE, "<$subpath.pm" or die "find_extensions: Can't open $subpath.pm: $!";
+            my $in_pod = 0;
+            while ( <PKGFILE> ) {
+                $in_pod = 1 if /^=\w/;
+                $in_pod = 0 if /^=cut/;
+                next if ($in_pod || /^=cut/);  # skip pod text
+                next if /^\s*#/;               # and comments
+                if ( m/^\s*package\s+($pkg)\s*;/i ) {
+                    $pkg = $1;
+                    last;
+                }
+            }
+            close PKGFILE;
+        }
 
-        $file = "$self->{path}/$1.pm";
-        my $pkg = "$self->{name}::$1"; $pkg =~ s!/!::!g;
         push @found, [ $file, $pkg ];
     }, $path ) if -d $path;
 
     @found;
 }
 
 sub _caller {
-    my $depth  = 0;
-    my $caller = caller($depth);
-
-    while ($caller eq __PACKAGE__) {
+    my $depth = 0;
+    my $call  = caller($depth);
+    while ( $call eq __PACKAGE__ ) {
         $depth++;
-        $caller = caller($depth);
+        $call = caller($depth);
     }
-
-    $caller;
+    return $call;
 }
 
 1;