diff -u -r -N eumm-r3935/MANIFEST eumm/MANIFEST --- eumm-r3935/MANIFEST 2006-09-11 18:38:16.000000000 -0300 +++ eumm/MANIFEST 2007-03-01 22:24:38.000000000 -0300 @@ -70,6 +70,7 @@ t/Liblist.t t/make.t t/Manifest.t +t/metafile_file.t t/Mkbootstrap.t t/MM_Any.t t/MM_BeOS.t diff -u -r -N eumm-r3935/Makefile.PL eumm/Makefile.PL --- eumm-r3935/Makefile.PL 2007-02-22 04:05:38.000000000 -0300 +++ eumm/Makefile.PL 2007-03-02 22:39:34.000000000 -0300 @@ -67,13 +67,9 @@ EXE_FILES => [qw(bin/instmodsh)], - # EXTRA_META is an experimental feature and its not going to work - # like this next release. - EXTRA_META => <<'META', -no_index: - dir: - - inc -META + EXTRA_META => { + no_index => { dir => [ qw(inc) ] }, + }, INSTALLDIRS => 'perl', diff -u -r -N eumm-r3935/lib/ExtUtils/MM_Any.pm eumm/lib/ExtUtils/MM_Any.pm --- eumm-r3935/lib/ExtUtils/MM_Any.pm 2007-02-22 04:07:36.000000000 -0300 +++ eumm/lib/ExtUtils/MM_Any.pm 2007-03-01 22:23:02.000000000 -0300 @@ -705,6 +705,10 @@ the distdir. The format follows Module::Build's as closely as possible. +The YAML is generated by C<< $mm->metafile_file($mm->metafile_data) >>. +Both methods, C and C, can be customized +for special effects. + =cut sub metafile_target { @@ -715,47 +719,8 @@ $(NOECHO) $(NOOP) MAKE_FRAG - my $prereq_pm = ''; - foreach my $mod ( sort { lc $a cmp lc $b } keys %{$self->{PREREQ_PM}} ) { - my $ver = $self->{PREREQ_PM}{$mod}; - $prereq_pm .= sprintf "\n %-30s %s", "$mod:", $ver; - } - - # Use a list to preserve order. - my @meta_to_mm = ( - name => $self->{DISTNAME}, - version => $self->{VERSION}, - abstract => $self->{ABSTRACT}, - license => $self->{LICENSE}, - generated_by => - "ExtUtils::MakeMaker version $ExtUtils::MakeMaker::VERSION", - distribution_type => $self->{PM} ? 'module' : 'script', - ); - - my $meta = "--- #YAML:1.0\n"; - - while( @meta_to_mm ) { - my($key, $val) = splice @meta_to_mm, 0, 2; - - $val = '~' unless defined $val; - - $meta .= sprintf "%-20s %s\n", "$key:", $val; - }; - - $meta .= <<"YAML"; -requires: $prereq_pm -meta-spec: - url: http://module-build.sourceforge.net/META-spec-v1.2.html - version: 1.2 -YAML - - $meta .= <<"YAML" if defined $self->{AUTHOR}; -author: - - $self->{AUTHOR} -YAML - - $meta .= $self->{EXTRA_META} if $self->{EXTRA_META}; - + my @metadata = $self->metafile_data; + my $meta = $self->metafile_file(@metadata); my @write_meta = $self->echo($meta, 'META_new.yml'); return sprintf <<'MAKE_FRAG', join("\n\t", @write_meta); @@ -1636,8 +1601,214 @@ } +=begin private + +=head3 _sort_pairs + + my @pairs = _sort_pairs($sort_sub, \%hash); +Sorts the pairs of a hash based on keys ordered according +to C<$sort_sub>. + +=end private + +=cut + +sub _sort_pairs { + my $k_sort = shift; # a CODE + my $hash = shift; # a HASH + local *key_sort = $k_sort; + # XXX try without the GLOB, i.e. $k_sort directly + return map { ($_, $hash->{$_}) } sort key_sort keys(%$hash); +} + +=head3 metafile_data + + my %metadata = $mm->metafile_data; + +Returns the data which MakeMaker turns into the META.yml file. +The pairs at C are added. If they clash with +MakeMaker-generated fields, a warning is issued. + +This may be overriden for customization purposes. + +=cut + +sub metafile_data { + my $self = shift; + + my @META_KEYS = qw( + name version abstract + license generated_by author + distribution_type requires meta-spec + ); + my %meta = ( + name => $self->{DISTNAME}, + version => $self->{VERSION}, + abstract => $self->{ABSTRACT}, + license => $self->{LICENSE} || 'unknown', + generated_by => + "ExtUtils::MakeMaker version $ExtUtils::MakeMaker::VERSION", + distribution_type => $self->{PM} ? 'module' : 'script', + requires => $self->{PREREQ_PM}, + 'meta-spec' => { + url => 'http://module-build.sourceforge.net/META-spec-v1.2.html', + version => 1.2 + }, + #version_from => $self->{VERSION_FROM}, + #installdirs => $self->{INSTALLDIRS}, + ); + $meta{author} = $self->{AUTHOR} if defined $self->{AUTHOR}; + + # now merge the pairs from %meta with EXTRA_META - + # this is harder than + # @meta{keys %$extra} = values %$extra; + # so to work with pairs and to preserve order + my @extra; + if ($self->{EXTRA_META}) { + my $extra = $self->{EXTRA_META}; + + my @pairs = ref $extra eq 'HASH' ? _sort_pairs(sub { lc $a cmp lc $ b }, $extra) + : @{$extra}; + while (@pairs) { + my ($k, $v) = splice @pairs, 0, 2; + if (exists $meta{$k}) { + carp "EXTRA_META overrides MakeMaker-generated field '$k'"; + $meta{$k} = $v; + } else { + push @extra, ($k, $v) + } + } + } + # sort %meta pairs according to prespecified order of keys + my @meta = map({ $_, $meta{$_} } @META_KEYS); + return @meta, @extra; + +} + +=begin private + +=head3 _dump_hash + + $yaml = _dump_hash(\%options, %hash); + +Implements a fake YAML dumper for a hash given +as a list of pairs. No quoting/escaping is done. Keys +are supposed to be strings. Values are undef, strings, +hash refs or array refs of strings. + +Supported options are: + + delta => STR - indentation delta + use_header => BOOL - whether to include a YAML header + indent => STR - a string of spaces + default: '' + + key_length => INT - an estimate of the max key length, + used to align keys and values of the same hash + default: no alignment + key_sort => CODE - a sort sub + It may be undef, which means no sorting by keys + default: sub { lc $a cmp lc $b } + + customs => HASH - special options for certain keys + (whose values are hashes themselves) + may contain: key_length, key_sort, customs + +=end private + +=cut + +sub _dump_hash { + croak "first argument should be a hash ref" unless ref $_[0] eq 'HASH'; + my $options = shift; + + # Use a list to preserve order. + my @pairs; + + my $k_sort + = exists $options->{key_sort} ? $options->{key_sort} + : sub { lc $a cmp lc $b }; + if ($k_sort) { + croak "'key_sort' should be a coderef" unless ref $k_sort eq 'CODE'; + my %hash = @_; + @pairs = _sort_pairs($k_sort, \%hash); + } else { # list of pairs, no sorting + @pairs = @_; + } + + my $yaml = $options->{use_header} ? "--- #YAML:1.0\n" : ''; + my $indent = $options->{indent} || ''; + my $k_length = $options->{key_length}; + my $customs = $options->{customs} || {}; + + # printf format for key + my $k_format = $k_length ? "%-${k_length}s" + : "%s"; + + while( @pairs ) { + my($key, $val) = splice @pairs, 0, 2; + $val = '~' unless defined $val; + if (ref $val eq 'HASH') { + my %k_options = ( # options for recursive call + delta => $options->{delta}, + use_header => 0, + indent => $indent . $options->{delta}, + ); + if (exists $customs->{$key}) { + my %k_custom = %{$customs->{$key}}; + foreach my $k qw(key_sort key_length customs) { + $k_options{$k} = $k_custom{$k} if exists $k_custom{$k}; + } + } + $yaml .= $indent . "$key:\n" + . _dump_hash(\%k_options, %$val); + } elsif (ref $val eq 'ARRAY') { + $yaml .= $indent . "$key:\n"; + for (@$val) { + croak "only nested arrays of non-refs are supported" if ref $_; + $yaml .= $indent . $options->{delta} . "- $_\n"; + } + } elsif (ref $val) { # not HASH or ARRAY + croak "only nested hashes and arrays are supported"; + } else { + $yaml .= $indent . sprintf "$k_format %s\n", "$key:", $val; + } + }; + + return $yaml; + +} + +=head3 metafile_file + + my %metayml = $mm->metafile_file(%data); + +Turns the metadata given as argument into YAML. +This method does not implement a real YAML dumper, +being limited to dump a hash with values which are +strings, undef's or nested hashes and arrays of +strings. No quoting/escaping is done. + +This may be overriden for customization purposes. + +=cut + +sub metafile_file { + my $self = shift; + my %dump_options = ( + use_header => 1, + delta => ' ' x 4, + key_length => 20, + key_sort => undef, + customs => { + requires => { key_length => 30, key_sort => sub { lc $a cmp lc $b }, } + } + ); + return _dump_hash(\%dump_options, @_); + +} =head2 File::Spec wrappers diff -u -r -N eumm-r3935/lib/ExtUtils/MakeMaker.pm eumm/lib/ExtUtils/MakeMaker.pm --- eumm-r3935/lib/ExtUtils/MakeMaker.pm 2007-02-22 04:08:06.000000000 -0300 +++ eumm/lib/ExtUtils/MakeMaker.pm 2007-03-01 21:09:48.000000000 -0300 @@ -1,4 +1,4 @@ -# $Id: MakeMaker.pm 3934 2007-02-22 07:08:04Z schwern $ +# $Id: MakeMaker.pm 3934M 2007-03-02 00:09:48Z (local) $ package ExtUtils::MakeMaker; BEGIN {require 5.005_03;} @@ -22,7 +22,7 @@ use strict; $VERSION = '6.32'; -($Revision) = q$Revision: 3934 $ =~ /Revision:\s+(\S+)/; +($Revision) = q$Revision: 3934M $ =~ /Revision:\s+(\S+)/; @ISA = qw(Exporter); @EXPORT = qw(&WriteMakefile &writeMakefile $Verbose &prompt); @@ -92,6 +92,7 @@ TYPEMAPS => 'array', XS => 'hash', _KEEP_AFTER_FLUSH => '', + EXTRA_META => ['hash','array'], clean => 'hash', depend => 'hash', @@ -1494,6 +1495,11 @@ 'Makefile.PL' was invoked with so the programs will be sure to run properly even if perl is not in /usr/bin/perl. +=item EXTRA_META + +Extra key/value pairs to be appended to the generated META.yml. +It may be a hash or array reference. + =item FIRST_MAKEFILE The name of the Makefile to be produced. This is used for the second @@ -2165,7 +2171,7 @@ $VERSION = '1.00'; *VERSION = \'1.01'; - $VERSION = (q$Revision: 3934 $) =~ /(\d+)/g; + $VERSION = (q$Revision: 3934M $) =~ /(\d+)/g; $FOO::VERSION = '1.10'; *FOO::VERSION = \'1.11'; our $VERSION = 1.2.3; # new for perl5.6.0 diff -u -r -N eumm-r3935/t/metafile_file.t eumm/t/metafile_file.t --- eumm-r3935/t/metafile_file.t 1969-12-31 21:00:00.000000000 -0300 +++ eumm/t/metafile_file.t 2007-03-01 22:04:10.000000000 -0300 @@ -0,0 +1,285 @@ +#!/usr/bin/perl -w + +# This is a test of the fake YAML dumper implemented by EUMM: +# ExtUtils::MM_Any::metafile_file + +BEGIN { + if( $ENV{PERL_CORE} ) { + chdir 't' if -d 't'; + @INC = ('../lib', 'lib'); + } + else { + unshift @INC, 't/lib'; + } +} + +use strict; +use Test::More tests => 12; + +require ExtUtils::MM_Any; + +my $mm = bless {}, 'ExtUtils::MM_Any'; + +{ +my @meta = ( a => 1, b => 2 ); +my $expected = <metafile_file(@meta), $expected, "dump for flat hashes works ok"); +} + +{ +my @meta = ( k1 => 'some key and value', k2 => undef, k3 => 1 ); +my $expected = <metafile_file(@meta), $expected, "dumping strings and undefs is ok"); +} + +{ +my @meta = ( a => 1, b => 2, h => { hh => 1 } ); +my $expected = <metafile_file(@meta), $expected, "dump for nested hashes works ok"); +} + +{ +my @meta = ( a => 1, b => 2, h => { h1 => 'x', h2 => 'z' } ); +my $expected = <metafile_file(@meta), $expected, "nested hashes sort ascii-betically"); +# to tell the truth, they sort case-insensitively +# that's hard to test for Perl with unstable sort's +} + +{ +my @meta = ( a => 1, b => 2, h => { hh => { hhh => 1 } } ); +my $expected = <metafile_file(@meta), $expected, "dump for hashes (with more nesting) works ok"); +} + +{ +my @meta = ( a => 1, k => [ qw(w y z) ] ); +my $expected = <metafile_file(@meta), $expected, "array of strings are handled ok"); +} + +{ +my @meta = ( + name => 'My-Module', + version => '0.1', + version_from => 'lib/My/Module.pm', + installdirs => 'site', + abstract => 'A does-it-all module', + license => 'perl', + generated_by => 'myself', + author => 'John Doe ', + distribution_type => 'module', + requires => { + 'My::Module::Helper' => 0, + 'Your::Module' => '1.5', + }, + 'meta-spec' => { + version => '1.1', + url => 'http://module-build.sourceforge.net/META-spec-new.html', + }, +); +my $expected = <<'YAML'; +--- #YAML:1.0 +name: My-Module +version: 0.1 +version_from: lib/My/Module.pm +installdirs: site +abstract: A does-it-all module +license: perl +generated_by: myself +author: John Doe +distribution_type: module +requires: + My::Module::Helper: 0 + Your::Module: 1.5 +meta-spec: + url: http://module-build.sourceforge.net/META-spec-new.html + version: 1.1 +YAML + +is($mm->metafile_file(@meta), $expected, "dump for something like META.yml works"); +} + +{ +my @meta = ( + name => 'My-Module', + version => '0.1', + version_from => 'lib/My/Module.pm', + installdirs => 'site', + abstract => 'A does-it-all module', + license => 'perl', + generated_by => 'myself', + author => 'John Doe ', + distribution_type => 'module', + requires => { + 'My::Module::Helper' => 0, + 'Your::Module' => '1.5', + }, + recommends => { + 'Test::More' => 0, + 'Test::Pod' => 1.18, + 'Test::Pod::Coverage' => 1 + }, + 'meta-spec' => { + version => '1.1', + url => 'http://module-build.sourceforge.net/META-spec-new.html', + }, +); +my $expected = <<'YAML'; +--- #YAML:1.0 +name: My-Module +version: 0.1 +version_from: lib/My/Module.pm +installdirs: site +abstract: A does-it-all module +license: perl +generated_by: myself +author: John Doe +distribution_type: module +requires: + My::Module::Helper: 0 + Your::Module: 1.5 +recommends: + Test::More: 0 + Test::Pod: 1.18 + Test::Pod::Coverage: 1 +meta-spec: + url: http://module-build.sourceforge.net/META-spec-new.html + version: 1.1 +YAML + +is($mm->metafile_file(@meta), $expected, "META.yml with extra 'recommends' works"); +} + +{ +my @meta = ( + name => 'My-Module', + version => '0.1', + version_from => 'lib/My/Module.pm', + installdirs => 'site', + abstract => 'A does-it-all module', + license => 'perl', + generated_by => 'myself', + author => 'John Doe ', + distribution_type => 'module', + requires => { + 'My::Module::Helper' => 0, + 'Your::Module' => '1.5', + }, + recommends => { + 'Test::More' => 0, + 'Test::Pod' => 1.18, + 'Test::Pod::Coverage' => 1 + }, + no_index => { + dir => [ qw(inc) ], + file => [ qw(TODO NOTES) ], + }, + 'meta-spec' => { + version => '1.1', + url => 'http://module-build.sourceforge.net/META-spec-new.html', + }, +); +my $expected = <<'YAML'; +--- #YAML:1.0 +name: My-Module +version: 0.1 +version_from: lib/My/Module.pm +installdirs: site +abstract: A does-it-all module +license: perl +generated_by: myself +author: John Doe +distribution_type: module +requires: + My::Module::Helper: 0 + Your::Module: 1.5 +recommends: + Test::More: 0 + Test::Pod: 1.18 + Test::Pod::Coverage: 1 +no_index: + dir: + - inc + file: + - TODO + - NOTES +meta-spec: + url: http://module-build.sourceforge.net/META-spec-new.html + version: 1.1 +YAML + +is($mm->metafile_file(@meta), $expected, "META.yml with extra 'no_index' works"); +} + +{ +my @meta = ( k => 'a : b', 'x : y' => 1 ); +my $expected = <metafile_file(@meta), $expected, "no quoting is done"); +} + +{ +my @meta = ( k => \*STDOUT ); +eval { $mm->metafile_file(@meta) }; + +like($@, qr/^only nested hashes and arrays are supported/, + "we don't like but hash/array refs"); +} + +{ +my @meta = ( k => [ [] ] ); +eval { $mm->metafile_file(@meta) }; + +like($@, qr/^only nested arrays of non-refs are supported/, + "we also don't like but array of strings"); +} + +# recursive data structures: don't even think about it - endless recursion