diff --git a/COMPATIBILITY b/COMPATIBILITY new file mode 100644 index 0000000..f1a4494 --- /dev/null +++ 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 index f020e17..e74154c 100644 --- 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 index 44d0615..9742cb2 100644 --- 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 index 6f60129..0dff38e 100644 --- a/META.yml +++ b/META.yml @@ -1,16 +1,13 @@ - +abstract: YAML Ain't Markup Language (tm) +author: "Ingy d\xC3\xB6t Net " +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 " -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 index ea11af8..736c910 100644 --- 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 index eb7a66e..b9c4207 100644 --- 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,11 +101,11 @@ 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 ) { @@ -86,21 +113,21 @@ sub preload { @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,10 +220,32 @@ 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 ( ) { + $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; @@ -208,15 +253,13 @@ sub find_extensions { } 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; diff --git a/inc/Module/Install/Base.pm b/inc/Module/Install/Base.pm index 95a42b6..d003728 100644 --- a/inc/Module/Install/Base.pm +++ b/inc/Module/Install/Base.pm @@ -1,47 +1,52 @@ -#line 1 "inc/Module/Install/Base.pm - /Users/ingy/local/lib/perl5/site_perl/5.8.6/Module/Install/Base.pm" +#line 1 package Module::Install::Base; +$VERSION = '0.61'; + # Suspend handler for "redefined" warnings -BEGIN { my $w = $SIG{__WARN__}; $SIG{__WARN__} = sub { $w } }; +BEGIN { + my $w = $SIG{__WARN__}; + $SIG{__WARN__} = sub { $w }; +} + +### This is the ONLY module that shouldn't have strict on +# use strict; -#line 30 +#line 41 sub new { my ($class, %args) = @_; - foreach my $method (qw(call load)) { + foreach my $method ( qw(call load) ) { *{"$class\::$method"} = sub { - +shift->_top->$method(@_); + shift()->_top->$method(@_); } unless defined &{"$class\::$method"}; } - bless(\%args, $class); + bless( \%args, $class ); } -#line 48 +#line 61 sub AUTOLOAD { my $self = shift; - local $@; my $autoload = eval { $self->_top->autoload } or return; goto &$autoload; } -#line 62 +#line 76 sub _top { $_[0]->{_top} } -#line 73 +#line 89 sub admin { - my $self = shift; - $self->_top->{admin} or Module::Install::Base::FakeAdmin->new; + $_[0]->_top->{admin} or Module::Install::Base::FakeAdmin->new; } sub is_admin { - my $self = shift; - $self->admin->VERSION; + $_[0]->admin->VERSION; } sub DESTROY {} @@ -50,14 +55,16 @@ package Module::Install::Base::FakeAdmin; my $Fake; sub new { $Fake ||= bless(\@_, $_[0]) } + sub AUTOLOAD {} -sub DESTROY {} -1; +sub DESTROY {} # Restore warning handler -BEGIN { $SIG{__WARN__} = $SIG{__WARN__}->() }; +BEGIN { + $SIG{__WARN__} = $SIG{__WARN__}->(); +} -__END__ +1; -#line 120 +#line 138 diff --git a/inc/Module/Install/Can.pm b/inc/Module/Install/Can.pm index 35ac995..f2034db 100644 --- a/inc/Module/Install/Can.pm +++ b/inc/Module/Install/Can.pm @@ -1,69 +1,82 @@ -#line 1 "inc/Module/Install/Can.pm - /Users/ingy/local/lib/perl5/site_perl/5.8.6/Module/Install/Can.pm" +#line 1 package Module::Install::Can; -use Module::Install::Base; @ISA = qw(Module::Install::Base); -$VERSION = '0.01'; use strict; +use Module::Install::Base; use Config (); +### This adds a 5.005 Perl version dependency. +### This is a bug and will be fixed. use File::Spec (); use ExtUtils::MakeMaker (); +use vars qw{$VERSION @ISA}; +BEGIN { + $VERSION = '0.61'; + @ISA = qw{Module::Install::Base}; +} + + # check if we can load some module +### Upgrade this to not have to load the module if possible sub can_use { - my ($self, $mod, $ver) = @_; - $mod =~ s{::|\\}{/}g; - $mod .= ".pm" unless $mod =~ /\.pm$/i; + my ($self, $mod, $ver) = @_; + $mod =~ s{::|\\}{/}g; + $mod .= '.pm' unless $mod =~ /\.pm$/i; - my $pkg = $mod; - $pkg =~ s{/}{::}g; - $pkg =~ s{\.pm$}{}i; + my $pkg = $mod; + $pkg =~ s{/}{::}g; + $pkg =~ s{\.pm$}{}i; - local $@; - eval { require $mod; $pkg->VERSION($ver || 0); 1 }; + local $@; + eval { require $mod; $pkg->VERSION($ver || 0); 1 }; } # check if we can run some command sub can_run { - my ($self, $cmd) = @_; + my ($self, $cmd) = @_; - my $_cmd = $cmd; - return $_cmd if (-x $_cmd or $_cmd = MM->maybe_command($_cmd)); + my $_cmd = $cmd; + return $_cmd if (-x $_cmd or $_cmd = MM->maybe_command($_cmd)); - for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') { - my $abs = File::Spec->catfile($dir, $_[1]); - return $abs if (-x $abs or $abs = MM->maybe_command($abs)); - } + for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') { + my $abs = File::Spec->catfile($dir, $_[1]); + return $abs if (-x $abs or $abs = MM->maybe_command($abs)); + } - return; + return; } +# can we locate a (the) C compiler sub can_cc { - my $self = shift; - my @chunks = split(/ /, $Config::Config{cc}) or return; + my $self = shift; + my @chunks = split(/ /, $Config::Config{cc}) or return; - # $Config{cc} may contain args; try to find out the program part - while (@chunks) { - return $self->can_run("@chunks") || (pop(@chunks), next); - } + # $Config{cc} may contain args; try to find out the program part + while (@chunks) { + return $self->can_run("@chunks") || (pop(@chunks), next); + } - return; + return; } # Fix Cygwin bug on maybe_command(); -if ($^O eq 'cygwin') { - require ExtUtils::MM_Cygwin; - require ExtUtils::MM_Win32; - if (!defined(&ExtUtils::MM_Cygwin::maybe_command)) { - *ExtUtils::MM_Cygwin::maybe_command = sub { - my ($self, $file) = @_; - if ($file =~ m{^/cygdrive/}i and ExtUtils::MM_Win32->can('maybe_command')) { - ExtUtils::MM_Win32->maybe_command($file); - } - else { - ExtUtils::MM_Unix->maybe_command($file); - } - } - } +if ( $^O eq 'cygwin' ) { + require ExtUtils::MM_Cygwin; + require ExtUtils::MM_Win32; + if ( ! defined(&ExtUtils::MM_Cygwin::maybe_command) ) { + *ExtUtils::MM_Cygwin::maybe_command = sub { + my ($self, $file) = @_; + if ($file =~ m{^/cygdrive/}i and ExtUtils::MM_Win32->can('maybe_command')) { + ExtUtils::MM_Win32->maybe_command($file); + } else { + ExtUtils::MM_Unix->maybe_command($file); + } + } + } } 1; + +__END__ + +#line 157 diff --git a/inc/Module/Install/Fetch.pm b/inc/Module/Install/Fetch.pm index 35478c2..09ed284 100644 --- a/inc/Module/Install/Fetch.pm +++ b/inc/Module/Install/Fetch.pm @@ -1,15 +1,21 @@ -#line 1 "inc/Module/Install/Fetch.pm - /Users/ingy/local/lib/perl5/site_perl/5.8.6/Module/Install/Fetch.pm" +#line 1 package Module::Install::Fetch; -use Module::Install::Base; @ISA = qw(Module::Install::Base); -$VERSION = '0.01'; +use strict; +use Module::Install::Base; + +use vars qw{$VERSION @ISA}; +BEGIN { + $VERSION = '0.61'; + @ISA = qw{Module::Install::Base}; +} sub get_file { my ($self, %args) = @_; my ($scheme, $host, $path, $file) = $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return; - if ($scheme eq 'http' and !eval { require LWP::Simple; 1 }) { + if ( $scheme eq 'http' and ! eval { require LWP::Simple; 1 } ) { $args{url} = $args{ftp_url} or (warn("LWP support unavailable!\n"), return); ($scheme, $host, $path, $file) = @@ -53,14 +59,14 @@ sub get_file { chdir $dir; return; } - my @dialog = split(/\n/, << "."); + my @dialog = split(/\n/, <<"END_FTP"); open $host user anonymous anonymous\@example.com cd $path binary get $file $file quit -. +END_FTP foreach (@dialog) { $fh->print("$_\n") } $fh->close; } } diff --git a/inc/Module/Install/Include.pm b/inc/Module/Install/Include.pm index 7086362..526e8c8 100644 --- a/inc/Module/Install/Include.pm +++ b/inc/Module/Install/Include.pm @@ -1,10 +1,31 @@ -#line 1 "inc/Module/Install/Include.pm - /Users/ingy/local/lib/perl5/site_perl/5.8.6/Module/Install/Include.pm" +#line 1 package Module::Install::Include; -use Module::Install::Base; @ISA = qw(Module::Install::Base); -sub include { +shift->admin->include(@_) }; -sub include_deps { +shift->admin->include_deps(@_) }; -sub auto_include { +shift->admin->auto_include(@_) }; -sub auto_include_deps { +shift->admin->auto_include_deps(@_) }; -sub auto_include_dependent_dists { +shift->admin->auto_include_dependent_dists(@_) } +use Module::Install::Base; +@ISA = qw(Module::Install::Base); + +$VERSION = '0.61'; + +use strict; + +sub include { + shift()->admin->include(@_); +} + +sub include_deps { + shift()->admin->include_deps(@_); +} + +sub auto_include { + shift()->admin->auto_include(@_); +} + +sub auto_include_deps { + shift()->admin->auto_include_deps(@_); +} + +sub auto_include_dependent_dists { + shift()->admin->auto_include_dependent_dists(@_); +} + 1; diff --git a/inc/Module/Install/Makefile.pm b/inc/Module/Install/Makefile.pm index 71c928a..d0206aa 100644 --- a/inc/Module/Install/Makefile.pm +++ b/inc/Module/Install/Makefile.pm @@ -1,19 +1,36 @@ -#line 1 "inc/Module/Install/Makefile.pm - /Users/ingy/local/lib/perl5/site_perl/5.8.6/Module/Install/Makefile.pm" +#line 1 package Module::Install::Makefile; -use Module::Install::Base; @ISA = qw(Module::Install::Base); - -$VERSION = '0.01'; use strict 'vars'; -use vars '$VERSION'; - +use Module::Install::Base; use ExtUtils::MakeMaker (); +use vars qw{$VERSION @ISA}; +BEGIN { + $VERSION = '0.61'; + @ISA = qw{Module::Install::Base}; +} + sub Makefile { $_[0] } -sub prompt { +my %seen = (); + +sub prompt { shift; - goto &ExtUtils::MakeMaker::prompt; + + # Infinite loop protection + my @c = caller(); + if ( ++$seen{"$c[1]|$c[2]|$_[0]"} > 3 ) { + die "Caught an potential prompt infinite loop ($c[1]|$c[2]|$_[0])"; + } + + # In automated testing, always use defaults + if ( $ENV{AUTOMATED_TESTING} and ! $ENV{PERL_MM_USE_DEFAULT} ) { + local $ENV{PERL_MM_USE_DEFAULT} = 1; + goto &ExtUtils::MakeMaker::prompt; + } else { + goto &ExtUtils::MakeMaker::prompt; + } } sub makemaker_args { @@ -23,8 +40,19 @@ sub makemaker_args { $args; } -sub build_subdirs { +# For mm args that take multiple space-seperated args, +# append an argument to the current list. +sub makemaker_append { my $self = shift; + my $name = shift; + my $args = $self->makemaker_args; + $args->{name} = defined $args->{$name} + ? join( ' ', $args->{name}, @_ ) + : join( ' ', @_ ); +} + +sub build_subdirs { + my $self = shift; my $subdirs = $self->makemaker_args->{DIR} ||= []; for my $subdir (@_) { push @$subdirs, $subdir; @@ -32,17 +60,26 @@ sub build_subdirs { } sub clean_files { - my $self = shift; + my $self = shift; my $clean = $self->makemaker_args->{clean} ||= {}; %$clean = ( %$clean, - FILES => join(" ", grep length, $clean->{FILES}, @_), + FILES => join(' ', grep length, $clean->{FILES}, @_), + ); +} + +sub realclean_files { + my $self = shift; + my $realclean = $self->makemaker_args->{realclean} ||= {}; + %$realclean = ( + %$realclean, + FILES => join(' ', grep length, $realclean->{FILES}, @_), ); } sub libs { my $self = shift; - my $libs = ref $_[0] ? shift : [shift]; + my $libs = ref $_[0] ? shift : [ shift ]; $self->makemaker_args( LIBS => $libs ); } @@ -56,25 +93,26 @@ sub write { die "&Makefile->write() takes no arguments\n" if @_; my $args = $self->makemaker_args; - $args->{DISTNAME} = $self->name; - $args->{NAME} = $self->module_name || $self->name || $self->determine_NAME($args); - $args->{VERSION} = $self->version || $self->determine_VERSION($args); - $args->{NAME} =~ s/-/::/g; - - $args->{test} = {TESTS => $self->tests} if $self->tests; - + $args->{NAME} = $self->module_name || $self->name || $self->determine_NAME($args); + $args->{VERSION} = $self->version || $self->determine_VERSION($args); + $args->{NAME} =~ s/-/::/g; + if ( $self->tests ) { + $args->{test} = { TESTS => $self->tests }; + } if ($] >= 5.005) { $args->{ABSTRACT} = $self->abstract; - $args->{AUTHOR} = $self->author; + $args->{AUTHOR} = $self->author; } if ( eval($ExtUtils::MakeMaker::VERSION) >= 6.10 ) { $args->{NO_META} = 1; } - if ( eval($ExtUtils::MakeMaker::VERSION) > 6.17 ) { - $args->{SIGN} = 1 if $self->sign; + if ( eval($ExtUtils::MakeMaker::VERSION) > 6.17 and $self->sign ) { + $args->{SIGN} = 1; + } + unless ( $self->is_admin ) { + delete $args->{SIGN}; } - delete $args->{SIGN} unless $self->is_admin; # merge both kinds of requires into prereq_pm my $prereq = ($args->{PREREQ_PM} ||= {}); @@ -91,49 +129,53 @@ sub write { } } - if (my $perl_version = $self->perl_version) { + if ( my $perl_version = $self->perl_version ) { eval "use $perl_version; 1" - or die "ERROR: perl: Version $] is installed, ". - "but we need version >= $perl_version"; + or die "ERROR: perl: Version $] is installed, " + . "but we need version >= $perl_version"; } - my %args = map {($_ => $args->{$_})} grep {defined($args->{$_})} keys %$args; - + my %args = map { ( $_ => $args->{$_} ) } grep {defined($args->{$_})} keys %$args; if ($self->admin->preop) { $args{dist} = $self->admin->preop; } - ExtUtils::MakeMaker::WriteMakefile(%args); - - $self->fix_up_makefile(); + my $mm = ExtUtils::MakeMaker::WriteMakefile(%args); + $self->fix_up_makefile($mm->{FIRST_MAKEFILE} || 'Makefile'); } sub fix_up_makefile { - my $self = shift; - my $top_class = ref($self->_top) || ''; - my $top_version = $self->_top->VERSION || ''; + my $self = shift; + my $makefile_name = shift; + my $top_class = ref($self->_top) || ''; + my $top_version = $self->_top->VERSION || ''; my $preamble = $self->preamble - ? "# Preamble by $top_class $top_version\n" . $self->preamble - : ''; - my $postamble = "# Postamble by $top_class $top_version\n" . - ($self->postamble || ''); + ? "# Preamble by $top_class $top_version\n" + . $self->preamble + : ''; + my $postamble = "# Postamble by $top_class $top_version\n" + . ($self->postamble || ''); local *MAKEFILE; - open MAKEFILE, '< Makefile' or die $!; + open MAKEFILE, "< $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!"; my $makefile = do { local $/; }; - close MAKEFILE; + close MAKEFILE or die $!; $makefile =~ s/\b(test_harness\(\$\(TEST_VERBOSE\), )/$1'inc', /; $makefile =~ s/( -I\$\(INST_ARCHLIB\))/ -Iinc$1/g; $makefile =~ s/( "-I\$\(INST_LIB\)")/ "-Iinc"$1/g; + $makefile =~ s/^(FULLPERL = .*)/$1 "-Iinc"/m; + $makefile =~ s/^(PERL = .*)/$1 "-Iinc"/m; + + # XXX - This is currently unused; not sure if it breaks other MM-users + # $makefile =~ s/^pm_to_blib\s+:\s+/pm_to_blib :: /mg; - $makefile =~ s/^(FULLPERL = .*)/$1 -Iinc/m; - $makefile =~ s/^(PERL = .*)/$1 -Iinc/m; + open MAKEFILE, "> $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!"; + print MAKEFILE "$preamble$makefile$postamble" or die $!; + close MAKEFILE or die $!; - open MAKEFILE, '> Makefile' or die $!; - print MAKEFILE "$preamble$makefile$postamble"; - close MAKEFILE; + 1; } sub preamble { @@ -144,7 +186,6 @@ sub preamble { sub postamble { my ($self, $text) = @_; - $self->{postamble} ||= $self->admin->postamble; $self->{postamble} .= $text if defined $text; $self->{postamble} @@ -154,4 +195,4 @@ sub postamble { __END__ -#line 286 +#line 324 diff --git a/inc/Module/Install/Metadata.pm b/inc/Module/Install/Metadata.pm index 3b559d6..0c47548 100644 --- a/inc/Module/Install/Metadata.pm +++ b/inc/Module/Install/Metadata.pm @@ -1,14 +1,12 @@ -#line 1 "inc/Module/Install/Metadata.pm - /Users/ingy/local/lib/perl5/site_perl/5.8.6/Module/Install/Metadata.pm" +#line 1 package Module::Install::Metadata; -use strict 'vars'; use Module::Install::Base; +@ISA = qw{Module::Install::Base}; -use vars qw($VERSION @ISA); -BEGIN { - $VERSION = '0.06'; - @ISA = 'Module::Install::Base'; -} +$VERSION = '0.61'; + +use strict 'vars'; my @scalar_keys = qw{ name module_name abstract author version license @@ -62,6 +60,16 @@ sub sign { return $self; } +sub dynamic_config { + my $self = shift; + unless ( @_ ) { + warn "You MUST provide an explicit true/false value to dynamic_config, skipping\n"; + return $self; + } + $self->{'values'}{'dynamic_config'} = $_[0] ? 1 : 0; + return $self; +} + sub all_from { my ( $self, $file ) = @_; @@ -130,8 +138,7 @@ sub feature { # The user used ->feature like ->features by passing in the second # argument as a reference. Accomodate for that. $mods = $_[0]; - } - else { + } else { $mods = \@_; } @@ -154,7 +161,9 @@ sub features { while ( my ( $name, $mods ) = splice( @_, 0, 2 ) ) { $self->feature( $name, @$mods ); } - return @{ $self->{values}{features} }; + return $self->{values}->{features} + ? @{ $self->{values}->{features} } + : (); } sub no_index { diff --git a/inc/Module/Install/Scripts.pm b/inc/Module/Install/Scripts.pm index 9145262..fe1d679 100644 --- a/inc/Module/Install/Scripts.pm +++ b/inc/Module/Install/Scripts.pm @@ -1,14 +1,20 @@ -#line 1 "inc/Module/Install/Scripts.pm - /Users/ingy/local/lib/perl5/site_perl/5.8.6/Module/Install/Scripts.pm" +#line 1 package Module::Install::Scripts; -use Module::Install::Base; @ISA = qw(Module::Install::Base); -$VERSION = '0.02'; + use strict; +use Module::Install::Base; use File::Basename (); +use vars qw{$VERSION @ISA}; +BEGIN { + $VERSION = '0.61'; + @ISA = qw(Module::Install::Base); +} + sub prompt_script { my ($self, $script_file) = @_; - my ($prompt, $abstract, $default); + my ($prompt, $abstract, $default); foreach my $line ( $self->_read_script($script_file) ) { last unless $line =~ /^#/; $prompt = $1 if $line =~ /^#\s*prompt:\s+(.*)/; diff --git a/inc/Module/Install/TestBase.pm b/inc/Module/Install/TestBase.pm index c37e3d3..91c8edd 100644 --- a/inc/Module/Install/TestBase.pm +++ b/inc/Module/Install/TestBase.pm @@ -1,4 +1,4 @@ -#line 1 "inc/Module/Install/TestBase.pm - /Users/ingy/local/lib/perl5/site_perl/5.8.6/Module/Install/TestBase.pm" +#line 1 package Module::Install::TestBase; use strict; use warnings; @@ -7,13 +7,12 @@ use Module::Install::Base; use vars qw($VERSION @ISA); BEGIN { - $VERSION = '0.10'; + $VERSION = '0.11'; @ISA = 'Module::Install::Base'; } sub use_test_base { my $self = shift; - $self->build_requires('Test::Base' => '0.49'); $self->include('Test::Base'); $self->include('Test::Base::Filter'); $self->include('Spiffy'); @@ -24,4 +23,4 @@ sub use_test_base { 1; -#line 68 +#line 67 diff --git a/inc/Module/Install/Win32.pm b/inc/Module/Install/Win32.pm index c67bd06..6483b03 100644 --- a/inc/Module/Install/Win32.pm +++ b/inc/Module/Install/Win32.pm @@ -1,40 +1,44 @@ -#line 1 "inc/Module/Install/Win32.pm - /Users/ingy/local/lib/perl5/site_perl/5.8.6/Module/Install/Win32.pm" +#line 1 package Module::Install::Win32; -use Module::Install::Base; @ISA = qw(Module::Install::Base); - -$VERSION = '0.02'; use strict; +use Module::Install::Base; + +use vars qw{$VERSION @ISA}; +BEGIN { + $VERSION = '0.61'; + @ISA = qw{Module::Install::Base}; +} # determine if the user needs nmake, and download it if needed sub check_nmake { - my $self = shift; - $self->load('can_run'); - $self->load('get_file'); - - require Config; - return unless ( - $Config::Config{make} and - $Config::Config{make} =~ /^nmake\b/i and - $^O eq 'MSWin32' and - !$self->can_run('nmake') - ); - - print "The required 'nmake' executable not found, fetching it...\n"; - - require File::Basename; - my $rv = $self->get_file( - url => 'http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe', - ftp_url => 'ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe', - local_dir => File::Basename::dirname($^X), - size => 51928, - run => 'Nmake15.exe /o > nul', - check_for => 'Nmake.exe', - remove => 1, - ); - - if (!$rv) { - die << '.'; + my $self = shift; + $self->load('can_run'); + $self->load('get_file'); + + require Config; + return unless ( + $^O eq 'MSWin32' and + $Config::Config{make} and + $Config::Config{make} =~ /^nmake\b/i and + ! $self->can_run('nmake') + ); + + print "The required 'nmake' executable not found, fetching it...\n"; + + require File::Basename; + my $rv = $self->get_file( + url => 'http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe', + ftp_url => 'ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe', + local_dir => File::Basename::dirname($^X), + size => 51928, + run => 'Nmake15.exe /o > nul', + check_for => 'Nmake.exe', + remove => 1, + ); + + if (!$rv) { + die <<'END_MESSAGE'; ------------------------------------------------------------------------------- @@ -53,11 +57,8 @@ that directory, and run "Nmake15.exe" from there; that will create the You may then resume the installation process described in README. ------------------------------------------------------------------------------- -. - } +END_MESSAGE + } } 1; - -__END__ - diff --git a/inc/Module/Install/WriteAll.pm b/inc/Module/Install/WriteAll.pm index 4d0dffd..586cae2 100644 --- a/inc/Module/Install/WriteAll.pm +++ b/inc/Module/Install/WriteAll.pm @@ -1,6 +1,12 @@ -#line 1 "inc/Module/Install/WriteAll.pm - /Users/ingy/local/lib/perl5/site_perl/5.8.6/Module/Install/WriteAll.pm" +#line 1 package Module::Install::WriteAll; -use Module::Install::Base; @ISA = qw(Module::Install::Base); + +use Module::Install::Base; +@ISA = qw(Module::Install::Base); + +$VERSION = '0.61'; + +use strict; sub WriteAll { my $self = shift; @@ -12,22 +18,20 @@ sub WriteAll { @_ ); - $self->sign(1) if $args{sign}; - $self->Meta->write if $args{meta}; + $self->sign(1) if $args{sign}; + $self->Meta->write if $args{meta}; $self->admin->WriteAll(%args) if $self->is_admin; - if ($0 =~ /Build.PL$/i) { + if ( $0 =~ /Build.PL$/i ) { $self->Build->write; - } - else { + } else { $self->check_nmake if $args{check_nmake}; - $self->makemaker_args( PL_FILES => {} ) - unless $self->makemaker_args->{'PL_FILES'}; - + unless ( $self->makemaker_args->{'PL_FILES'} ) { + $self->makemaker_args( PL_FILES => {} ); + } if ($args{inline}) { $self->Inline->write; - } - else { + } else { $self->Makefile->write; } } diff --git a/inc/Spiffy.pm b/inc/Spiffy.pm index f8d81dc..7b10f7a 100644 --- a/inc/Spiffy.pm +++ b/inc/Spiffy.pm @@ -1,4 +1,4 @@ -#line 1 "inc/Spiffy.pm - /Users/ingy/local/lib/perl5/site_perl/5.8.6/Spiffy.pm" +#line 1 package Spiffy; use strict; use 5.006001; diff --git a/inc/Test/Base.pm b/inc/Test/Base.pm index 5280ea1..81960c0 100644 --- a/inc/Test/Base.pm +++ b/inc/Test/Base.pm @@ -1,11 +1,11 @@ -#line 1 "inc/Test/Base.pm - /Users/ingy/local/lib/perl5/site_perl/5.8.6/Test/Base.pm" +#line 1 # TODO: # package Test::Base; use 5.006001; use Spiffy 0.30 -Base; use Spiffy ':XXX'; -our $VERSION = '0.49'; +our $VERSION = '0.52'; my @test_more_exports; BEGIN { @@ -14,9 +14,11 @@ BEGIN { skip todo_skip pass fail eq_array eq_hash eq_set plan can_ok isa_ok diag + use_ok $TODO ); } + use Test::More import => \@test_more_exports; use Carp; @@ -76,11 +78,18 @@ sub import() { # unless $default_class->isa($class); # } - if (@_ > 1 and not grep /^-base$/i, @_) { - my @args = @_; - shift @args; - Test::More->import(import => \@test_more_exports, @args); - } + unless (grep /^-base$/i, @_) { + my @args; + for (my $ii = 1; $ii <= $#_; ++$ii) { + if ($_[$ii] eq '-package') { + ++$ii; + } else { + push @args, $_[$ii]; + } + } + Test::More->import(import => \@test_more_exports, @args) + if @args; + } _strict_warnings(); goto &Spiffy::import; @@ -627,4 +636,4 @@ sub _get_filters { __DATA__ -#line 1289 +#line 1298 diff --git a/inc/Test/Base/Filter.pm b/inc/Test/Base/Filter.pm index 45e7217..e7e2403 100644 --- a/inc/Test/Base/Filter.pm +++ b/inc/Test/Base/Filter.pm @@ -1,4 +1,4 @@ -#line 1 "inc/Test/Base/Filter.pm - /Users/ingy/local/lib/perl5/site_perl/5.8.6/Test/Base/Filter.pm" +#line 1 #. TODO: #. diff --git a/inc/Test/Builder.pm b/inc/Test/Builder.pm index 473a985..3326796 100644 --- a/inc/Test/Builder.pm +++ b/inc/Test/Builder.pm @@ -1,4 +1,4 @@ -#line 1 "inc/Test/Builder.pm - /Users/ingy/local/lib/perl5/5.8.6/Test/Builder.pm" +#line 1 package Test::Builder; use 5.004; diff --git a/inc/Test/Builder/Module.pm b/inc/Test/Builder/Module.pm index f96212e..633c63b 100644 --- a/inc/Test/Builder/Module.pm +++ b/inc/Test/Builder/Module.pm @@ -1,4 +1,4 @@ -#line 1 "inc/Test/Builder/Module.pm - /Users/ingy/local/lib/perl5/5.8.6/Test/Builder/Module.pm" +#line 1 package Test::Builder::Module; use Test::Builder; @@ -6,7 +6,7 @@ use Test::Builder; require Exporter; @ISA = qw(Exporter); -$VERSION = '0.03'; +$VERSION = '0.02'; use strict; diff --git a/inc/Test/More.pm b/inc/Test/More.pm index 8cb3a8c..471ede9 100644 --- a/inc/Test/More.pm +++ b/inc/Test/More.pm @@ -1,4 +1,4 @@ -#line 1 "inc/Test/More.pm - /Users/ingy/local/lib/perl5/5.8.6/Test/More.pm" +#line 1 package Test::More; use 5.004; diff --git a/lib/YAML.pm b/lib/YAML.pm index 7087b78..73d5391 100644 --- a/lib/YAML.pm +++ b/lib/YAML.pm @@ -4,40 +4,13 @@ use YAML::Base; use base 'YAML::Base'; use YAML::Node; # XXX This is a temp fix for Module::Build use 5.006001; -our $VERSION = '0.58'; +our $VERSION = '0.60'; our @EXPORT = qw'Dump Load'; our @EXPORT_OK = qw'freeze thaw DumpFile LoadFile Bless Blessed'; # XXX This VALUE nonsense needs to go. use constant VALUE => "\x07YAML\x07VALUE\x07"; -# Global Options are an idea taken from Data::Dumper. Really they are just -# sugar on top of real OO properties. They make the simple Dump/Load API -# easy to configure. -# -# These options are no longer set by YAML.pm into globals. The action -# modules will check the globals, set by the user. - -# New global options -# our $SpecVersion = '1.0'; -# our $LoaderClass = ''; -# our $DumperClass = ''; - -# Legacy global options -# our $Indent = 2; -# our $UseHeader = 1; -# our $UseVersion = 0; -# our $SortKeys = 1; -# our $AnchorPrefix = ''; -# our $UseCode = 0; -# our $DumpCode = ''; -# our $LoadCode = ''; -# our $UseBlock = 0; -# our $UseFold = 0; -# our $CompressSeries = 1; -# our $UseAliases = 1; -# our $Stringify = 0; - # YAML Object Properties field dumper_class => 'YAML::Dumper'; field loader_class => 'YAML::Loader'; @@ -69,23 +42,35 @@ sub Load { } sub DumpFile { + my $OUT; my $filename = shift; - local $/ = "\n"; # reset special to "sane" - my $mode = '>'; - if ($filename =~ /^\s*(>{1,2})\s*(.*)$/) { - ($mode, $filename) = ($1, $2); + if (ref $filename) { + $OUT = $filename; } - open my $OUT, $mode, $filename - or YAML::Base->die('YAML_DUMP_ERR_FILE_OUTPUT', $filename, $!); + else { + my $mode = '>'; + if ($filename =~ /^\s*(>{1,2})\s*(.*)$/) { + ($mode, $filename) = ($1, $2); + } + open $OUT, $mode, $filename + or YAML::Base->die('YAML_DUMP_ERR_FILE_OUTPUT', $filename, $!); + } + local $/ = "\n"; # reset special to "sane" print $OUT Dump(@_); } sub LoadFile { + my $IN; my $filename = shift; - open my $IN, $filename - or YAML::Base->die('YAML_LOAD_ERR_FILE_INPUT', $filename, $!); + if (ref $filename) { + $IN = $filename; + } + else { + open $IN, $filename + or YAML::Base->die('YAML_LOAD_ERR_FILE_INPUT', $filename, $!); + } return Load(do { local $/; <$IN> }); -} +} sub init_action_object { my $self = shift; diff --git a/lib/YAML/Base.pm b/lib/YAML/Base.pm index 9d0b226..f97f286 100644 --- a/lib/YAML/Base.pm +++ b/lib/YAML/Base.pm @@ -129,9 +129,9 @@ $_scalar_info = sub { }; $_new_error = sub { + require Carp; my $self = shift; require YAML::Error; - require Carp; my $code = shift || 'unknown error'; my $error = YAML::Error->new(code => $code); @@ -167,6 +167,8 @@ $default_as_code = sub { return $code; }; +1; + __END__ =head1 NAME diff --git a/lib/YAML/Dumper.pm b/lib/YAML/Dumper.pm index 82a181b..5521f8c 100644 --- a/lib/YAML/Dumper.pm +++ b/lib/YAML/Dumper.pm @@ -14,7 +14,6 @@ use constant VALUE => "\x07YAML\x07VALUE\x07"; # Common YAML character sets my $ESCAPE_CHAR = '[\\x00-\\x08\\x0b-\\x0d\\x0e-\\x1f]'; -my $FOLD_CHAR = '>'; my $LIT_CHAR = '|'; #============================================================================== @@ -437,18 +436,12 @@ sub _emit_str { $self->_emit_block($LIT_CHAR, $_[0]), $self->_emit($eb), last if $self->use_block; - $self->_emit($sb), - $self->_emit_block($FOLD_CHAR, $_[0]), - $self->_emit($eb), last + Carp::cluck "[YAML] \$UseFold is no longer supported" if $self->use_fold; $self->_emit($sf), $self->_emit_double($_[0]), $self->_emit($ef), last if length $_[0] <= 30; - $self->_emit($sb), - $self->_emit_block($FOLD_CHAR, $_[0]), - $self->_emit($eb), last - if $_[0] =~ /^\S[^\n]{76}/m; $self->_emit($sf), $self->_emit_double($_[0]), $self->_emit($ef), last @@ -490,7 +483,6 @@ sub is_valid_plain { return 1; } -# A nested scalar is either block or folded sub _emit_block { my $self = shift; my ($indicator, $value) = @_; @@ -500,10 +492,6 @@ sub _emit_block { $value = '~' if not defined $value; $self->{stream} .= $chomp; $self->{stream} .= $self->indent_width if $value =~ /^\s/; - if ($indicator eq $FOLD_CHAR) { - $value = $self->fold($value); - chop $value unless $chomp eq '+'; - } $self->{stream} .= $self->indent($value); } @@ -544,28 +532,6 @@ sub indent { return $text; } -# Fold a paragraph to fit within a certain columnar restraint. -sub fold { - my $self = shift; - my ($text) = @_; - my $folded = ''; - $text =~ s/^(\S.*)\n(?=\S)/$1\n\n/gm; - while (length $text > 0) { - if ($text =~ s/^([^\n]{0,76})(\n|\Z)//) { - $folded .= $1; - } - elsif ($text =~ s/^(.{0,76})\s//) { - $folded .= $1; - } - else { - $self->die("bad news") unless $text =~ s/(.*?)(\s|\Z)//; - $folded .= $1; - } - $folded .= "\n"; - } - return $folded; -} - # Escapes for unprintable characters my @escapes = qw(\z \x01 \x02 \x03 \x04 \x05 \x06 \a \x08 \t \n \v \f \r \x0e \x0f diff --git a/lib/YAML/Dumper/Base.pm b/lib/YAML/Dumper/Base.pm index 6cc4c5d..8e4de0c 100644 --- a/lib/YAML/Dumper/Base.pm +++ b/lib/YAML/Dumper/Base.pm @@ -31,6 +31,9 @@ field offset => []; field headless => 0; field blessed_map => {}; +# Global Options are an idea taken from Data::Dumper. Really they are just +# sugar on top of real OO properties. They make the simple Dump/Load API +# easy to configure. sub set_global_options { my $self = shift; $self->spec_version($YAML::SpecVersion) diff --git a/lib/YAML/Loader.pm b/lib/YAML/Loader.pm index 1ff9d42..969867d 100644 --- a/lib/YAML/Loader.pm +++ b/lib/YAML/Loader.pm @@ -250,7 +250,17 @@ sub _parse_explicit { my $self = shift; my ($node, $explicit) = @_; my ($type, $class); - if ($explicit =~ /^perl\/(undef|glob|regexp|code|ref)\:(\w(\w|\:\:)*)?$/) { + if ($explicit =~ /^\!perl\/(hash|array|scalar)\:(\w(\w|\:\:)*)?$/) { + ($type, $class) = (($1 || ''), ($2 || '')); + if (ref $node) { + return CORE::bless $node, $class; + } + else { + return CORE::bless \$node, $class; + } + } + if ($explicit =~ + /^\!?perl\/(undef|glob|regexp|code|ref)\:(\w(\w|\:\:)*)?$/) { ($type, $class) = (($1 || ''), ($2 || '')); my $type_class = "YAML::Type::$type"; no strict 'refs'; @@ -261,6 +271,7 @@ sub _parse_explicit { $self->die('YAML_LOAD_ERR_NO_CONVERT', 'XXX', $explicit); } } + # This !perl/@Foo and !perl/$Foo are deprecated but still parsed elsif ($YAML::TagClass->{$explicit} || $explicit =~ m{^perl/(\@|\$)?([a-zA-Z](\w|::)+)$} ) { diff --git a/lib/YAML/Types.pm b/lib/YAML/Types.pm index d14b667..4d737ba 100644 --- a/lib/YAML/Types.pm +++ b/lib/YAML/Types.pm @@ -7,19 +7,25 @@ use YAML::Node; # but at least they work for now. #------------------------------------------------------------------------------- package YAML::Type::blessed; -my %sigil = (HASH => '', ARRAY => '@', SCALAR => '$'); +use YAML::Base; # XXX sub yaml_dump { my $self = shift; my ($value) = @_; my ($class, $type) = YAML::Base->node_info($value); no strict 'refs'; + my $kind = lc($type) . ':'; my $tag = ${$class . '::ClassTag'} || - "perl/$sigil{$type}$class"; - if ($type eq 'SCALAR') { + "!perl/$kind$class"; + if ($type eq 'REF') { + YAML::Node->new( + {(&YAML::VALUE, ${$_[0]})}, $tag + ); + } + elsif ($type eq 'SCALAR') { $_[1] = $$value; - YAML::Node->new($_[1], $tag) + YAML::Node->new($_[1], $tag); } else { - YAML::Node->new($value, $tag) + YAML::Node->new($value, $tag); } } @@ -37,7 +43,7 @@ sub yaml_load { package YAML::Type::glob; sub yaml_dump { my $self = shift; - my $ynode = YAML::Node->new({}, 'perl/glob:'); + my $ynode = YAML::Node->new({}, '!perl/glob:'); for my $type (qw(PACKAGE NAME SCALAR ARRAY HASH CODE IO)) { my $value = *{$_[0]}{$type}; $value = $$value if $type eq 'SCALAR'; @@ -111,7 +117,7 @@ sub yaml_dump { my ($dumpflag, $value) = @_; my ($class, $type) = YAML::Base->node_info($value); $class ||= ''; - my $tag = "perl/code:$class"; + my $tag = "!perl/code:$class"; if (not $dumpflag) { $code = $default; } @@ -159,7 +165,7 @@ sub yaml_load { package YAML::Type::ref; sub yaml_dump { my $self = shift; - YAML::Node->new({(&YAML::VALUE, ${$_[0]})}, 'perl/ref:') + YAML::Node->new({(&YAML::VALUE, ${$_[0]})}, '!perl/ref:') } sub yaml_load { @@ -184,7 +190,7 @@ sub yaml_dump { else { $dumper->die('YAML_DUMP_ERR_BAD_REGEXP', $node); } - my $tag = 'perl/regexp:'; + my $tag = '!perl/regexp:'; $tag .= $class if $class; my $ynode = YAML::Node->new({}, $tag); $ynode->{REGEXP} = $regexp; diff --git a/t/bugs-emailed.t b/t/bugs-emailed.t index 533008a..b9afa14 100644 --- a/t/bugs-emailed.t +++ b/t/bugs-emailed.t @@ -49,7 +49,7 @@ key1: '|value' +++ subject: Argument "E5" isn't numeric in multiplication (*) +++ function: load_passes +++ yaml ---- #YAML:1.0 !perl/Blam::Game +--- #YAML:1.0 !!perl/Blam::Game board: E5: R1 history: @@ -154,7 +154,7 @@ fontsize_banner: '16px' # title === Date: Mon, 07 Nov 2005 15:49:07 +++ perl: \ '|something' +++ yaml ---- !perl/ref: +--- !!perl/ref: =: '|something' diff --git a/t/bugs-rt.t b/t/bugs-rt.t index 74d09a1..d253f95 100644 --- a/t/bugs-rt.t +++ b/t/bugs-rt.t @@ -9,7 +9,7 @@ __DATA__ +++ skip_unless_modules: FileHandle +++ perl: FileHandle->new( ">/tmp/$$" ); +++ yaml ---- !perl/FileHandle +--- !!perl/io:FileHandle - xxx === Ticket #105-B YAML doesn't serialize odd objects very well @@ -17,7 +17,7 @@ __DATA__ +++ no_round_trip +++ perl: URI->new( "http://localhost/" ) +++ yaml ---- !perl/$URI::http http://localhost/ +--- !!perl/scalar:URI::http http://localhost/ === Ticket #105-C YAML doesn't serialize odd objects very well +++ skip_unless_modules: URI @@ -33,7 +33,7 @@ names: +++ skip_unless_modules: CGI +++ perl: CGI->new() +++ yaml ---- !perl/CGI +--- !!perl/hash:CGI .charset: ISO-8859-1 .fieldnames: {} .parameters: [] @@ -46,7 +46,7 @@ sub new { return bless ['one','two','three'], $_[0]; } package main; MyObj::Class->new(); +++ yaml ---- !perl/@MyObj::Class +--- !!perl/array:MyObj::Class - one - two - three @@ -132,7 +132,7 @@ text: "Bla:\n\n- Foo\n- Bar\n" === Ticket #6139 0.35 can't deserialize blessed scalars +++ perl: my $x = "abc"; bless \ $x, "ABCD"; +++ yaml ---- !perl/$ABCD abc +--- !!perl/scalar:ABCD abc @@ -146,14 +146,14 @@ Can't get this to work yet. -=== Ticket #8795 !perl/code blocks are evaluated in package main +=== Ticket #8795 !!perl/code: blocks are evaluated in package main +++ skip_this_for_now This test passes but not sure if this totally represents what was being reported. Check back later. +++ perl: $YAML::UseCode = 1; package Food; sub { 42; } +++ no_round_trip +++ yaml ---- perl/code: | +--- !!perl/code: | sub { package Food; use warnings; @@ -206,7 +206,7 @@ serializing yourself, but this doesn't work. $ perl -MYAML -we ' $YAML::DumpCode = sub { return "dumped code $_[0]", "test" }; print Dump(sub { "foo" });' - --- !perl/code: "{\n 'foo';\n}\n" + --- !!perl/code: "{\n 'foo';\n}\n" $ _ YAML::Transfer::code::yaml_dump() doesn't look to have any code to diff --git a/t/dump-basics.t b/t/dump-basics.t index 353e9c5..59cff8a 100644 --- a/t/dump-basics.t +++ b/t/dump-basics.t @@ -4,7 +4,6 @@ filters { perl => [qw'eval yaml_dump'], }; -no_diff; run_is; __DATA__ diff --git a/t/dump-code.t b/t/dump-code.t index 3b439e7..dba6f3e 100644 --- a/t/dump-code.t +++ b/t/dump-code.t @@ -12,7 +12,7 @@ local $YAML::DumpCode = 1; package main; return sub { 'Something at least 30 chars' }; +++ yaml ---- !perl/code: | +--- !!perl/code: | { use warnings; use strict 'refs'; @@ -28,7 +28,7 @@ my $joe_random_global = sub { 'Something at least 30 chars' }; [$joe_random_global, $joe_random_global, $joe_random_global]; +++ yaml --- -- &1 !perl/code: | +- &1 !!perl/code: | { use warnings; use strict 'refs'; @@ -43,7 +43,7 @@ local $YAML::DumpCode = 0; +++ perl sub { 'Something at least 30 chars' } +++ yaml ---- !perl/code: '{ "DUMMY" }' +--- !!perl/code: '{ "DUMMY" }' === blessed code ref +++ config @@ -53,7 +53,7 @@ package main; bless sub { 'Something at least 30 chars' }, "Foo::Bar"; +++ no_round_trip +++ yaml ---- !perl/code:Foo::Bar | +--- !!perl/code:Foo::Bar | { use warnings; use strict 'refs'; diff --git a/t/dump-nested.t b/t/dump-nested.t index 1c52469..15cf571 100644 --- a/t/dump-nested.t +++ b/t/dump-nested.t @@ -24,17 +24,11 @@ The parser (and event generator) The input of the parser are characters. These characters are directly fed into the functions that implement the different productions. The output of the parser are events, a well defined and small set of events.}] +++ yaml --- -- >- - It reads one character at a time, with the ability to push back any number - of characters up to a maximum, and with nested mark() / reset() / unmark() - functions. The input of the stream reader is any java.io.Reader. The output - are characters. - +- |- + It reads one character at a time, with the ability to push back any number of characters up to a maximum, and with nested mark() / reset() / unmark() functions. The input of the stream reader is any java.io.Reader. The output are characters. The parser (and event generator) - The input of the parser are characters. These characters are directly fed - into the functions that implement the different productions. The output of - the parser are events, a well defined and small set of events. + The input of the parser are characters. These characters are directly fed into the functions that implement the different productions. The output of the parser are events, a well defined and small set of events. === +++ perl < -xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx -xxx xxx xxx xxx xxx xxx xxx xxx xxx - -xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx -xxx xxx xxx xxx xxx xxx xxx xxx xxx +--- | +xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx +xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx 1) xxx xxx xxx xxx 2) xxx xxx xxx xxx -xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx -xxx xxx xxx xxx xxx xxx xxx xxx xxx +xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx === -+++ config -local $YAML::UseFold = 1 +++ perl < +--- | xxx xxx xxx xxx - xxx xxx xxx xxx 1) xxx xxx xxx xxx @@ -79,8 +66,6 @@ xxx xxx xxx xxx xxx xxx xxx xxx === -+++ config -local $YAML::UseFold = 1 +++ perl < +--- | xxx xxx xxx xxx 1) xxx xxx xxx xxx @@ -100,25 +85,17 @@ xxx xxx xxx xxx +++ perl "xxx xxx xxx xxx xxx xxx xxx xxx xxx xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx xxx xxx xxx xxx xxx xxx xxx xxx\n" +++ yaml ---- > -xxx xxx xxx xxx xxx xxx xxx xxx xxx -xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx xxx xxx xxx xxx xxx xxx -xxx xxx +--- "xxx xxx xxx xxx xxx xxx xxx xxx xxx xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx xxx xxx xxx xxx xxx xxx xxx xxx\n" === +++ perl "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx xxx xxx xxx xxx xxx xxx xxx xxx\n" +++ yaml ---- > -xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx -xxx xxx xxx xxx xxx xxx xxx xxx +--- "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx xxx xxx xxx xxx xxx xxx xxx xxx\n" === -+++ config -local $YAML::UseFold = 1 +++ perl "xxx xxx xxx xxx\n\n" -+++ yaml -trim ---- >+ -xxx xxx xxx xxx ++++ yaml +--- "xxx xxx xxx xxx\n\n" === +++ config diff --git a/t/dump-perl-types.t b/t/dump-perl-types.t index 55c0deb..1e766db 100644 --- a/t/dump-perl-types.t +++ b/t/dump-perl-types.t @@ -33,7 +33,7 @@ $YAML::DumpCode = 1; package main; sub { print "Hello, world\n"; } +++ yaml ---- !perl/code: | +--- !!perl/code: | { use warnings; use strict 'refs'; @@ -43,13 +43,13 @@ sub { print "Hello, world\n"; } === Scalar Reference +++ perl: \ 'Goodbye' +++ yaml ---- !perl/ref: +--- !!perl/ref: =: Goodbye === Regular Expression +++ perl: qr{perfect match}; +++ yaml ---- !perl/regexp: +--- !!perl/regexp: REGEXP: perfect match === Scalar Glob @@ -57,7 +57,7 @@ REGEXP: perfect match $::var = 'Hola'; *::var; +++ yaml ---- !perl/glob: +--- !!perl/glob: PACKAGE: main NAME: var SCALAR: Hola @@ -67,7 +67,7 @@ SCALAR: Hola @::var2 = (qw(xxx yyy zzz)); *::var2; +++ yaml ---- !perl/glob: +--- !!perl/glob: PACKAGE: main NAME: var2 ARRAY: @@ -82,10 +82,10 @@ package main; sub main::var3 { print "Hello, world\n"; } *var3; +++ yaml ---- !perl/glob: +--- !!perl/glob: PACKAGE: main NAME: var3 -CODE: !perl/code: | +CODE: !!perl/code: | { use warnings; use strict 'refs'; @@ -95,24 +95,24 @@ CODE: !perl/code: | === Blessed Empty Hash +++ perl: bless {}, 'A::B::C'; +++ yaml ---- !perl/A::B::C {} +--- !!perl/hash:A::B::C {} === Blessed Populated Hash +++ perl: bless {qw(foo bar bar foo)}, 'A::B::C'; +++ yaml ---- !perl/A::B::C +--- !!perl/hash:A::B::C bar: foo foo: bar === Blessed Empty Array +++ perl: bless [], 'A::B::C'; +++ yaml ---- !perl/@A::B::C [] +--- !!perl/array:A::B::C [] === Blessed Populated Array +++ perl: bless [qw(foo bar bar foo)], 'A::B::C'; +++ yaml ---- !perl/@A::B::C +--- !!perl/array:A::B::C - foo - bar - bar @@ -121,25 +121,25 @@ foo: bar === Blessed Empty String +++ perl: my $e = ''; bless \ $e, 'A::B::C'; +++ yaml ---- !perl/$A::B::C '' +--- !!perl/scalar:A::B::C '' === Blessed Populated String +++ perl: my $fbbf = 'foo bar bar foo'; bless \ $fbbf, 'A::B::C'; +++ yaml ---- !perl/$A::B::C foo bar bar foo +--- !!perl/scalar:A::B::C foo bar bar foo === Blessed Regular Expression +++ SKIP +++ perl: bless qr{perfect match}, 'A::B::C'; +++ yaml ---- !perl/regexp: +--- !!perl/regexp: REGEXP: perfect match === Blessed Glob +++ SKIP +++ perl: $::x = 42; bless \ *::x, 'A::B::C'; +++ yaml ---- !perl/glob:A::B::C +--- !!perl/glob:A::B::C PACKAGE: main NAME: x SCALAR: 42 diff --git a/t/dump-stringify.t b/t/dump-stringify.t index 3ddb057..691d3f9 100644 --- a/t/dump-stringify.t +++ b/t/dump-stringify.t @@ -18,7 +18,7 @@ my $stringy_dump = <<''; --- Hello mate! my $object_dump = <<''; ---- !perl/Foo +--- !!perl/hash:Foo Hello: mate! my $yaml; diff --git a/t/dump-tests.t b/t/dump-tests.t index 29cbfb4..90d77bc 100644 --- a/t/dump-tests.t +++ b/t/dump-tests.t @@ -92,13 +92,13 @@ vegetables: +++ perl bless {}, 'Foo::Bar' +++ yaml ---- !perl/Foo::Bar {} +--- !!perl/hash:Foo::Bar {} === +++ perl bless {qw(foo 42 bar 43)}, 'Foo::Bar' +++ yaml ---- !perl/Foo::Bar +--- !!perl/hash:Foo::Bar bar: 43 foo: 42 @@ -106,13 +106,13 @@ foo: 42 +++ perl bless [], 'Foo::Bar' +++ yaml ---- !perl/@Foo::Bar [] +--- !!perl/array:Foo::Bar [] === +++ perl bless [map "$_",42..45], 'Foo::Bar' +++ yaml ---- !perl/@Foo::Bar +--- !!perl/array:Foo::Bar - 42 - 43 - 44 @@ -139,7 +139,7 @@ use YAML::Node; my $a = ''; bless \$a, 'Foo::Bark'; +++ yaml ---- !perl/$Foo::Bark '' +--- !!perl/scalar:Foo::Bark '' === +++ perl @@ -173,7 +173,7 @@ $joe_random_global = 42; @joe_random_global = (43, 44); *joe_random_global +++ yaml ---- !perl/glob: +--- !!perl/glob: PACKAGE: main NAME: joe_random_global SCALAR: 42 @@ -187,8 +187,8 @@ no strict; package main; \*joe_random_global +++ yaml ---- !perl/ref: -=: !perl/glob: +--- !!perl/ref: +=: !!perl/glob: PACKAGE: main NAME: joe_random_global SCALAR: 42 @@ -272,13 +272,13 @@ my $joe_random_global = \\\\\\\'42'; ] +++ yaml --- -- &1 !perl/ref: - =: !perl/ref: - =: !perl/ref: - =: &2 !perl/ref: - =: !perl/ref: - =: !perl/ref: - =: &3 !perl/ref: +- &1 !!perl/ref: + =: !!perl/ref: + =: !!perl/ref: + =: &2 !!perl/ref: + =: !!perl/ref: + =: !!perl/ref: + =: &3 !!perl/ref: =: 42 - *2 - *1 @@ -311,7 +311,7 @@ sake) this test doesn't roundtrip even though the values are equivalent. [qr{bozo$}i] +++ yaml --- -- !perl/regexp: +- !!perl/regexp: REGEXP: bozo$ MODIFIERS: i @@ -330,7 +330,7 @@ push @$joe_random_global, $joe_random_global; bless $joe_random_global, 'XYZ'; $joe_random_global +++ yaml ---- &1 !perl/@XYZ +--- &1 !!perl/array:XYZ - *1 === @@ -361,26 +361,26 @@ $a = \\\\\\\\"foo"; $b = $$$$$a; ([$a, $b], [$b, $a]) +++ yaml --- -- !perl/ref: - =: !perl/ref: - =: !perl/ref: - =: !perl/ref: - =: &1 !perl/ref: - =: !perl/ref: - =: !perl/ref: - =: !perl/ref: +- !!perl/ref: + =: !!perl/ref: + =: !!perl/ref: + =: !!perl/ref: + =: &1 !!perl/ref: + =: !!perl/ref: + =: !!perl/ref: + =: !!perl/ref: =: foo - *1 --- -- &1 !perl/ref: - =: !perl/ref: - =: !perl/ref: - =: !perl/ref: +- &1 !!perl/ref: + =: !!perl/ref: + =: !!perl/ref: + =: !!perl/ref: =: foo -- !perl/ref: - =: !perl/ref: - =: !perl/ref: - =: !perl/ref: +- !!perl/ref: + =: !!perl/ref: + =: !!perl/ref: + =: !!perl/ref: =: *1 === @@ -402,7 +402,7 @@ a: 1 $a = 'bitter buffalo'; bless \$a, 'Heart'; +++ yaml ---- !perl/$Heart bitter buffalo +--- !!perl/scalar:Heart bitter buffalo === +++ perl diff --git a/t/load-fails.t b/t/load-fails.t index 70ecfed..62203be 100644 --- a/t/load-fails.t +++ b/t/load-fails.t @@ -10,6 +10,15 @@ run_like yaml => 'msg'; __DATA__ +=== ++++ SKIP +This test hangs YAML.pm ++++ msg +YAML Error: Inconsistent indentation level ++++ yaml +a: * + + === +++ msg YAML Error: Inconsistent indentation level diff --git a/t/load-passes.t b/t/load-passes.t index 28a8b41..4d4e0fd 100644 --- a/t/load-passes.t +++ b/t/load-passes.t @@ -3,6 +3,20 @@ use t::TestYAML tests => 8; run_load_passes(); __DATA__ + +=== Bug reported by Rich Morin ++++ SKIP ++++ yaml +foo: + - > + This is a test. + +=== Bug reported by audreyt ++++ SKIP ++++ yaml +--- "\n\ +\r" + === +++ yaml --- diff --git a/t/meta-yml.t b/t/meta-yml.t index 0bd6de6..7611670 100644 --- a/t/meta-yml.t +++ b/t/meta-yml.t @@ -19,17 +19,14 @@ __DATA__ 't' ] }, - 'generated_by' => 'Module::Install version 0.54', + 'generated_by' => 'Module::Install version 0.61', 'distribution_type' => 'module', - 'version' => '0.58', + 'version' => '0.60', 'name' => 'YAML', 'author' => 'Ingy döt Net ', 'license' => 'perl', 'requires' => { 'perl' => '5.6.1' }, - 'build_requires' => { - 'Test::Base' => '0.49' - }, 'abstract' => 'YAML Ain\'t Markup Language (tm)' }; diff --git a/t/pugs-objects.t b/t/pugs-objects.t index d22d04e..181fbfc 100644 --- a/t/pugs-objects.t +++ b/t/pugs-objects.t @@ -2,8 +2,8 @@ use t::TestYAML tests => 2; { no warnings 'once'; - $Foo::Bar::ClassTag = 'pugs/object:Foo::Bar'; - $YAML::TagClass->{'pugs/object:Foo::Bar'} = 'Foo::Bar'; + $Foo::Bar::ClassTag = '!pugs/object:Foo::Bar'; + $YAML::TagClass->{'!pugs/object:Foo::Bar'} = 'Foo::Bar'; } no_diff; @@ -13,6 +13,6 @@ __DATA__ === Turn Perl object to Pugs object +++ perl: bless { 'a'..'d' }, 'Foo::Bar'; +++ yaml ---- !pugs/object:Foo::Bar +--- !!pugs/object:Foo::Bar a: b c: d diff --git a/t/references.t b/t/references.t new file mode 100644 index 0000000..8973b03 --- /dev/null +++ b/t/references.t @@ -0,0 +1,47 @@ +use Test::YAML tests => 10; + +no_diff; + +run_yaml_tests; + +__DATA__ +=== A scalar ref ++++ perl: \ 42 ++++ yaml +--- !!perl/ref: +=: 42 + +=== A ref to a scalar ref ++++ perl: \\ "yellow" ++++ yaml +--- !!perl/ref: +=: !!perl/ref: + =: yellow + +=== A ref to a ref to a scalar ref ++++ perl: \\\ 123 ++++ yaml +--- !!perl/ref: +=: !!perl/ref: + =: !!perl/ref: + =: 123 + +=== A blessed container reference ++++ perl +my $array_ref = [ 1, 3, 5]; +my $container_ref = \ $array_ref; +bless $container_ref, 'Wax'; ++++ yaml +--- !!perl/ref:Wax +=: + - 1 + - 3 + - 5 + +=== A blessed scalar reference ++++ perl +my $scalar = "omg"; +my $scalar_ref = \ $scalar; +bless $scalar_ref, 'Wax'; ++++ yaml +--- !!perl/scalar:Wax omg diff --git a/t/svk.t b/t/svk.t index 57f06a1..f8091a1 100644 --- a/t/svk.t +++ b/t/svk.t @@ -14,5 +14,5 @@ like $yaml_from_file, qr{^---\ncheckout: !perl/Data::Hierarchy\n}, my $yaml_from_node = Dump($node); -is $yaml_from_node, $yaml_from_file, +is Dump(Load($yaml_from_node)), Dump(Load($yaml_from_file)), "svk data roundtrips!";;