r40932 - in /branches/upstream/libparse-cpan-meta-perl/current: ./ lib/Parse/CPAN/ t/ t/data/
jawnsy-guest at users.alioth.debian.org
jawnsy-guest at users.alioth.debian.org
Tue Jul 28 20:47:46 UTC 2009
Author: jawnsy-guest
Date: Tue Jul 28 20:47:40 2009
New Revision: 40932
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=40932
Log:
[svn-upgrade] Integrating new upstream version, libparse-cpan-meta-perl (1.40)
Added:
branches/upstream/libparse-cpan-meta-perl/current/t/data/utf_16_le_bom.yml.packed
branches/upstream/libparse-cpan-meta-perl/current/uupacktool.pl
Removed:
branches/upstream/libparse-cpan-meta-perl/current/.dualLivedDiffConfig
branches/upstream/libparse-cpan-meta-perl/current/LICENSE
branches/upstream/libparse-cpan-meta-perl/current/README
branches/upstream/libparse-cpan-meta-perl/current/t/97_meta.t
branches/upstream/libparse-cpan-meta-perl/current/t/98_pod.t
branches/upstream/libparse-cpan-meta-perl/current/t/99_pmv.t
branches/upstream/libparse-cpan-meta-perl/current/t/data/utf_16_le_bom.yml
Modified:
branches/upstream/libparse-cpan-meta-perl/current/Changes
branches/upstream/libparse-cpan-meta-perl/current/MANIFEST
branches/upstream/libparse-cpan-meta-perl/current/META.yml
branches/upstream/libparse-cpan-meta-perl/current/Makefile.PL
branches/upstream/libparse-cpan-meta-perl/current/lib/Parse/CPAN/Meta.pm
Modified: branches/upstream/libparse-cpan-meta-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libparse-cpan-meta-perl/current/Changes?rev=40932&op=diff
==============================================================================
--- branches/upstream/libparse-cpan-meta-perl/current/Changes (original)
+++ branches/upstream/libparse-cpan-meta-perl/current/Changes Tue Jul 28 20:47:40 2009
@@ -1,4 +1,8 @@
Changes for Perl programming language extension Parse-CPAN-Meta
+
+1.40 Sat 25 Jul 2009
+ - Add core perl 5.10.1's uupacktool.pl
+ - Repackage t/data/utf_16_le_bom.yml as ASCII for https://rt.cpan.org/Ticket/Display.html?id=47844
1.39 Thu 21 May 2009
- Even though utf8 starts at 5.7+ there's no is_utf till
Modified: branches/upstream/libparse-cpan-meta-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libparse-cpan-meta-perl/current/MANIFEST?rev=40932&op=diff
==============================================================================
--- branches/upstream/libparse-cpan-meta-perl/current/MANIFEST (original)
+++ branches/upstream/libparse-cpan-meta-perl/current/MANIFEST Tue Jul 28 20:47:40 2009
@@ -1,10 +1,7 @@
-.dualLivedDiffConfig
Changes
lib/Parse/CPAN/Meta.pm
-LICENSE
Makefile.PL
MANIFEST This list of files
-README
t/01_compile.t
t/02_basic.t
t/03_regression.t
@@ -20,16 +17,14 @@
t/18_tap.t
t/19_errors.t
t/21_bom.t
-t/97_meta.t
-t/98_pod.t
-t/99_pmv.t
t/data/HTML-WebDAO.yml
t/data/multibyte.yml
t/data/sample.yml
t/data/Spreadsheet-Read.yml
t/data/Template-Provider-Unicode-Japanese.yml
t/data/toolbar.yml
-t/data/utf_16_le_bom.yml
+t/data/utf_16_le_bom.yml.packed
t/data/vanilla.yml
t/lib/Parse/CPAN/Meta/Test.pm
+uupacktool.pl
META.yml Module meta-data (added by MakeMaker)
Modified: branches/upstream/libparse-cpan-meta-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libparse-cpan-meta-perl/current/META.yml?rev=40932&op=diff
==============================================================================
--- branches/upstream/libparse-cpan-meta-perl/current/META.yml (original)
+++ branches/upstream/libparse-cpan-meta-perl/current/META.yml Tue Jul 28 20:47:40 2009
@@ -1,23 +1,12 @@
---- #YAML:1.0
-name: Parse-CPAN-Meta
-version: 1.39
-abstract: Parse META.yml and other similar CPAN metadata files
-author:
- - Adam Kennedy <adamk at cpan.org>
-license: perl
-distribution_type: module
-configure_requires:
- ExtUtils::MakeMaker: 0
-build_requires:
- ExtUtils::MakeMaker: 0
+# http://module-build.sourceforge.net/META-spec.html
+#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
+name: Parse-CPAN-Meta
+version: 1.40
+version_from:
+installdirs: site
requires:
- File::Spec: 0.80
- Test::More: 0.47
-no_index:
- directory:
- - t
- - inc
-generated_by: ExtUtils::MakeMaker version 6.50
-meta-spec:
- url: http://module-build.sourceforge.net/META-spec-v1.4.html
- version: 1.4
+ File::Spec: 0.80
+ Test::More: 0.47
+
+distribution_type: module
+generated_by: ExtUtils::MakeMaker version 6.30_01
Modified: branches/upstream/libparse-cpan-meta-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libparse-cpan-meta-perl/current/Makefile.PL?rev=40932&op=diff
==============================================================================
--- branches/upstream/libparse-cpan-meta-perl/current/Makefile.PL (original)
+++ branches/upstream/libparse-cpan-meta-perl/current/Makefile.PL Tue Jul 28 20:47:40 2009
@@ -1,23 +1,73 @@
-use strict;
-BEGIN {
- require 5.003_96;
- $main::VERSION = '1.39';
-}
-use ExtUtils::MakeMaker;
-
-WriteMakefile(
- NAME => 'Parse::CPAN::Meta',
- ABSTRACT => 'Parse META.yml and other similar CPAN metadata files',
- VERSION => $main::VERSION,
- PREREQ_PM => {
- 'File::Spec' => '0.80',
- 'Test::More' => '0.47',
- },
- ($] >= 5.005 ? (
- AUTHOR => 'Adam Kennedy <adamk at cpan.org>',
- ) : ()),
- ($ExtUtils::MakeMaker::VERSION ge '6.30_00' ? (
- LICENSE => 'perl',
- ) : ()),
- (INSTALLDIRS => $] >= 5.010001 ? 'perl' : 'site'),
-);
+use strict;
+BEGIN {
+ require 5.003_96;
+ $main::VERSION = '1.40';
+}
+use ExtUtils::MakeMaker;
+
+WriteMakefile(
+ NAME => 'Parse::CPAN::Meta',
+ ABSTRACT => 'Parse META.yml and other similar CPAN metadata files',
+ VERSION => $main::VERSION,
+ PREREQ_PM => {
+ 'File::Spec' => '0.80',
+ 'Test::More' => '0.47',
+ },
+ ($] >= 5.005 ? (
+ AUTHOR => 'Adam Kennedy <adamk at cpan.org>',
+ ) : ()),
+ ($ExtUtils::MakeMaker::VERSION ge '6.30_00' ? (
+ LICENSE => 'perl',
+ ) : ()),
+ (INSTALLDIRS => $] >= 5.010001 ? 'perl' : 'site'),
+);
+
+package MY;
+
+# ExtUtil::MakeMaker's default PMLIBDIRS finds uupacktool.pl but
+# that's only a utility so I'd like it to be skipped over.
+sub libscan {
+ my $self = shift @_;
+ my ( $pl_or_pm ) = @_;
+ return 0 if $pl_or_pm eq 'uupacktool.pl';
+ return $self->SUPER::libscan( @_ );
+}
+
+# Just like core perl's _test_prep function in Makefile, we unpack
+# binary files before testing. This function also converts the
+# double-colon test dependency list to a single colon list. This
+# turned out to be be necessary because unpacking the binary files
+# must happen before any other test tasks will run and potentially
+# require them.
+#
+# TODO: consider whether the test rule should be gutted so it only
+# handles test preparation, then delegates to another rule which is
+# double-colon like this rule normally is.
+sub test {
+ my $inherited = shift->SUPER::test(@_);
+ $inherited =~ s{^test\s*:+\s*(.*)}{
+ "test : unpack_files $1";
+ }me || die $inherited;
+ return $inherited;
+}
+
+# Adding cleanup_unpacked_files to the clean rule.
+sub clean {
+ my $inherited = shift->SUPER::clean(@_);
+ $inherited =~ s{^(clean\s*:.*)}{
+ "$1 cleanup_unpacked_files";
+ }me || die $inherited;
+ return $inherited;
+}
+
+# Define the unpack_files and cleanup_unpacked_files Makefile rules.
+sub postamble {
+ return <<'MAKE_FRAG';
+unpack_files:
+ $(FULLPERLRUN) uupacktool.pl -u -m
+
+cleanup_unpacked_files:
+ $(FULLPERLRUN) uupacktool.pl -c
+
+MAKE_FRAG
+}
Modified: branches/upstream/libparse-cpan-meta-perl/current/lib/Parse/CPAN/Meta.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libparse-cpan-meta-perl/current/lib/Parse/CPAN/Meta.pm?rev=40932&op=diff
==============================================================================
--- branches/upstream/libparse-cpan-meta-perl/current/lib/Parse/CPAN/Meta.pm (original)
+++ branches/upstream/libparse-cpan-meta-perl/current/lib/Parse/CPAN/Meta.pm Tue Jul 28 20:47:40 2009
@@ -1,437 +1,437 @@
-package Parse::CPAN::Meta;
-
-use strict;
-use Carp 'croak';
-
-# UTF Support?
-sub HAVE_UTF8 () { $] >= 5.007003 }
-BEGIN {
- if ( HAVE_UTF8 ) {
- # The string eval helps hide this from Test::MinimumVersion
- eval "require utf8;";
- die "Failed to load UTF-8 support" if $@;
- }
-
- # Class structure
- require 5.004;
- require Exporter;
- $Parse::CPAN::Meta::VERSION = '1.39';
- @Parse::CPAN::Meta::ISA = qw{ Exporter };
- @Parse::CPAN::Meta::EXPORT_OK = qw{ Load LoadFile };
-}
-
-# Prototypes
-sub LoadFile ($);
-sub Load ($);
-sub _scalar ($$$);
-sub _array ($$$);
-sub _hash ($$$);
-
-# Printable characters for escapes
-my %UNESCAPES = (
- z => "\x00", a => "\x07", t => "\x09",
- n => "\x0a", v => "\x0b", f => "\x0c",
- r => "\x0d", e => "\x1b", '\\' => '\\',
-);
-
-
-
-
-
-#####################################################################
-# Implementation
-
-# Create an object from a file
-sub LoadFile ($) {
- # Check the file
- my $file = shift;
- croak('You did not specify a file name') unless $file;
- croak( "File '$file' does not exist" ) unless -e $file;
- croak( "'$file' is a directory, not a file" ) unless -f _;
- croak( "Insufficient permissions to read '$file'" ) unless -r _;
-
- # Slurp in the file
- local $/ = undef;
- local *CFG;
- unless ( open( CFG, $file ) ) {
- croak("Failed to open file '$file': $!");
- }
- my $yaml = <CFG>;
- unless ( close(CFG) ) {
- croak("Failed to close file '$file': $!");
- }
-
- # Hand off to the actual parser
- Load( $yaml );
-}
-
-# Parse a document from a string.
-# Doing checks on $_[0] prevents us having to do a string copy.
-sub Load ($) {
- my $string = $_[0];
- unless ( defined $string ) {
- croak("Did not provide a string to load");
- }
-
- # Byte order marks
- if ( $string =~ /^(?:\376\377|\377\376|\377\376\0\0|\0\0\376\377)/ ) {
- croak("Stream has a non UTF-8 Unicode Byte Order Mark");
- } else {
- # Strip UTF-8 bom if found, we'll just ignore it
- $string =~ s/^\357\273\277//;
- }
-
- # Try to decode as utf8
- utf8::decode($string) if HAVE_UTF8;
-
- # Check for some special cases
- return () unless length $string;
- unless ( $string =~ /[\012\015]+\z/ ) {
- croak("Stream does not end with newline character");
- }
-
- # Split the file into lines
- my @lines = grep { ! /^\s*(?:\#.*)?\z/ }
- split /(?:\015{1,2}\012|\015|\012)/, $string;
-
- # Strip the initial YAML header
- @lines and $lines[0] =~ /^\%YAML[: ][\d\.]+.*\z/ and shift @lines;
-
- # A nibbling parser
- my @documents = ();
- while ( @lines ) {
- # Do we have a document header?
- if ( $lines[0] =~ /^---\s*(?:(.+)\s*)?\z/ ) {
- # Handle scalar documents
- shift @lines;
- if ( defined $1 and $1 !~ /^(?:\#.+|\%YAML[: ][\d\.]+)\z/ ) {
- push @documents, _scalar( "$1", [ undef ], \@lines );
- next;
- }
- }
-
- if ( ! @lines or $lines[0] =~ /^(?:---|\.\.\.)/ ) {
- # A naked document
- push @documents, undef;
- while ( @lines and $lines[0] !~ /^---/ ) {
- shift @lines;
- }
-
- } elsif ( $lines[0] =~ /^\s*\-/ ) {
- # An array at the root
- my $document = [ ];
- push @documents, $document;
- _array( $document, [ 0 ], \@lines );
-
- } elsif ( $lines[0] =~ /^(\s*)\S/ ) {
- # A hash at the root
- my $document = { };
- push @documents, $document;
- _hash( $document, [ length($1) ], \@lines );
-
- } else {
- croak("Parse::CPAN::Meta failed to classify line '$lines[0]'");
- }
- }
-
- if ( wantarray ) {
- return @documents;
- } else {
- return $documents[-1];
- }
-}
-
-# Deparse a scalar string to the actual scalar
-sub _scalar ($$$) {
- my ($string, $indent, $lines) = @_;
-
- # Trim trailing whitespace
- $string =~ s/\s*\z//;
-
- # Explitic null/undef
- return undef if $string eq '~';
-
- # Quotes
- if ( $string =~ /^\'(.*?)\'\z/ ) {
- return '' unless defined $1;
- $string = $1;
- $string =~ s/\'\'/\'/g;
- return $string;
- }
- if ( $string =~ /^\"((?:\\.|[^\"])*)\"\z/ ) {
- # Reusing the variable is a little ugly,
- # but avoids a new variable and a string copy.
- $string = $1;
- $string =~ s/\\"/"/g;
- $string =~ s/\\([never\\fartz]|x([0-9a-fA-F]{2}))/(length($1)>1)?pack("H2",$2):$UNESCAPES{$1}/gex;
- return $string;
- }
-
- # Special cases
- if ( $string =~ /^[\'\"!&]/ ) {
- croak("Parse::CPAN::Meta does not support a feature in line '$lines->[0]'");
- }
- return {} if $string eq '{}';
- return [] if $string eq '[]';
-
- # Regular unquoted string
- return $string unless $string =~ /^[>|]/;
-
- # Error
- croak("Parse::CPAN::Meta failed to find multi-line scalar content") unless @$lines;
-
- # Check the indent depth
- $lines->[0] =~ /^(\s*)/;
- $indent->[-1] = length("$1");
- if ( defined $indent->[-2] and $indent->[-1] <= $indent->[-2] ) {
- croak("Parse::CPAN::Meta found bad indenting in line '$lines->[0]'");
- }
-
- # Pull the lines
- my @multiline = ();
- while ( @$lines ) {
- $lines->[0] =~ /^(\s*)/;
- last unless length($1) >= $indent->[-1];
- push @multiline, substr(shift(@$lines), length($1));
- }
-
- my $j = (substr($string, 0, 1) eq '>') ? ' ' : "\n";
- my $t = (substr($string, 1, 1) eq '-') ? '' : "\n";
- return join( $j, @multiline ) . $t;
-}
-
-# Parse an array
-sub _array ($$$) {
- my ($array, $indent, $lines) = @_;
-
- while ( @$lines ) {
- # Check for a new document
- if ( $lines->[0] =~ /^(?:---|\.\.\.)/ ) {
- while ( @$lines and $lines->[0] !~ /^---/ ) {
- shift @$lines;
- }
- return 1;
- }
-
- # Check the indent level
- $lines->[0] =~ /^(\s*)/;
- if ( length($1) < $indent->[-1] ) {
- return 1;
- } elsif ( length($1) > $indent->[-1] ) {
- croak("Parse::CPAN::Meta found bad indenting in line '$lines->[0]'");
- }
-
- if ( $lines->[0] =~ /^(\s*\-\s+)[^\'\"]\S*\s*:(?:\s+|$)/ ) {
- # Inline nested hash
- my $indent2 = length("$1");
- $lines->[0] =~ s/-/ /;
- push @$array, { };
- _hash( $array->[-1], [ @$indent, $indent2 ], $lines );
-
- } elsif ( $lines->[0] =~ /^\s*\-(\s*)(.+?)\s*\z/ ) {
- # Array entry with a value
- shift @$lines;
- push @$array, _scalar( "$2", [ @$indent, undef ], $lines );
-
- } elsif ( $lines->[0] =~ /^\s*\-\s*\z/ ) {
- shift @$lines;
- unless ( @$lines ) {
- push @$array, undef;
- return 1;
- }
- if ( $lines->[0] =~ /^(\s*)\-/ ) {
- my $indent2 = length("$1");
- if ( $indent->[-1] == $indent2 ) {
- # Null array entry
- push @$array, undef;
- } else {
- # Naked indenter
- push @$array, [ ];
- _array( $array->[-1], [ @$indent, $indent2 ], $lines );
- }
-
- } elsif ( $lines->[0] =~ /^(\s*)\S/ ) {
- push @$array, { };
- _hash( $array->[-1], [ @$indent, length("$1") ], $lines );
-
- } else {
- croak("Parse::CPAN::Meta failed to classify line '$lines->[0]'");
- }
-
- } elsif ( defined $indent->[-2] and $indent->[-1] == $indent->[-2] ) {
- # This is probably a structure like the following...
- # ---
- # foo:
- # - list
- # bar: value
- #
- # ... so lets return and let the hash parser handle it
- return 1;
-
- } else {
- croak("Parse::CPAN::Meta failed to classify line '$lines->[0]'");
- }
- }
-
- return 1;
-}
-
-# Parse an array
-sub _hash ($$$) {
- my ($hash, $indent, $lines) = @_;
-
- while ( @$lines ) {
- # Check for a new document
- if ( $lines->[0] =~ /^(?:---|\.\.\.)/ ) {
- while ( @$lines and $lines->[0] !~ /^---/ ) {
- shift @$lines;
- }
- return 1;
- }
-
- # Check the indent level
- $lines->[0] =~ /^(\s*)/;
- if ( length($1) < $indent->[-1] ) {
- return 1;
- } elsif ( length($1) > $indent->[-1] ) {
- croak("Parse::CPAN::Meta found bad indenting in line '$lines->[0]'");
- }
-
- # Get the key
- unless ( $lines->[0] =~ s/^\s*([^\'\" ][^\n]*?)\s*:(\s+|$)// ) {
- if ( $lines->[0] =~ /^\s*[?\'\"]/ ) {
- croak("Parse::CPAN::Meta does not support a feature in line '$lines->[0]'");
- }
- croak("Parse::CPAN::Meta failed to classify line '$lines->[0]'");
- }
- my $key = $1;
-
- # Do we have a value?
- if ( length $lines->[0] ) {
- # Yes
- $hash->{$key} = _scalar( shift(@$lines), [ @$indent, undef ], $lines );
- } else {
- # An indent
- shift @$lines;
- unless ( @$lines ) {
- $hash->{$key} = undef;
- return 1;
- }
- if ( $lines->[0] =~ /^(\s*)-/ ) {
- $hash->{$key} = [];
- _array( $hash->{$key}, [ @$indent, length($1) ], $lines );
- } elsif ( $lines->[0] =~ /^(\s*)./ ) {
- my $indent2 = length("$1");
- if ( $indent->[-1] >= $indent2 ) {
- # Null hash entry
- $hash->{$key} = undef;
- } else {
- $hash->{$key} = {};
- _hash( $hash->{$key}, [ @$indent, length($1) ], $lines );
- }
- }
- }
- }
-
- return 1;
-}
-
-1;
-
-__END__
-
-=pod
-
-=head1 NAME
-
-Parse::CPAN::Meta - Parse META.yml and other similar CPAN metadata files
-
-=head1 SYNOPSIS
-
- #############################################
- # In your file
-
- ---
- rootproperty: blah
- section:
- one: two
- three: four
- Foo: Bar
- empty: ~
-
-
-
- #############################################
- # In your program
-
- use Parse::CPAN::Meta;
-
- # Create a YAML file
- my @yaml = Parse::CPAN::Meta::LoadFile( 'Meta.yml' );
-
- # Reading properties
- my $root = $yaml[0]->{rootproperty};
- my $one = $yaml[0]->{section}->{one};
- my $Foo = $yaml[0]->{section}->{Foo};
-
-=head1 DESCRIPTION
-
-B<Parse::CPAN::Meta> is a parser for F<META.yml> files, based on the
-parser half of L<YAML::Tiny>.
-
-It supports a basic subset of the full YAML specification, enough to
-implement parsing of typical F<META.yml> files, and other similarly simple
-YAML files.
-
-If you need something with more power, move up to a full YAML parser such
-as L<YAML>, L<YAML::Syck> or L<YAML::LibYAML>.
-
-B<Parse::CPAN::Meta> provides a very simply API of only two functions,
-based on the YAML functions of the same name. Wherever possible,
-identical calling semantics are used.
-
-All error reporting is done with exceptions (die'ing).
-
-=head1 FUNCTIONS
-
-For maintenance clarity, no functions are exported.
-
-=head2 Load
-
- my @yaml = Load( $string );
-
-Parses a string containing a valid YAML stream into a list of Perl data
-structures.
-
-=head2 LoadFile
-
- my @yaml = LoadFile( 'META.yml' );
-
-Reads the YAML stream from a file instead of a string.
-
-=head1 SUPPORT
-
-Bugs should be reported via the CPAN bug tracker at
-
-L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Parse-CPAN-Meta>
-
-=head1 AUTHOR
-
-Adam Kennedy E<lt>adamk at cpan.orgE<gt>
-
-=head1 SEE ALSO
-
-L<YAML>, L<YAML::Syck>, L<Config::Tiny>, L<CSS::Tiny>,
-L<http://use.perl.org/~Alias/journal/29427>, L<http://ali.as/>
-
-=head1 COPYRIGHT
-
-Copyright 2006 - 2009 Adam Kennedy.
-
-This program is free software; you can redistribute
-it and/or modify it under the same terms as Perl itself.
-
-The full text of the license can be found in the
-LICENSE file included with this module.
-
-=cut
+package Parse::CPAN::Meta;
+
+use strict;
+use Carp 'croak';
+
+# UTF Support?
+sub HAVE_UTF8 () { $] >= 5.007003 }
+BEGIN {
+ if ( HAVE_UTF8 ) {
+ # The string eval helps hide this from Test::MinimumVersion
+ eval "require utf8;";
+ die "Failed to load UTF-8 support" if $@;
+ }
+
+ # Class structure
+ require 5.004;
+ require Exporter;
+ $Parse::CPAN::Meta::VERSION = '1.40';
+ @Parse::CPAN::Meta::ISA = qw{ Exporter };
+ @Parse::CPAN::Meta::EXPORT_OK = qw{ Load LoadFile };
+}
+
+# Prototypes
+sub LoadFile ($);
+sub Load ($);
+sub _scalar ($$$);
+sub _array ($$$);
+sub _hash ($$$);
+
+# Printable characters for escapes
+my %UNESCAPES = (
+ z => "\x00", a => "\x07", t => "\x09",
+ n => "\x0a", v => "\x0b", f => "\x0c",
+ r => "\x0d", e => "\x1b", '\\' => '\\',
+);
+
+
+
+
+
+#####################################################################
+# Implementation
+
+# Create an object from a file
+sub LoadFile ($) {
+ # Check the file
+ my $file = shift;
+ croak('You did not specify a file name') unless $file;
+ croak( "File '$file' does not exist" ) unless -e $file;
+ croak( "'$file' is a directory, not a file" ) unless -f _;
+ croak( "Insufficient permissions to read '$file'" ) unless -r _;
+
+ # Slurp in the file
+ local $/ = undef;
+ local *CFG;
+ unless ( open( CFG, $file ) ) {
+ croak("Failed to open file '$file': $!");
+ }
+ my $yaml = <CFG>;
+ unless ( close(CFG) ) {
+ croak("Failed to close file '$file': $!");
+ }
+
+ # Hand off to the actual parser
+ Load( $yaml );
+}
+
+# Parse a document from a string.
+# Doing checks on $_[0] prevents us having to do a string copy.
+sub Load ($) {
+ my $string = $_[0];
+ unless ( defined $string ) {
+ croak("Did not provide a string to load");
+ }
+
+ # Byte order marks
+ if ( $string =~ /^(?:\376\377|\377\376|\377\376\0\0|\0\0\376\377)/ ) {
+ croak("Stream has a non UTF-8 Unicode Byte Order Mark");
+ } else {
+ # Strip UTF-8 bom if found, we'll just ignore it
+ $string =~ s/^\357\273\277//;
+ }
+
+ # Try to decode as utf8
+ utf8::decode($string) if HAVE_UTF8;
+
+ # Check for some special cases
+ return () unless length $string;
+ unless ( $string =~ /[\012\015]+\z/ ) {
+ croak("Stream does not end with newline character");
+ }
+
+ # Split the file into lines
+ my @lines = grep { ! /^\s*(?:\#.*)?\z/ }
+ split /(?:\015{1,2}\012|\015|\012)/, $string;
+
+ # Strip the initial YAML header
+ @lines and $lines[0] =~ /^\%YAML[: ][\d\.]+.*\z/ and shift @lines;
+
+ # A nibbling parser
+ my @documents = ();
+ while ( @lines ) {
+ # Do we have a document header?
+ if ( $lines[0] =~ /^---\s*(?:(.+)\s*)?\z/ ) {
+ # Handle scalar documents
+ shift @lines;
+ if ( defined $1 and $1 !~ /^(?:\#.+|\%YAML[: ][\d\.]+)\z/ ) {
+ push @documents, _scalar( "$1", [ undef ], \@lines );
+ next;
+ }
+ }
+
+ if ( ! @lines or $lines[0] =~ /^(?:---|\.\.\.)/ ) {
+ # A naked document
+ push @documents, undef;
+ while ( @lines and $lines[0] !~ /^---/ ) {
+ shift @lines;
+ }
+
+ } elsif ( $lines[0] =~ /^\s*\-/ ) {
+ # An array at the root
+ my $document = [ ];
+ push @documents, $document;
+ _array( $document, [ 0 ], \@lines );
+
+ } elsif ( $lines[0] =~ /^(\s*)\S/ ) {
+ # A hash at the root
+ my $document = { };
+ push @documents, $document;
+ _hash( $document, [ length($1) ], \@lines );
+
+ } else {
+ croak("Parse::CPAN::Meta failed to classify line '$lines[0]'");
+ }
+ }
+
+ if ( wantarray ) {
+ return @documents;
+ } else {
+ return $documents[-1];
+ }
+}
+
+# Deparse a scalar string to the actual scalar
+sub _scalar ($$$) {
+ my ($string, $indent, $lines) = @_;
+
+ # Trim trailing whitespace
+ $string =~ s/\s*\z//;
+
+ # Explitic null/undef
+ return undef if $string eq '~';
+
+ # Quotes
+ if ( $string =~ /^\'(.*?)\'\z/ ) {
+ return '' unless defined $1;
+ $string = $1;
+ $string =~ s/\'\'/\'/g;
+ return $string;
+ }
+ if ( $string =~ /^\"((?:\\.|[^\"])*)\"\z/ ) {
+ # Reusing the variable is a little ugly,
+ # but avoids a new variable and a string copy.
+ $string = $1;
+ $string =~ s/\\"/"/g;
+ $string =~ s/\\([never\\fartz]|x([0-9a-fA-F]{2}))/(length($1)>1)?pack("H2",$2):$UNESCAPES{$1}/gex;
+ return $string;
+ }
+
+ # Special cases
+ if ( $string =~ /^[\'\"!&]/ ) {
+ croak("Parse::CPAN::Meta does not support a feature in line '$lines->[0]'");
+ }
+ return {} if $string eq '{}';
+ return [] if $string eq '[]';
+
+ # Regular unquoted string
+ return $string unless $string =~ /^[>|]/;
+
+ # Error
+ croak("Parse::CPAN::Meta failed to find multi-line scalar content") unless @$lines;
+
+ # Check the indent depth
+ $lines->[0] =~ /^(\s*)/;
+ $indent->[-1] = length("$1");
+ if ( defined $indent->[-2] and $indent->[-1] <= $indent->[-2] ) {
+ croak("Parse::CPAN::Meta found bad indenting in line '$lines->[0]'");
+ }
+
+ # Pull the lines
+ my @multiline = ();
+ while ( @$lines ) {
+ $lines->[0] =~ /^(\s*)/;
+ last unless length($1) >= $indent->[-1];
+ push @multiline, substr(shift(@$lines), length($1));
+ }
+
+ my $j = (substr($string, 0, 1) eq '>') ? ' ' : "\n";
+ my $t = (substr($string, 1, 1) eq '-') ? '' : "\n";
+ return join( $j, @multiline ) . $t;
+}
+
+# Parse an array
+sub _array ($$$) {
+ my ($array, $indent, $lines) = @_;
+
+ while ( @$lines ) {
+ # Check for a new document
+ if ( $lines->[0] =~ /^(?:---|\.\.\.)/ ) {
+ while ( @$lines and $lines->[0] !~ /^---/ ) {
+ shift @$lines;
+ }
+ return 1;
+ }
+
+ # Check the indent level
+ $lines->[0] =~ /^(\s*)/;
+ if ( length($1) < $indent->[-1] ) {
+ return 1;
+ } elsif ( length($1) > $indent->[-1] ) {
+ croak("Parse::CPAN::Meta found bad indenting in line '$lines->[0]'");
+ }
+
+ if ( $lines->[0] =~ /^(\s*\-\s+)[^\'\"]\S*\s*:(?:\s+|$)/ ) {
+ # Inline nested hash
+ my $indent2 = length("$1");
+ $lines->[0] =~ s/-/ /;
+ push @$array, { };
+ _hash( $array->[-1], [ @$indent, $indent2 ], $lines );
+
+ } elsif ( $lines->[0] =~ /^\s*\-(\s*)(.+?)\s*\z/ ) {
+ # Array entry with a value
+ shift @$lines;
+ push @$array, _scalar( "$2", [ @$indent, undef ], $lines );
+
+ } elsif ( $lines->[0] =~ /^\s*\-\s*\z/ ) {
+ shift @$lines;
+ unless ( @$lines ) {
+ push @$array, undef;
+ return 1;
+ }
+ if ( $lines->[0] =~ /^(\s*)\-/ ) {
+ my $indent2 = length("$1");
+ if ( $indent->[-1] == $indent2 ) {
+ # Null array entry
+ push @$array, undef;
+ } else {
+ # Naked indenter
+ push @$array, [ ];
+ _array( $array->[-1], [ @$indent, $indent2 ], $lines );
+ }
+
+ } elsif ( $lines->[0] =~ /^(\s*)\S/ ) {
+ push @$array, { };
+ _hash( $array->[-1], [ @$indent, length("$1") ], $lines );
+
+ } else {
+ croak("Parse::CPAN::Meta failed to classify line '$lines->[0]'");
+ }
+
+ } elsif ( defined $indent->[-2] and $indent->[-1] == $indent->[-2] ) {
+ # This is probably a structure like the following...
+ # ---
+ # foo:
+ # - list
+ # bar: value
+ #
+ # ... so lets return and let the hash parser handle it
+ return 1;
+
+ } else {
+ croak("Parse::CPAN::Meta failed to classify line '$lines->[0]'");
+ }
+ }
+
+ return 1;
+}
+
+# Parse an array
+sub _hash ($$$) {
+ my ($hash, $indent, $lines) = @_;
+
+ while ( @$lines ) {
+ # Check for a new document
+ if ( $lines->[0] =~ /^(?:---|\.\.\.)/ ) {
+ while ( @$lines and $lines->[0] !~ /^---/ ) {
+ shift @$lines;
+ }
+ return 1;
+ }
+
+ # Check the indent level
+ $lines->[0] =~ /^(\s*)/;
+ if ( length($1) < $indent->[-1] ) {
+ return 1;
+ } elsif ( length($1) > $indent->[-1] ) {
+ croak("Parse::CPAN::Meta found bad indenting in line '$lines->[0]'");
+ }
+
+ # Get the key
+ unless ( $lines->[0] =~ s/^\s*([^\'\" ][^\n]*?)\s*:(\s+|$)// ) {
+ if ( $lines->[0] =~ /^\s*[?\'\"]/ ) {
+ croak("Parse::CPAN::Meta does not support a feature in line '$lines->[0]'");
+ }
+ croak("Parse::CPAN::Meta failed to classify line '$lines->[0]'");
+ }
+ my $key = $1;
+
+ # Do we have a value?
+ if ( length $lines->[0] ) {
+ # Yes
+ $hash->{$key} = _scalar( shift(@$lines), [ @$indent, undef ], $lines );
+ } else {
+ # An indent
+ shift @$lines;
+ unless ( @$lines ) {
+ $hash->{$key} = undef;
+ return 1;
+ }
+ if ( $lines->[0] =~ /^(\s*)-/ ) {
+ $hash->{$key} = [];
+ _array( $hash->{$key}, [ @$indent, length($1) ], $lines );
+ } elsif ( $lines->[0] =~ /^(\s*)./ ) {
+ my $indent2 = length("$1");
+ if ( $indent->[-1] >= $indent2 ) {
+ # Null hash entry
+ $hash->{$key} = undef;
+ } else {
+ $hash->{$key} = {};
+ _hash( $hash->{$key}, [ @$indent, length($1) ], $lines );
+ }
+ }
+ }
+ }
+
+ return 1;
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Parse::CPAN::Meta - Parse META.yml and other similar CPAN metadata files
+
+=head1 SYNOPSIS
+
+ #############################################
+ # In your file
+
+ ---
+ rootproperty: blah
+ section:
+ one: two
+ three: four
+ Foo: Bar
+ empty: ~
+
+
+
+ #############################################
+ # In your program
+
+ use Parse::CPAN::Meta;
+
+ # Create a YAML file
+ my @yaml = Parse::CPAN::Meta::LoadFile( 'Meta.yml' );
+
+ # Reading properties
+ my $root = $yaml[0]->{rootproperty};
+ my $one = $yaml[0]->{section}->{one};
+ my $Foo = $yaml[0]->{section}->{Foo};
+
+=head1 DESCRIPTION
+
+B<Parse::CPAN::Meta> is a parser for F<META.yml> files, based on the
+parser half of L<YAML::Tiny>.
+
+It supports a basic subset of the full YAML specification, enough to
+implement parsing of typical F<META.yml> files, and other similarly simple
+YAML files.
+
+If you need something with more power, move up to a full YAML parser such
+as L<YAML>, L<YAML::Syck> or L<YAML::LibYAML>.
+
+B<Parse::CPAN::Meta> provides a very simply API of only two functions,
+based on the YAML functions of the same name. Wherever possible,
+identical calling semantics are used.
+
+All error reporting is done with exceptions (die'ing).
+
+=head1 FUNCTIONS
+
+For maintenance clarity, no functions are exported.
+
+=head2 Load
+
+ my @yaml = Load( $string );
+
+Parses a string containing a valid YAML stream into a list of Perl data
+structures.
+
+=head2 LoadFile
+
+ my @yaml = LoadFile( 'META.yml' );
+
+Reads the YAML stream from a file instead of a string.
+
+=head1 SUPPORT
+
+Bugs should be reported via the CPAN bug tracker at
+
+L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Parse-CPAN-Meta>
+
+=head1 AUTHOR
+
+Adam Kennedy E<lt>adamk at cpan.orgE<gt>
+
+=head1 SEE ALSO
+
+L<YAML>, L<YAML::Syck>, L<Config::Tiny>, L<CSS::Tiny>,
+L<http://use.perl.org/~Alias/journal/29427>, L<http://ali.as/>
+
+=head1 COPYRIGHT
+
+Copyright 2006 - 2009 Adam Kennedy.
+
+This program is free software; you can redistribute
+it and/or modify it under the same terms as Perl itself.
+
+The full text of the license can be found in the
+LICENSE file included with this module.
+
+=cut
Added: branches/upstream/libparse-cpan-meta-perl/current/t/data/utf_16_le_bom.yml.packed
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libparse-cpan-meta-perl/current/t/data/utf_16_le_bom.yml.packed?rev=40932&op=file
==============================================================================
--- branches/upstream/libparse-cpan-meta-perl/current/t/data/utf_16_le_bom.yml.packed (added)
+++ branches/upstream/libparse-cpan-meta-perl/current/t/data/utf_16_le_bom.yml.packed Tue Jul 28 20:47:40 2009
@@ -1,0 +1,16 @@
+#########################################################################
+This is a binary file that was packed with the 'uupacktool.pl' which
+is included in the Perl distribution.
+
+To unpack this file use the following command:
+
+ uupacktool.pl -u t/data/utf_16_le_bom.yml.packed t/data/utf_16_le_bom.yml
+
+To recreate it use the following command:
+
+ uupacktool.pl -p t/data/utf_16_le_bom.yml t/data/utf_16_le_bom.yml.packed
+
+Created at Sat Jul 25 17:27:03 2009
+#########################################################################
+__UU__
+6__XM`"T`+0`*`"T`(`!F`&\`;P`*````
Added: branches/upstream/libparse-cpan-meta-perl/current/uupacktool.pl
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libparse-cpan-meta-perl/current/uupacktool.pl?rev=40932&op=file
==============================================================================
--- branches/upstream/libparse-cpan-meta-perl/current/uupacktool.pl (added)
+++ branches/upstream/libparse-cpan-meta-perl/current/uupacktool.pl Tue Jul 28 20:47:40 2009
@@ -1,0 +1,225 @@
+#!perl
+
+use strict;
+use warnings;
+use Getopt::Long;
+use File::Basename;
+use File::Spec;
+
+BEGIN {
+ if ($^O eq 'VMS') {
+ require VMS::Filespec;
+ import VMS::Filespec;
+ }
+}
+
+Getopt::Long::Configure('no_ignore_case');
+
+our $LastUpdate = -M $0;
+
+sub handle_file {
+ my $opts = shift;
+ my $file = shift or die "Need file\n". usage();
+ my $outfile = shift || '';
+ $file = vms_check_name($file) if $^O eq 'VMS';
+ my $mode = (stat($file))[2] & 07777;
+
+ open my $fh, "<", $file
+ or do { warn "Could not open input file $file: $!"; exit 0 };
+ my $str = do { local $/; <$fh> };
+
+ ### unpack?
+ my $outstr;
+ if( $opts->{u} ) {
+ if( !$outfile ) {
+ $outfile = $file;
+ $outfile =~ s/\.packed\z//;
+ }
+ my ($head, $body) = split /__UU__\n/, $str;
+ die "Can't unpack malformed data in '$file'\n"
+ if !$head;
+ $outstr = unpack 'u', $body;
+
+ } else {
+ $outfile ||= $file . '.packed';
+
+ my $me = basename($0);
+
+ $outstr = <<"EOFBLURB" . pack 'u', $str;
+#########################################################################
+This is a binary file that was packed with the 'uupacktool.pl' which
+is included in the Perl distribution.
+
+To unpack this file use the following command:
+
+ $me -u $outfile $file
+
+To recreate it use the following command:
+
+ $me -p $file $outfile
+
+Created at @{[scalar localtime]}
+#########################################################################
+__UU__
+EOFBLURB
+ }
+
+ ### output the file
+ if( $opts->{'s'} ) {
+ print STDOUT $outstr;
+ } else {
+ $outfile = VMS::Filespec::vmsify($outfile) if $^O eq 'VMS';
+ print "Writing $file into $outfile\n" if $opts->{'v'};
+ open my $outfh, ">", $outfile
+ or do { warn "Could not open $outfile for writing: $!"; exit 0 };
+ binmode $outfh;
+ ### $outstr might be empty, if the file was empty
+ print $outfh $outstr if $outstr;
+ close $outfh;
+
+ chmod $mode, $outfile;
+ }
+
+ ### delete source file?
+ if( $opts->{'D'} and $file ne $outfile ) {
+ 1 while unlink $file;
+ }
+}
+
+sub bulk_process {
+ my $opts = shift;
+ my $Manifest = $opts->{'m'};
+
+ open my $fh, "<", $Manifest or die "Could not open '$Manifest':$!";
+
+ print "Reading $Manifest\n"
+ if $opts->{'v'};
+
+ my $count = 0;
+ my $lines = 0;
+ while( my $line = <$fh> ) {
+ chomp $line;
+ my ($file) = split /\s+/, $line;
+
+ $lines++;
+
+ next unless $file =~ /\.packed/;
+
+ $count++;
+
+ my $out = $file;
+ $out =~ s/\.packed\z//;
+ $out = vms_check_name($out) if $^O eq 'VMS';
+
+ ### unpack
+ if( !$opts->{'c'} ) {
+ ( $out, $file ) = ( $file, $out ) if $opts->{'p'};
+ if (-e $out) {
+ my $changed = -M _;
+ if ($changed < $LastUpdate and $changed < -M $file) {
+ print "Skipping '$file' as '$out' is up-to-date.\n"
+ if $opts->{'v'};
+ next;
+ }
+ }
+ handle_file($opts, $file, $out);
+ print "Converted '$file' to '$out'\n"
+ if $opts->{'v'};
+
+ ### clean up
+ } else {
+
+ ### file exists?
+ unless( -e $out ) {
+ print "File '$file' was not unpacked into '$out'. Can not remove.\n";
+
+ ### remove it
+ } else {
+ print "Removing '$out'\n";
+ 1 while unlink $out;
+ }
+ }
+ }
+ print "Found $count files to process out of $lines in '$Manifest'\n"
+ if $opts->{'v'};
+}
+
+sub usage {
+ return qq[
+Usage: $^X $0 [-d dir] [-v] [-c] [-D] -p|-u [orig [packed|-s] | -m [manifest]]
+
+ Handle binary files in source tree. Can be used to pack or
+ unpack files individiually or as specified by a manifest file.
+
+Options:
+ -u Unpack files (defaults to -u unless -p is specified)
+ -p Pack files
+ -c Clean up all unpacked files. Implies -m
+
+ -D Delete source file after encoding/decoding
+
+ -s Output to STDOUT rather than OUTPUT_FILE
+ -m Use manifest file, if none is explicitly provided defaults to 'MANIFEST'
+
+ -d Change directory to dir before processing
+
+ -v Run verbosely
+ -h Display this help message
+];
+}
+
+sub vms_check_name {
+
+# Packed files tend to have multiple dots, which the CRTL may or may not handle
+# properly, so convert to native format. And depending on how the archive was
+# unpacked, foo.bar.baz may be foo_bar.baz or foo.bar_baz. N.B. This checks for
+# existence, so is not suitable as-is to generate ODS-2-safe names in preparation
+# for file creation.
+
+ my $file = shift;
+
+ $file = VMS::Filespec::vmsify($file);
+ return $file if -e $file;
+
+ my ($vol,$dirs,$base) = File::Spec->splitpath($file);
+ my $tmp = $base;
+ 1 while $tmp =~ s/([^\.]+)\.(.+\..+)/$1_$2/;
+ my $try = File::Spec->catpath($vol, $dirs, $tmp);
+ return $try if -e $try;
+
+ $tmp = $base;
+ 1 while $tmp =~ s/(.+\..+)\.([^\.]+)/$1_$2/;
+ $try = File::Spec->catpath($vol, $dirs, $tmp);
+ return $try if -e $try;
+
+ return $file;
+}
+
+my $opts = {};
+GetOptions($opts,'u','p','c', 'D', 'm:s','s','d=s','v','h');
+
+die "Can't pack and unpack at the same time!\n", usage()
+ if $opts->{'u'} && $opts->{'p'};
+die usage() if $opts->{'h'};
+
+if ( $opts->{'d'} ) {
+ chdir $opts->{'d'}
+ or die "Failed to chdir to '$opts->{'d'}':$!";
+}
+$opts->{'u'} = 1 if !$opts->{'p'};
+binmode STDOUT if $opts->{'s'};
+if ( exists $opts->{'m'} or exists $opts->{'c'} ) {
+ $opts->{'m'} ||= "MANIFEST";
+ bulk_process($opts);
+ exit(0);
+} else {
+ if (@ARGV) {
+ handle_file($opts, @ARGV);
+ } else {
+ die "No file to process specified!\n", usage();
+ }
+ exit(0);
+}
+
+
+die usage();
More information about the Pkg-perl-cvs-commits
mailing list