'CPAN::Meta::YAML' => {
'MAINTAINER' => 'dagolden',
- 'DISTRIBUTION' => 'DAGOLDEN/CPAN-Meta-YAML-0.008.tar.gz',
+ 'DISTRIBUTION' => 'DAGOLDEN/CPAN-Meta-YAML-0.010.tar.gz',
'FILES' => q[cpan/CPAN-Meta-YAML],
'EXCLUDED' => [
't/00-compile.t',
package CPAN::Meta::YAML;
{
- $CPAN::Meta::YAML::VERSION = '0.008';
+ $CPAN::Meta::YAML::VERSION = '0.010';
}
+BEGIN {
+ $CPAN::Meta::YAML::AUTHORITY = 'cpan:ADAMK';
+}
+{
+; # original $VERSION removed by Doppelgaenger
+}
+# git description: v1.54-8-g4c3002d
+
use strict;
+use warnings;
# 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;
- require Carp;
- @CPAN::Meta::YAML::ISA = qw{ Exporter };
- @CPAN::Meta::YAML::EXPORT = qw{ Load Dump };
- @CPAN::Meta::YAML::EXPORT_OK = qw{ LoadFile DumpFile freeze thaw };
-
- # Error storage
- $CPAN::Meta::YAML::errstr = '';
+ 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;
+ require Carp;
+ @CPAN::Meta::YAML::ISA = qw{ Exporter };
+ @CPAN::Meta::YAML::EXPORT = qw{ Load Dump };
+ @CPAN::Meta::YAML::EXPORT_OK = qw{ LoadFile DumpFile freeze thaw };
+
+ # Error storage
+ $CPAN::Meta::YAML::errstr = '';
}
# The character class of all characters we need to escape
# Printed form of the unprintable characters in the lowest range
# of ASCII characters, listed by ASCII ordinal position.
my @UNPRINTABLE = qw(
- z x01 x02 x03 x04 x05 x06 a
- x08 t n v f r x0e x0f
- x10 x11 x12 x13 x14 x15 x16 x17
- x18 x19 x1a e x1c x1d x1e x1f
+ z x01 x02 x03 x04 x05 x06 a
+ x08 t n v f r x0e x0f
+ x10 x11 x12 x13 x14 x15 x16 x17
+ x18 x19 x1a e x1c x1d x1e x1f
);
# Printable characters for escapes
my %UNESCAPES = (
- z => "\x00", a => "\x07", t => "\x09",
- n => "\x0a", v => "\x0b", f => "\x0c",
- r => "\x0d", e => "\x1b", '\\' => '\\',
+ z => "\x00", a => "\x07", t => "\x09",
+ n => "\x0a", v => "\x0b", f => "\x0c",
+ r => "\x0d", e => "\x1b", '\\' => '\\',
);
# Special magic boolean words
my %QUOTE = map { $_ => 1 } qw{
- null Null NULL
- y Y yes Yes YES n N no No NO
- true True TRUE false False FALSE
- on On ON off Off OFF
+ null Null NULL
+ y Y yes Yes YES n N no No NO
+ true True TRUE false False FALSE
+ on On ON off Off OFF
};
# Create an empty CPAN::Meta::YAML object
sub new {
- my $class = shift;
- bless [ @_ ], $class;
+ my $class = shift;
+ bless [ @_ ], $class;
}
# Create an object from a file
sub read {
- my $class = ref $_[0] ? ref shift : shift;
-
- # Check the file
- my $file = shift or return $class->_error( 'You did not specify a file name' );
- return $class->_error( "File '$file' does not exist" ) unless -e $file;
- return $class->_error( "'$file' is a directory, not a file" ) unless -f _;
- return $class->_error( "Insufficient permissions to read '$file'" ) unless -r _;
-
- # Slurp in the file
- local $/ = undef;
- local *CFG;
- unless ( open(CFG, $file) ) {
- return $class->_error("Failed to open file '$file': $!");
- }
- my $contents = <CFG>;
- unless ( close(CFG) ) {
- return $class->_error("Failed to close file '$file': $!");
- }
-
- $class->read_string( $contents );
+ my $class = ref $_[0] ? ref shift : shift;
+
+ # Check the file
+ my $file = shift or return $class->_error( 'You did not specify a file name' );
+ return $class->_error( "File '$file' does not exist" ) unless -e $file;
+ return $class->_error( "'$file' is a directory, not a file" ) unless -f _;
+ return $class->_error( "Insufficient permissions to read '$file'" ) unless -r _;
+
+ # Slurp in the file
+ local $/ = undef;
+ local *CFG;
+ unless ( open(CFG, $file) ) {
+ return $class->_error("Failed to open file '$file': $!");
+ }
+ my $contents = <CFG>;
+ unless ( close(CFG) ) {
+ return $class->_error("Failed to close file '$file': $!");
+ }
+
+ $class->read_string( $contents );
}
# Create an object from a string
sub read_string {
- my $class = ref $_[0] ? ref shift : shift;
- my $self = bless [], $class;
- my $string = $_[0];
- eval {
- unless ( defined $string ) {
- die \"Did not provide a string to load";
- }
-
- # Byte order marks
- # NOTE: Keeping this here to educate maintainers
- # my %BOM = (
- # "\357\273\277" => 'UTF-8',
- # "\376\377" => 'UTF-16BE',
- # "\377\376" => 'UTF-16LE',
- # "\377\376\0\0" => 'UTF-32LE'
- # "\0\0\376\377" => 'UTF-32BE',
- # );
- if ( $string =~ /^(?:\376\377|\377\376|\377\376\0\0|\0\0\376\377)/ ) {
- die \"Stream has a non UTF-8 BOM";
- } 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 $self unless length $string;
- unless ( $string =~ /[\012\015]+\z/ ) {
- die \"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
- 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 @$self, $self->_read_scalar( "$1", [ undef ], \@lines );
- next;
- }
- }
-
- if ( ! @lines or $lines[0] =~ /^(?:---|\.\.\.)/ ) {
- # A naked document
- push @$self, undef;
- while ( @lines and $lines[0] !~ /^---/ ) {
- shift @lines;
- }
-
- } elsif ( $lines[0] =~ /^\s*\-/ ) {
- # An array at the root
- my $document = [ ];
- push @$self, $document;
- $self->_read_array( $document, [ 0 ], \@lines );
-
- } elsif ( $lines[0] =~ /^(\s*)\S/ ) {
- # A hash at the root
- my $document = { };
- push @$self, $document;
- $self->_read_hash( $document, [ length($1) ], \@lines );
-
- } else {
- die \"CPAN::Meta::YAML failed to classify the line '$lines[0]'";
- }
- }
- };
- if ( ref $@ eq 'SCALAR' ) {
- return $self->_error(${$@});
- } elsif ( $@ ) {
- require Carp;
- Carp::croak($@);
- }
-
- return $self;
+ my $class = ref $_[0] ? ref shift : shift;
+ my $self = bless [], $class;
+ my $string = $_[0];
+ eval {
+ unless ( defined $string ) {
+ die \"Did not provide a string to load";
+ }
+
+ # Byte order marks
+ # NOTE: Keeping this here to educate maintainers
+ # my %BOM = (
+ # "\357\273\277" => 'UTF-8',
+ # "\376\377" => 'UTF-16BE',
+ # "\377\376" => 'UTF-16LE',
+ # "\377\376\0\0" => 'UTF-32LE'
+ # "\0\0\376\377" => 'UTF-32BE',
+ # );
+ if ( $string =~ /^(?:\376\377|\377\376|\377\376\0\0|\0\0\376\377)/ ) {
+ die \"Stream has a non UTF-8 BOM";
+ } 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 $self unless length $string;
+ unless ( $string =~ /[\012\015]+\z/ ) {
+ die \"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
+ 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 @$self, $self->_read_scalar( "$1", [ undef ], \@lines );
+ next;
+ }
+ }
+
+ if ( ! @lines or $lines[0] =~ /^(?:---|\.\.\.)/ ) {
+ # A naked document
+ push @$self, undef;
+ while ( @lines and $lines[0] !~ /^---/ ) {
+ shift @lines;
+ }
+
+ } elsif ( $lines[0] =~ /^\s*\-/ ) {
+ # An array at the root
+ my $document = [ ];
+ push @$self, $document;
+ $self->_read_array( $document, [ 0 ], \@lines );
+
+ } elsif ( $lines[0] =~ /^(\s*)\S/ ) {
+ # A hash at the root
+ my $document = { };
+ push @$self, $document;
+ $self->_read_hash( $document, [ length($1) ], \@lines );
+
+ } else {
+ die \"CPAN::Meta::YAML failed to classify the line '$lines[0]'";
+ }
+ }
+ };
+ if ( ref $@ eq 'SCALAR' ) {
+ return $self->_error(${$@});
+ } elsif ( $@ ) {
+ require Carp;
+ Carp::croak($@);
+ }
+
+ return $self;
}
# Deparse a scalar string to the actual scalar
sub _read_scalar {
- my ($self, $string, $indent, $lines) = @_;
-
- # Trim trailing whitespace
- $string =~ s/\s*\z//;
-
- # Explitic null/undef
- return undef if $string eq '~';
-
- # Single quote
- if ( $string =~ /^\'(.*?)\'(?:\s+\#.*)?\z/ ) {
- return '' unless defined $1;
- $string = $1;
- $string =~ s/\'\'/\'/g;
- return $string;
- }
-
- # Double quote.
- # The commented out form is simpler, but overloaded the Perl regex
- # engine due to recursion and backtracking problems on strings
- # larger than 32,000ish characters. Keep it for reference purposes.
- # if ( $string =~ /^\"((?:\\.|[^\"])*)\"\z/ ) {
- if ( $string =~ /^\"([^\\"]*(?:\\.[^\\"]*)*)\"(?:\s+\#.*)?\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 =~ /^[\'\"!&]/ ) {
- die \"CPAN::Meta::YAML does not support a feature in line '$string'";
- }
- return {} if $string =~ /^{}(?:\s+\#.*)?\z/;
- return [] if $string =~ /^\[\](?:\s+\#.*)?\z/;
-
- # Regular unquoted string
- if ( $string !~ /^[>|]/ ) {
- if (
- $string =~ /^(?:-(?:\s|$)|[\@\%\`])/
- or
- $string =~ /:(?:\s|$)/
- ) {
- die \"CPAN::Meta::YAML found illegal characters in plain scalar: '$string'";
- }
- $string =~ s/\s+#.*\z//;
- return $string;
- }
-
- # Error
- die \"CPAN::Meta::YAML 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] ) {
- die \"CPAN::Meta::YAML 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;
+ my ($self, $string, $indent, $lines) = @_;
+
+ # Trim trailing whitespace
+ $string =~ s/\s*\z//;
+
+ # Explitic null/undef
+ return undef if $string eq '~';
+
+ # Single quote
+ if ( $string =~ /^\'(.*?)\'(?:\s+\#.*)?\z/ ) {
+ return '' unless defined $1;
+ $string = $1;
+ $string =~ s/\'\'/\'/g;
+ return $string;
+ }
+
+ # Double quote.
+ # The commented out form is simpler, but overloaded the Perl regex
+ # engine due to recursion and backtracking problems on strings
+ # larger than 32,000ish characters. Keep it for reference purposes.
+ # if ( $string =~ /^\"((?:\\.|[^\"])*)\"\z/ ) {
+ if ( $string =~ /^\"([^\\"]*(?:\\.[^\\"]*)*)\"(?:\s+\#.*)?\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 =~ /^[\'\"!&]/ ) {
+ die \"CPAN::Meta::YAML does not support a feature in line '$string'";
+ }
+ return {} if $string =~ /^{}(?:\s+\#.*)?\z/;
+ return [] if $string =~ /^\[\](?:\s+\#.*)?\z/;
+
+ # Regular unquoted string
+ if ( $string !~ /^[>|]/ ) {
+ if (
+ $string =~ /^(?:-(?:\s|$)|[\@\%\`])/
+ or
+ $string =~ /:(?:\s|$)/
+ ) {
+ die \"CPAN::Meta::YAML found illegal characters in plain scalar: '$string'";
+ }
+ $string =~ s/\s+#.*\z//;
+ return $string;
+ }
+
+ # Error
+ die \"CPAN::Meta::YAML 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] ) {
+ die \"CPAN::Meta::YAML 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 _read_array {
- my ($self, $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] ) {
- die \"CPAN::Meta::YAML 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, { };
- $self->_read_hash( $array->[-1], [ @$indent, $indent2 ], $lines );
-
- } elsif ( $lines->[0] =~ /^\s*\-(\s*)(.+?)\s*\z/ ) {
- # Array entry with a value
- shift @$lines;
- push @$array, $self->_read_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, [ ];
- $self->_read_array( $array->[-1], [ @$indent, $indent2 ], $lines );
- }
-
- } elsif ( $lines->[0] =~ /^(\s*)\S/ ) {
- push @$array, { };
- $self->_read_hash( $array->[-1], [ @$indent, length("$1") ], $lines );
-
- } else {
- die \"CPAN::Meta::YAML 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 {
- die \"CPAN::Meta::YAML failed to classify line '$lines->[0]'";
- }
- }
-
- return 1;
+ my ($self, $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] ) {
+ die \"CPAN::Meta::YAML 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, { };
+ $self->_read_hash( $array->[-1], [ @$indent, $indent2 ], $lines );
+
+ } elsif ( $lines->[0] =~ /^\s*\-(\s*)(.+?)\s*\z/ ) {
+ # Array entry with a value
+ shift @$lines;
+ push @$array, $self->_read_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, [ ];
+ $self->_read_array( $array->[-1], [ @$indent, $indent2 ], $lines );
+ }
+
+ } elsif ( $lines->[0] =~ /^(\s*)\S/ ) {
+ push @$array, { };
+ $self->_read_hash( $array->[-1], [ @$indent, length("$1") ], $lines );
+
+ } else {
+ die \"CPAN::Meta::YAML 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 {
+ die \"CPAN::Meta::YAML failed to classify line '$lines->[0]'";
+ }
+ }
+
+ return 1;
}
# Parse an array
sub _read_hash {
- my ($self, $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] ) {
- die \"CPAN::Meta::YAML found bad indenting in line '$lines->[0]'";
- }
-
- # Get the key
- unless ( $lines->[0] =~ s/^\s*([^\'\" ][^\n]*?)\s*:(\s+(?:\#.*)?|$)// ) {
- if ( $lines->[0] =~ /^\s*[?\'\"]/ ) {
- die \"CPAN::Meta::YAML does not support a feature in line '$lines->[0]'";
- }
- die \"CPAN::Meta::YAML failed to classify line '$lines->[0]'";
- }
- my $key = $1;
-
- # Do we have a value?
- if ( length $lines->[0] ) {
- # Yes
- $hash->{$key} = $self->_read_scalar( shift(@$lines), [ @$indent, undef ], $lines );
- } else {
- # An indent
- shift @$lines;
- unless ( @$lines ) {
- $hash->{$key} = undef;
- return 1;
- }
- if ( $lines->[0] =~ /^(\s*)-/ ) {
- $hash->{$key} = [];
- $self->_read_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} = {};
- $self->_read_hash( $hash->{$key}, [ @$indent, length($1) ], $lines );
- }
- }
- }
- }
-
- return 1;
+ my ($self, $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] ) {
+ die \"CPAN::Meta::YAML found bad indenting in line '$lines->[0]'";
+ }
+
+ # Get the key
+ unless ( $lines->[0] =~ s/^\s*([^\'\" ][^\n]*?)\s*:(\s+(?:\#.*)?|$)// ) {
+ if ( $lines->[0] =~ /^\s*[?\'\"]/ ) {
+ die \"CPAN::Meta::YAML does not support a feature in line '$lines->[0]'";
+ }
+ die \"CPAN::Meta::YAML failed to classify line '$lines->[0]'";
+ }
+ my $key = $1;
+
+ # Do we have a value?
+ if ( length $lines->[0] ) {
+ # Yes
+ $hash->{$key} = $self->_read_scalar( shift(@$lines), [ @$indent, undef ], $lines );
+ } else {
+ # An indent
+ shift @$lines;
+ unless ( @$lines ) {
+ $hash->{$key} = undef;
+ return 1;
+ }
+ if ( $lines->[0] =~ /^(\s*)-/ ) {
+ $hash->{$key} = [];
+ $self->_read_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} = {};
+ $self->_read_hash( $hash->{$key}, [ @$indent, length($1) ], $lines );
+ }
+ }
+ }
+ }
+
+ return 1;
}
# Save an object to a file
sub write {
- my $self = shift;
- my $file = shift or return $self->_error('No file name provided');
+ my $self = shift;
+ my $file = shift or return $self->_error('No file name provided');
- # Write it to the file
- open( CFG, '>' . $file ) or return $self->_error(
- "Failed to open file '$file' for writing: $!"
- );
- print CFG $self->write_string;
- close CFG;
+ # Write it to the file
+ open( CFG, '>' . $file ) or return $self->_error(
+ "Failed to open file '$file' for writing: $!"
+ );
+ print CFG $self->write_string;
+ close CFG;
- return 1;
+ return 1;
}
# Save an object to a string
sub write_string {
- my $self = shift;
- return '' unless @$self;
-
- # Iterate over the documents
- my $indent = 0;
- my @lines = ();
- foreach my $cursor ( @$self ) {
- push @lines, '---';
-
- # An empty document
- if ( ! defined $cursor ) {
- # Do nothing
-
- # A scalar document
- } elsif ( ! ref $cursor ) {
- $lines[-1] .= ' ' . $self->_write_scalar( $cursor, $indent );
-
- # A list at the root
- } elsif ( ref $cursor eq 'ARRAY' ) {
- unless ( @$cursor ) {
- $lines[-1] .= ' []';
- next;
- }
- push @lines, $self->_write_array( $cursor, $indent, {} );
-
- # A hash at the root
- } elsif ( ref $cursor eq 'HASH' ) {
- unless ( %$cursor ) {
- $lines[-1] .= ' {}';
- next;
- }
- push @lines, $self->_write_hash( $cursor, $indent, {} );
-
- } else {
- Carp::croak("Cannot serialize " . ref($cursor));
- }
- }
-
- join '', map { "$_\n" } @lines;
+ my $self = shift;
+ return '' unless @$self;
+
+ # Iterate over the documents
+ my $indent = 0;
+ my @lines = ();
+ foreach my $cursor ( @$self ) {
+ push @lines, '---';
+
+ # An empty document
+ if ( ! defined $cursor ) {
+ # Do nothing
+
+ # A scalar document
+ } elsif ( ! ref $cursor ) {
+ $lines[-1] .= ' ' . $self->_write_scalar( $cursor, $indent );
+
+ # A list at the root
+ } elsif ( ref $cursor eq 'ARRAY' ) {
+ unless ( @$cursor ) {
+ $lines[-1] .= ' []';
+ next;
+ }
+ push @lines, $self->_write_array( $cursor, $indent, {} );
+
+ # A hash at the root
+ } elsif ( ref $cursor eq 'HASH' ) {
+ unless ( %$cursor ) {
+ $lines[-1] .= ' {}';
+ next;
+ }
+ push @lines, $self->_write_hash( $cursor, $indent, {} );
+
+ } else {
+ Carp::croak("Cannot serialize " . ref($cursor));
+ }
+ }
+
+ join '', map { "$_\n" } @lines;
}
sub _write_scalar {
- my $string = $_[1];
- return '~' unless defined $string;
- return "''" unless length $string;
- if ( $string =~ /[\x00-\x08\x0b-\x0d\x0e-\x1f\"\'\n]/ ) {
- $string =~ s/\\/\\\\/g;
- $string =~ s/"/\\"/g;
- $string =~ s/\n/\\n/g;
- $string =~ s/([\x00-\x1f])/\\$UNPRINTABLE[ord($1)]/g;
- return qq|"$string"|;
- }
- if ( $string =~ /(?:^\W|\s|:\z)/ or $QUOTE{$string} ) {
- return "'$string'";
- }
- return $string;
+ my $string = $_[1];
+ return '~' unless defined $string;
+ return "''" unless length $string;
+ if ( $string =~ /[\x00-\x08\x0b-\x0d\x0e-\x1f\"\'\n]/ ) {
+ $string =~ s/\\/\\\\/g;
+ $string =~ s/"/\\"/g;
+ $string =~ s/\n/\\n/g;
+ $string =~ s/([\x00-\x1f])/\\$UNPRINTABLE[ord($1)]/g;
+ return qq|"$string"|;
+ }
+ if ( $string =~ /(?:^\W|\s|:\z)/ or $QUOTE{$string} ) {
+ return "'$string'";
+ }
+ return $string;
}
sub _write_array {
- my ($self, $array, $indent, $seen) = @_;
- if ( $seen->{refaddr($array)}++ ) {
- die "CPAN::Meta::YAML does not support circular references";
- }
- my @lines = ();
- foreach my $el ( @$array ) {
- my $line = (' ' x $indent) . '-';
- my $type = ref $el;
- if ( ! $type ) {
- $line .= ' ' . $self->_write_scalar( $el, $indent + 1 );
- push @lines, $line;
-
- } elsif ( $type eq 'ARRAY' ) {
- if ( @$el ) {
- push @lines, $line;
- push @lines, $self->_write_array( $el, $indent + 1, $seen );
- } else {
- $line .= ' []';
- push @lines, $line;
- }
-
- } elsif ( $type eq 'HASH' ) {
- if ( keys %$el ) {
- push @lines, $line;
- push @lines, $self->_write_hash( $el, $indent + 1, $seen );
- } else {
- $line .= ' {}';
- push @lines, $line;
- }
-
- } else {
- die "CPAN::Meta::YAML does not support $type references";
- }
- }
-
- @lines;
+ my ($self, $array, $indent, $seen) = @_;
+ if ( $seen->{refaddr($array)}++ ) {
+ die "CPAN::Meta::YAML does not support circular references";
+ }
+ my @lines = ();
+ foreach my $el ( @$array ) {
+ my $line = (' ' x $indent) . '-';
+ my $type = ref $el;
+ if ( ! $type ) {
+ $line .= ' ' . $self->_write_scalar( $el, $indent + 1 );
+ push @lines, $line;
+
+ } elsif ( $type eq 'ARRAY' ) {
+ if ( @$el ) {
+ push @lines, $line;
+ push @lines, $self->_write_array( $el, $indent + 1, $seen );
+ } else {
+ $line .= ' []';
+ push @lines, $line;
+ }
+
+ } elsif ( $type eq 'HASH' ) {
+ if ( keys %$el ) {
+ push @lines, $line;
+ push @lines, $self->_write_hash( $el, $indent + 1, $seen );
+ } else {
+ $line .= ' {}';
+ push @lines, $line;
+ }
+
+ } else {
+ die "CPAN::Meta::YAML does not support $type references";
+ }
+ }
+
+ @lines;
}
sub _write_hash {
- my ($self, $hash, $indent, $seen) = @_;
- if ( $seen->{refaddr($hash)}++ ) {
- die "CPAN::Meta::YAML does not support circular references";
- }
- my @lines = ();
- foreach my $name ( sort keys %$hash ) {
- my $el = $hash->{$name};
- my $line = (' ' x $indent) . "$name:";
- my $type = ref $el;
- if ( ! $type ) {
- $line .= ' ' . $self->_write_scalar( $el, $indent + 1 );
- push @lines, $line;
-
- } elsif ( $type eq 'ARRAY' ) {
- if ( @$el ) {
- push @lines, $line;
- push @lines, $self->_write_array( $el, $indent + 1, $seen );
- } else {
- $line .= ' []';
- push @lines, $line;
- }
-
- } elsif ( $type eq 'HASH' ) {
- if ( keys %$el ) {
- push @lines, $line;
- push @lines, $self->_write_hash( $el, $indent + 1, $seen );
- } else {
- $line .= ' {}';
- push @lines, $line;
- }
-
- } else {
- die "CPAN::Meta::YAML does not support $type references";
- }
- }
-
- @lines;
+ my ($self, $hash, $indent, $seen) = @_;
+ if ( $seen->{refaddr($hash)}++ ) {
+ die "CPAN::Meta::YAML does not support circular references";
+ }
+ my @lines = ();
+ foreach my $name ( sort keys %$hash ) {
+ my $el = $hash->{$name};
+ my $line = (' ' x $indent) . "$name:";
+ my $type = ref $el;
+ if ( ! $type ) {
+ $line .= ' ' . $self->_write_scalar( $el, $indent + 1 );
+ push @lines, $line;
+
+ } elsif ( $type eq 'ARRAY' ) {
+ if ( @$el ) {
+ push @lines, $line;
+ push @lines, $self->_write_array( $el, $indent + 1, $seen );
+ } else {
+ $line .= ' []';
+ push @lines, $line;
+ }
+
+ } elsif ( $type eq 'HASH' ) {
+ if ( keys %$el ) {
+ push @lines, $line;
+ push @lines, $self->_write_hash( $el, $indent + 1, $seen );
+ } else {
+ $line .= ' {}';
+ push @lines, $line;
+ }
+
+ } else {
+ die "CPAN::Meta::YAML does not support $type references";
+ }
+ }
+
+ @lines;
}
# Set error
sub _error {
- $CPAN::Meta::YAML::errstr = $_[1];
- undef;
+ $CPAN::Meta::YAML::errstr = $_[1];
+ undef;
}
# Retrieve error
sub errstr {
- $CPAN::Meta::YAML::errstr;
+ $CPAN::Meta::YAML::errstr;
}
# YAML Compatibility
sub Dump {
- CPAN::Meta::YAML->new(@_)->write_string;
+ CPAN::Meta::YAML->new(@_)->write_string;
}
sub Load {
- my $self = CPAN::Meta::YAML->read_string(@_);
- unless ( $self ) {
- Carp::croak("Failed to load YAML document from string");
- }
- if ( wantarray ) {
- return @$self;
- } else {
- # To match YAML.pm, return the last document
- return $self->[-1];
- }
+ my $self = CPAN::Meta::YAML->read_string(@_);
+ unless ( $self ) {
+ Carp::croak("Failed to load YAML document from string");
+ }
+ if ( wantarray ) {
+ return @$self;
+ } else {
+ # To match YAML.pm, return the last document
+ return $self->[-1];
+ }
}
BEGIN {
- *freeze = *Dump;
- *thaw = *Load;
+ *freeze = *Dump;
+ *thaw = *Load;
}
sub DumpFile {
- my $file = shift;
- CPAN::Meta::YAML->new(@_)->write($file);
+ my $file = shift;
+ CPAN::Meta::YAML->new(@_)->write($file);
}
sub LoadFile {
- my $self = CPAN::Meta::YAML->read($_[0]);
- unless ( $self ) {
- Carp::croak("Failed to load YAML document from '" . ($_[0] || '') . "'");
- }
- if ( wantarray ) {
- return @$self;
- } else {
- # Return only the last document to match YAML.pm,
- return $self->[-1];
- }
+ my $self = CPAN::Meta::YAML->read($_[0]);
+ unless ( $self ) {
+ Carp::croak("Failed to load YAML document from '" . ($_[0] || '') . "'");
+ }
+ if ( wantarray ) {
+ return @$self;
+ } else {
+ # Return only the last document to match YAML.pm,
+ return $self->[-1];
+ }
}
# Use Scalar::Util if possible, otherwise emulate it
BEGIN {
- local $@;
- eval {
- require Scalar::Util;
- };
- my $v = eval("$Scalar::Util::VERSION") || 0;
- if ( $@ or $v < 1.18 ) {
- eval <<'END_PERL';
+ local $@;
+ eval {
+ require Scalar::Util;
+ };
+ my $v = eval("$Scalar::Util::VERSION") || 0;
+ if ( $@ or $v < 1.18 ) {
+ eval <<'END_PERL';
# Scalar::Util failed to load or too old
sub refaddr {
- my $pkg = ref($_[0]) or return undef;
- if ( !! UNIVERSAL::can($_[0], 'can') ) {
- bless $_[0], 'Scalar::Util::Fake';
- } else {
- $pkg = undef;
- }
- "$_[0]" =~ /0x(\w+)/;
- my $i = do { local $^W; hex $1 };
- bless $_[0], $pkg if defined $pkg;
- $i;
+ my $pkg = ref($_[0]) or return undef;
+ if ( !! UNIVERSAL::can($_[0], 'can') ) {
+ bless $_[0], 'Scalar::Util::Fake';
+ } else {
+ $pkg = undef;
+ }
+ "$_[0]" =~ /0x(\w+)/;
+ my $i = do { local $^W; hex $1 };
+ bless $_[0], $pkg if defined $pkg;
+ $i;
}
END_PERL
- } else {
- *refaddr = *Scalar::Util::refaddr;
- }
+ } else {
+ *refaddr = *Scalar::Util::refaddr;
+ }
}
1;
-
-
=pod
+=encoding utf-8
+
=head1 NAME
CPAN::Meta::YAML - Read and write a subset of YAML for CPAN Meta files
=head1 VERSION
-version 0.008
+version 0.010
=head1 SYNOPSIS
This module is currently derived from L<YAML::Tiny> by Adam Kennedy. If
there are bugs in how it parses a particular META.yml file, please file
a bug report in the YAML::Tiny bugtracker:
-L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=YAML-Tiny>
+L<https://rt.cpan.org/Public/Dist/Display.html?Name=YAML-Tiny>
=head1 SEE ALSO
=head2 Bugs / Feature Requests
Please report any bugs or feature requests through the issue tracker
-at L<http://rt.cpan.org/Public/Dist/Display.html?Name=CPAN-Meta-YAML>.
+at L<https://github.com/dagolden/CPAN-Meta-YAML/issues>.
You will be notified automatically of any progress on your issue.
=head2 Source Code
This is open source software. The code repository is available for
public review and contribution under the terms of the license.
-L<https://github.com/dagolden/cpan-meta-yaml>
+L<https://github.com/dagolden/CPAN-Meta-YAML>
- git clone https://github.com/dagolden/cpan-meta-yaml.git
+ git clone https://github.com/dagolden/CPAN-Meta-YAML.git
=head1 AUTHORS
=cut
-
__END__
-#!/usr/bin/perl
-
# Load testing for CPAN::Meta::YAML
use strict;
+use warnings;
+
BEGIN {
- $| = 1;
- $^W = 1;
+ $| = 1;
+ $^W = 1;
}
use File::Spec::Functions ':ALL';
-#!/usr/bin/perl
-
# Testing of basic document structures
use strict;
+use warnings;
+
BEGIN {
- $| = 1;
- $^W = 1;
+ $| = 1;
+ $^W = 1;
}
use File::Spec::Functions ':ALL';
# Test a completely empty document
yaml_ok(
- '',
- [ ],
- 'empty',
+ '',
+ [ ],
+ 'empty',
);
# Just a newline
### YAML.pm has a bug where it dies on a single newline
yaml_ok(
- "\n\n",
- [ ],
- 'only_newlines',
+ "\n\n",
+ [ ],
+ 'only_newlines',
);
# Just a comment
yaml_ok(
- "# comment\n",
- [ ],
- 'only_comment',
+ "# comment\n",
+ [ ],
+ 'only_comment',
);
# Empty documents
yaml_ok(
- "---\n",
- [ undef ],
- 'only_header',
- noyamlperl => 1,
+ "---\n",
+ [ undef ],
+ 'only_header',
+ noyamlperl => 1,
);
yaml_ok(
- "---\n---\n",
- [ undef, undef ],
- 'two_header',
- noyamlperl => 1,
+ "---\n---\n",
+ [ undef, undef ],
+ 'two_header',
+ noyamlperl => 1,
);
yaml_ok(
- "--- ~\n",
- [ undef ],
- 'one_undef',
- noyamlperl => 1,
+ "--- ~\n",
+ [ undef ],
+ 'one_undef',
+ noyamlperl => 1,
);
yaml_ok(
- "--- ~\n",
- [ undef ],
- 'one_undef2',
- noyamlperl => 1,
+ "--- ~\n",
+ [ undef ],
+ 'one_undef2',
+ noyamlperl => 1,
);
yaml_ok(
- "--- ~\n---\n",
- [ undef, undef ],
- 'two_undef',
- noyamlperl => 1,
+ "--- ~\n---\n",
+ [ undef, undef ],
+ 'two_undef',
+ noyamlperl => 1,
);
# Just a scalar
yaml_ok(
- "--- foo\n",
- [ 'foo' ],
- 'one_scalar',
+ "--- foo\n",
+ [ 'foo' ],
+ 'one_scalar',
);
yaml_ok(
- "--- foo\n",
- [ 'foo' ],
- 'one_scalar2',
+ "--- foo\n",
+ [ 'foo' ],
+ 'one_scalar2',
);
yaml_ok(
- "--- foo\n--- bar\n",
- [ 'foo', 'bar' ],
- 'two_scalar',
- noyamlperl => 1,
+ "--- foo\n--- bar\n",
+ [ 'foo', 'bar' ],
+ 'two_scalar',
+ noyamlperl => 1,
);
# Simple lists
yaml_ok(
- "---\n- foo\n",
- [ [ 'foo' ] ],
- 'one_list1',
+ "---\n- foo\n",
+ [ [ 'foo' ] ],
+ 'one_list1',
);
yaml_ok(
- "---\n- foo\n- bar\n",
- [ [ 'foo', 'bar' ] ],
- 'one_list2',
+ "---\n- foo\n- bar\n",
+ [ [ 'foo', 'bar' ] ],
+ 'one_list2',
);
yaml_ok(
- "---\n- ~\n- bar\n",
- [ [ undef, 'bar' ] ],
- 'one_listundef',
- noyamlperl => 1,
+ "---\n- ~\n- bar\n",
+ [ [ undef, 'bar' ] ],
+ 'one_listundef',
+ noyamlperl => 1,
);
# Simple hashs
yaml_ok(
- "---\nfoo: bar\n",
- [ { foo => 'bar' } ],
- 'one_hash1',
+ "---\nfoo: bar\n",
+ [ { foo => 'bar' } ],
+ 'one_hash1',
);
yaml_ok(
- "---\nfoo: bar\nthis: ~\n",
- [ { this => undef, foo => 'bar' } ],
- 'one_hash2',
- noyamlperl => 1,
+ "---\nfoo: bar\nthis: ~\n",
+ [ { this => undef, foo => 'bar' } ],
+ 'one_hash2',
+ noyamlperl => 1,
);
# Simple array inside a hash with an undef
yaml_ok(
- <<'END_YAML',
+ <<'END_YAML',
---
foo:
- bar
- ~
- baz
END_YAML
- [ { foo => [ 'bar', undef, 'baz' ] } ],
- 'array_in_hash',
- noyamlperl => 1,
+ [ { foo => [ 'bar', undef, 'baz' ] } ],
+ 'array_in_hash',
+ noyamlperl => 1,
);
# Simple hash inside a hash with an undef
yaml_ok(
- <<'END_YAML',
+ <<'END_YAML',
---
foo: ~
bar:
foo: bar
END_YAML
- [ { foo => undef, bar => { foo => 'bar' } } ],
- 'hash_in_hash',
- noyamlperl => 1,
+ [ { foo => undef, bar => { foo => 'bar' } } ],
+ 'hash_in_hash',
+ noyamlperl => 1,
);
# Mixed hash and scalars inside an array
yaml_ok(
- <<'END_YAML',
+ <<'END_YAML',
---
-
foo: ~
foo: bar
this: that
END_YAML
- [ [
- { foo => undef, this => 'that' },
- 'foo',
- undef,
- { foo => 'bar', this => 'that' },
- ] ],
- 'hash_in_array',
- noyamlperl => 1,
+ [ [
+ { foo => undef, this => 'that' },
+ 'foo',
+ undef,
+ { foo => 'bar', this => 'that' },
+ ] ],
+ 'hash_in_array',
+ noyamlperl => 1,
);
# Simple single quote
yaml_ok(
- "---\n- 'foo'\n",
- [ [ 'foo' ] ],
- 'single_quote1',
+ "---\n- 'foo'\n",
+ [ [ 'foo' ] ],
+ 'single_quote1',
);
yaml_ok(
- "---\n- ' '\n",
- [ [ ' ' ] ],
- 'single_spaces',
+ "---\n- ' '\n",
+ [ [ ' ' ] ],
+ 'single_spaces',
);
yaml_ok(
- "---\n- ''\n",
- [ [ '' ] ],
- 'single_null',
+ "---\n- ''\n",
+ [ [ '' ] ],
+ 'single_null',
);
# Double quotes
yaml_ok(
- "--- \" \"\n",
- [ ' ' ],
- "only_spaces",
- noyamlpm => 1,
- noyamlperl => 1,
+ "--- \" \"\n",
+ [ ' ' ],
+ "only_spaces",
+ noyamlpm => 1,
+ noyamlperl => 1,
);
yaml_ok(
- "--- \" foo\"\n--- \"bar \"\n",
- [ " foo", "bar " ],
- "leading_trailing_spaces",
- noyamlpm => 1,
- noyamlperl => 1,
+ "--- \" foo\"\n--- \"bar \"\n",
+ [ " foo", "bar " ],
+ "leading_trailing_spaces",
+ noyamlpm => 1,
+ noyamlperl => 1,
);
# Implicit document start
yaml_ok(
- "foo: bar\n",
- [ { foo => 'bar' } ],
- 'implicit_hash',
+ "foo: bar\n",
+ [ { foo => 'bar' } ],
+ 'implicit_hash',
);
yaml_ok(
- "- foo\n",
- [ [ 'foo' ] ],
- 'implicit_array',
+ "- foo\n",
+ [ [ 'foo' ] ],
+ 'implicit_array',
);
# Inline nested hash
yaml_ok(
- <<'END_YAML',
+ <<'END_YAML',
---
- ~
- foo: bar
this: that
- baz
END_YAML
- [ [ undef, { foo => 'bar', this => 'that' }, 'baz' ] ],
- 'inline_nested_hash',
- noyamlperl => 1,
+ [ [ undef, { foo => 'bar', this => 'that' }, 'baz' ] ],
+ 'inline_nested_hash',
+ noyamlperl => 1,
);
# Empty comments
yaml_ok(
- "---\n- foo\n#\n- bar\n",
- [ [ 'foo', 'bar' ] ],
- 'empty_comment_in_list',
+ "---\n- foo\n#\n- bar\n",
+ [ [ 'foo', 'bar' ] ],
+ 'empty_comment_in_list',
);
yaml_ok(
- "---\nfoo: bar\n# foo\none: two\n",
- [ { foo => 'bar', one => 'two' } ],
- 'empty_comment_in_hash',
+ "---\nfoo: bar\n# foo\none: two\n",
+ [ { foo => 'bar', one => 'two' } ],
+ 'empty_comment_in_hash',
);
# Complex keys
yaml_ok(
- "---\na b: c d\n",
- [ { 'a b' => 'c d' } ],
- 'key_with_whitespace',
+ "---\na b: c d\n",
+ [ { 'a b' => 'c d' } ],
+ 'key_with_whitespace',
);
-#!/usr/bin/perl
-
# Testing of common META.yml examples
use strict;
+use warnings;
+
BEGIN {
- $| = 1;
- $^W = 1;
+ $| = 1;
+ $^W = 1;
}
use File::Spec::Functions ':ALL';
use t::lib::Test;
use Test::More tests(37, 0, 13);
use CPAN::Meta::YAML qw{
- Load Dump
- LoadFile DumpFile
- freeze thaw
+ Load Dump
+ LoadFile DumpFile
+ freeze thaw
};
# Hash key legally containing a colon
yaml_ok(
- "---\nFoo::Bar: 1\n",
- [ { 'Foo::Bar' => 1 } ],
- 'module_hash_key',
+ "---\nFoo::Bar: 1\n",
+ [ { 'Foo::Bar' => 1 } ],
+ 'module_hash_key',
);
# Hash indented
yaml_ok(
- "---\n"
- . " foo: bar\n",
- [ { foo => "bar" } ],
- 'hash_indented',
+ "---\n"
+ . " foo: bar\n",
+ [ { foo => "bar" } ],
+ 'hash_indented',
);
# Declarative multi-line scalar
yaml_ok(
- "---\n"
- . " foo: >\n"
- . " bar\n"
- . " baz\n",
- [ { foo => "bar baz\n" } ],
- 'simple_multiline',
+ "---\n"
+ . " foo: >\n"
+ . " bar\n"
+ . " baz\n",
+ [ { foo => "bar baz\n" } ],
+ 'simple_multiline',
);
# Piped multi-line scalar
yaml_ok(
- <<'END_YAML',
+ <<'END_YAML',
---
- |
foo
bar
- 1
END_YAML
- [ [ "foo\nbar\n", 1 ] ],
- 'indented',
+ [ [ "foo\nbar\n", 1 ] ],
+ 'indented',
);
# ... with a pointless hyphen
bar
- 1
END_YAML
- [ [ "foo\nbar", 1 ] ],
- 'indented',
+ [ [ "foo\nbar", 1 ] ],
+ 'indented',
);
# Simple inline case (comment variant)
yaml_ok(
- <<'END_YAML',
+ <<'END_YAML',
--- #YAML:1.0
foo: bar
END_YAML
- [ { foo => 'bar' } ],
- 'simple_doctype_comment',
- nosyck => 1,
+ [ { foo => 'bar' } ],
+ 'simple_doctype_comment',
+ nosyck => 1,
);
# Simple inline case (percent variant)
yaml_ok(
- <<'END_YAML',
+ <<'END_YAML',
--- %YAML:1.0
foo: bar
END_YAML
- [ { foo => 'bar' } ],
- 'simple_doctype_percent',
- noyamlpm => 1,
- noxs => 1,
- noyamlperl => 1,
+ [ { foo => 'bar' } ],
+ 'simple_doctype_percent',
+ noyamlpm => 1,
+ noxs => 1,
+ noyamlperl => 1,
);
# Simple header (comment variant)
yaml_ok(
- <<'END_YAML',
+ <<'END_YAML',
%YAML:1.0
---
foo: bar
END_YAML
- [ { foo => 'bar' } ],
- 'predocument_1_0',
- noyamlpm => 1,
- nosyck => 1,
- noxs => 1,
- noyamlperl => 1,
+ [ { foo => 'bar' } ],
+ 'predocument_1_0',
+ noyamlpm => 1,
+ nosyck => 1,
+ noxs => 1,
+ noyamlperl => 1,
);
# Simple inline case (comment variant)
yaml_ok(
- <<'END_YAML',
+ <<'END_YAML',
%YAML 1.1
---
foo: bar
END_YAML
- [ { foo => 'bar' } ],
- 'predocument_1_1',
- noyamlpm => 1,
- nosyck => 1,
- noyamlperl => 1,
+ [ { foo => 'bar' } ],
+ 'predocument_1_1',
+ noyamlpm => 1,
+ nosyck => 1,
+ noyamlperl => 1,
);
# Multiple inline documents (comment variant)
yaml_ok(
- <<'END_YAML',
+ <<'END_YAML',
--- #YAML:1.0
foo: bar
--- #YAML:1.0
--- #YAML:1.0
foo: bar
END_YAML
- [ { foo => 'bar' }, [ 1 ], { foo => 'bar' } ],
- 'multi_doctype_comment',
+ [ { foo => 'bar' }, [ 1 ], { foo => 'bar' } ],
+ 'multi_doctype_comment',
);
# Simple pre-document case (comment variant)
yaml_ok(
- <<'END_YAML',
+ <<'END_YAML',
%YAML 1.1
---
foo: bar
END_YAML
- [ { foo => 'bar' } ],
- 'predocument_percent',
- noyamlpm => 1,
- nosyck => 1,
- noyamlperl => 1,
+ [ { foo => 'bar' } ],
+ 'predocument_percent',
+ noyamlpm => 1,
+ nosyck => 1,
+ noyamlperl => 1,
);
# Simple pre-document case (comment variant)
yaml_ok(
- <<'END_YAML',
+ <<'END_YAML',
#YAML 1.1
---
foo: bar
END_YAML
- [ { foo => 'bar' } ],
- 'predocument_comment',
+ [ { foo => 'bar' } ],
+ 'predocument_comment',
);
# Hitchhiker Scalar
yaml_ok(
- <<'END_YAML',
+ <<'END_YAML',
--- 42
END_YAML
- [ 42 ],
- 'hitchhiker scalar',
- serializes => 1,
+ [ 42 ],
+ 'hitchhiker scalar',
+ serializes => 1,
);
# Null HASH/ARRAY
yaml_ok(
- <<'END_YAML',
+ <<'END_YAML',
---
- foo
- {}
- bar
END_YAML
- [ [ 'foo', {}, 'bar' ] ],
- 'null hash in array',
+ [ [ 'foo', {}, 'bar' ] ],
+ 'null hash in array',
);
yaml_ok(
- <<'END_YAML',
+ <<'END_YAML',
---
- foo
- []
- bar
END_YAML
- [ [ 'foo', [], 'bar' ] ],
- 'null array in array',
+ [ [ 'foo', [], 'bar' ] ],
+ 'null array in array',
);
yaml_ok(
- <<'END_YAML',
+ <<'END_YAML',
---
foo: {}
bar: 1
END_YAML
- [ { foo => {}, bar => 1 } ],
- 'null hash in hash',
+ [ { foo => {}, bar => 1 } ],
+ 'null hash in hash',
);
yaml_ok(
- <<'END_YAML',
+ <<'END_YAML',
---
foo: []
bar: 1
END_YAML
- [ { foo => [], bar => 1 } ],
- 'null array in hash',
+ [ { foo => [], bar => 1 } ],
+ 'null array in hash',
);
# Trailing Whitespace
yaml_ok(
- <<'END_YAML',
+ <<'END_YAML',
---
-abstract: Generate fractal curves
-foo: ~
+abstract: Generate fractal curves
+foo: ~
arr:
- - foo
+ - foo
- ~
- - 'bar'
+ - 'bar'
END_YAML
- [ {
- abstract => 'Generate fractal curves',
- foo => undef,
- arr => [ 'foo', undef, 'bar' ],
- } ],
- 'trailing whitespace',
- noyamlperl => 1,
+ [ {
+ abstract => 'Generate fractal curves',
+ foo => undef,
+ arr => [ 'foo', undef, 'bar' ],
+ } ],
+ 'trailing whitespace',
+ noyamlperl => 1,
);
# Quote vs Hash
yaml_ok(
- <<'END_YAML',
+ <<'END_YAML',
---
author:
- 'mst: Matt S. Trout <mst@shadowcatsystems.co.uk>'
END_YAML
- [ { author => [ 'mst: Matt S. Trout <mst@shadowcatsystems.co.uk>' ] } ],
- 'hash-like quote',
+ [ { author => [ 'mst: Matt S. Trout <mst@shadowcatsystems.co.uk>' ] } ],
+ 'hash-like quote',
);
# Quote and Escaping Idiosyncracies
yaml_ok(
- <<'END_YAML',
+ <<'END_YAML',
---
name1: 'O''Reilly'
name2: 'O''Reilly O''Tool'
name3: 'Double '''' Quote'
END_YAML
- [ {
- name1 => "O'Reilly",
- name2 => "O'Reilly O'Tool",
- name3 => "Double '' Quote",
- } ],
- 'single quote subtleties',
+ [ {
+ name1 => "O'Reilly",
+ name2 => "O'Reilly O'Tool",
+ name3 => "Double '' Quote",
+ } ],
+ 'single quote subtleties',
);
yaml_ok(
- <<'END_YAML',
+ <<'END_YAML',
---
slash1: '\\'
slash2: '\\foo'
slash3: '\\foo\\\\'
END_YAML
- [ {
- slash1 => "\\\\",
- slash2 => "\\\\foo",
- slash3 => "\\\\foo\\\\\\\\",
- } ],
- 'single quote subtleties',
+ [ {
+ slash1 => "\\\\",
+ slash2 => "\\\\foo",
+ slash3 => "\\\\foo\\\\\\\\",
+ } ],
+ 'single quote subtleties',
);
# Empty Values and Premature EOF
yaml_ok(
- <<'END_YAML',
+ <<'END_YAML',
---
foo: 0
requires:
build_requires:
END_YAML
- [ { foo => 0, requires => undef, build_requires => undef } ],
- 'empty hash keys',
- noyamlpm => 1,
- noyamlperl => 1,
+ [ { foo => 0, requires => undef, build_requires => undef } ],
+ 'empty hash keys',
+ noyamlpm => 1,
+ noyamlperl => 1,
);
yaml_ok(
- <<'END_YAML',
+ <<'END_YAML',
---
- foo
-
-
END_YAML
- [ [ 'foo', undef, undef ] ],
- 'empty array keys',
- noyamlpm => 1,
- noyamlperl => 1,
+ [ [ 'foo', undef, undef ] ],
+ 'empty array keys',
+ noyamlpm => 1,
+ noyamlperl => 1,
);
# Comment on the Document Line
yaml_ok(
- <<'END_YAML',
+ <<'END_YAML',
--- # Comment
foo: bar
END_YAML
- [ { foo => 'bar' } ],
- 'comment header',
- noyamlpm => 1,
- noyamlperl => 1,
+ [ { foo => 'bar' } ],
+ 'comment header',
+ noyamlpm => 1,
+ noyamlperl => 1,
);
# Newlines and tabs
yaml_ok(
- <<'END_YAML',
+ <<'END_YAML',
foo: "foo\\\n\tbar"
END_YAML
- [ { foo => "foo\\\n\tbar" } ],
- 'special characters',
+ [ { foo => "foo\\\n\tbar" } ],
+ 'special characters',
);
# Circular Reference Protection
SCOPE: {
- my $foo = { a => 'b' };
- my $bar = [ $foo, 2 ];
- $foo->{c} = $bar;
- my $circ = CPAN::Meta::YAML->new( [ $foo, $bar ] );
- isa_ok( $circ, 'CPAN::Meta::YAML' );
-
- # When we try to serialize, it should NOT infinite loop
- my $string = undef;
- $string = eval { $circ->write_string; };
- is( $string, undef, '->write_string does not return a value' );
- ok( $@, 'Error string is defined' );
- ok(
- $@ =~ /does not support circular references/,
- 'Got the expected error message',
- );
-}
+ my $foo = { a => 'b' };
+ my $bar = [ $foo, 2 ];
+ $foo->{c} = $bar;
+ my $circ = CPAN::Meta::YAML->new( [ $foo, $bar ] );
+ isa_ok( $circ, 'CPAN::Meta::YAML' );
+
+ # When we try to serialize, it should NOT infinite loop
+ my $string = undef;
+ $string = eval { $circ->write_string; };
+ is( $string, undef, '->write_string does not return a value' );
+ ok( $@, 'Error string is defined' );
+ ok(
+ $@ =~ /does not support circular references/,
+ 'Got the expected error message',
+ );
+}
# Confirm we can read the synopsis
yaml_ok(
- <<'END_YAML',
+ <<'END_YAML',
---
rootproperty: blah
section:
Foo: Bar
empty: ~
END_YAML
- [ {
- rootproperty => 'blah',
- section => {
- one => 'two',
- three => 'four',
- Foo => 'Bar',
- empty => undef,
- },
- } ],
- 'synopsis',
- noyamlperl => 1,
+ [ {
+ rootproperty => 'blah',
+ section => {
+ one => 'two',
+ three => 'four',
+ Foo => 'Bar',
+ empty => undef,
+ },
+ } ],
+ 'synopsis',
+ noyamlperl => 1,
);
# Empty Quote Line
yaml_ok(
- <<'END_YAML',
+ <<'END_YAML',
---
- foo
#
- bar
END_YAML
- [ [ "foo", "bar" ] ],
+ [ [ "foo", "bar" ] ],
);
# Indentation after empty hash value
yaml_ok(
- <<'END_YAML',
+ <<'END_YAML',
---
Test:
optmods:
name: 'test profile'
note: 'note this test profile'
END_YAML
- [ {
- Test => {
- optmods => {
- Bad => 0,
- Foo => 1,
- Long => 0,
- },
- version => 5,
- },
- Test_IncludeA => {
- optmods => undef,
- },
- Test_IncludeB => {
- optmods => undef,
- },
- _meta => {
- name => 'test profile',
- note => 'note this test profile',
- },
- } ],
- 'Indentation after empty hash value',
- noyamlperl => 1,
+ [ {
+ Test => {
+ optmods => {
+ Bad => 0,
+ Foo => 1,
+ Long => 0,
+ },
+ version => 5,
+ },
+ Test_IncludeA => {
+ optmods => undef,
+ },
+ Test_IncludeB => {
+ optmods => undef,
+ },
+ _meta => {
+ name => 'test profile',
+ note => 'note this test profile',
+ },
+ } ],
+ 'Indentation after empty hash value',
+ noyamlperl => 1,
);
# Spaces in the Key
yaml_ok(
- <<'END_YAML',
+ <<'END_YAML',
---
the key: the value
END_YAML
- [ { 'the key' => 'the value' } ],
+ [ { 'the key' => 'the value' } ],
);
# Tests a particular pathological case
yaml_ok(
- <<'END_YAML',
+ <<'END_YAML',
---
- value
- '><'
END_YAML
- [ [ 'value', '><' ] ],
- 'Pathological >< case',
+ [ [ 'value', '><' ] ],
+ 'Pathological >< case',
);
# Special Characters
#yaml_ok(
-# <<'END_YAML',
+# <<'END_YAML',
#---
#- "Ingy d\xC3\xB6t Net"
#END_YAML
-# [ [ "Ingy d\xC3\xB6t Net" ] ],
+# [ [ "Ingy d\xC3\xB6t Net" ] ],
#);
# Non-Indenting Sub-List
yaml_ok(
- <<'END_YAML',
+ <<'END_YAML',
---
foo:
- list
bar: value
END_YAML
- [ { foo => [ 'list' ], bar => 'value' } ],
- 'Non-indenting sub-list',
- noyamlpm => 1,
- noyamlperl => 1,
+ [ { foo => [ 'list' ], bar => 'value' } ],
+ 'Non-indenting sub-list',
+ noyamlpm => 1,
+ noyamlperl => 1,
);
# RT #42119: write of two single quotes
yaml_ok(
- "--- \"A'B'C\"\n",
- [ "A'B'C" ],
- 'Multiple escaping of quote ok',
+ "--- \"A'B'C\"\n",
+ [ "A'B'C" ],
+ 'Multiple escaping of quote ok',
);
# Escapes without whitespace
yaml_ok(
- "--- A\\B\\C\n",
- [ "A\\B\\C" ],
- 'Multiple escaping of escape ok',
+ "--- A\\B\\C\n",
+ [ "A\\B\\C" ],
+ 'Multiple escaping of escape ok',
);
# Escapes with whitespace
yaml_ok(
- "--- 'A\\B \\C'\n",
- [ "A\\B \\C" ],
- 'Multiple escaping of escape with whitespace ok',
+ "--- 'A\\B \\C'\n",
+ [ "A\\B \\C" ],
+ 'Multiple escaping of escape with whitespace ok',
);
# Check illegal characters that are in legal places
yaml_ok(
- "--- 'Wow!'\n",
- [ "Wow!" ],
- 'Bang in a quote',
+ "--- 'Wow!'\n",
+ [ "Wow!" ],
+ 'Bang in a quote',
);
yaml_ok(
- "--- 'This&that'\n",
- [ "This&that" ],
- 'Ampersand in a quote',
+ "--- 'This&that'\n",
+ [ "This&that" ],
+ 'Ampersand in a quote',
);
# Check for unescaped boolean keywords
is_deeply(
- CPAN::Meta::YAML->new( 'True' )->write_string,
- "--- 'True'\n",
- 'Idiomatic trivial boolean string is escaped',
+ CPAN::Meta::YAML->new( 'True' )->write_string,
+ "--- 'True'\n",
+ 'Idiomatic trivial boolean string is escaped',
);
is_deeply( CPAN::Meta::YAML->new( [ qw{
- null Null NULL
- y Y yes Yes YES n N no No NO
- true True TRUE false False FALSE
- on On ON off Off OFF
+ null Null NULL
+ y Y yes Yes YES n N no No NO
+ true True TRUE false False FALSE
+ on On ON off Off OFF
} ] )->write_string, <<'END_YAML' );
---
- 'null'
# Always quote for scalars ending with :
is_deeply(
- CPAN::Meta::YAML->new( [ 'A:' ] )->write_string,
- "---\n- 'A:'\n",
- 'Simple scalar ending in a colon is correctly quoted',
+ CPAN::Meta::YAML->new( [ 'A:' ] )->write_string,
+ "---\n- 'A:'\n",
+ 'Simple scalar ending in a colon is correctly quoted',
);
-#!/usr/bin/perl
-
# Testing of basic document structures
use strict;
+use warnings;
+
BEGIN {
- $| = 1;
- $^W = 1;
+ $| = 1;
+ $^W = 1;
}
use Test::More tests => 6;
-#!/usr/bin/perl
-
# Testing of common META.yml examples
use strict;
+use warnings;
+
BEGIN {
- $| = 1;
- $^W = 1;
+ $| = 1;
+ $^W = 1;
}
use File::Spec::Functions ':ALL';
# Testing CPAN::Meta::YAML's own META.yml file
yaml_ok(
- <<'END_YAML',
+ <<'END_YAML',
abstract: Read/Write YAML files with as little code as possible
author: 'Adam Kennedy <cpan@ali.as>'
build_requires:
perl: 5.005
version: 0.03
END_YAML
- [ {
- abstract => 'Read/Write YAML files with as little code as possible',
- author => 'Adam Kennedy <cpan@ali.as>',
- build_requires => {
- 'File::Spec' => '0.80',
- 'Test::More' => '0.47',
- },
- distribution_type => 'module',
- generated_by => 'Module::Install version 0.63',
- license => 'perl',
- name => 'YAML-Tiny',
- no_index => {
- directory => [ qw{inc t} ],
- },
- requires => {
- perl => '5.005',
- },
- version => '0.03',
- } ],
- 'CPAN::Meta::YAML',
+ [ {
+ abstract => 'Read/Write YAML files with as little code as possible',
+ author => 'Adam Kennedy <cpan@ali.as>',
+ build_requires => {
+ 'File::Spec' => '0.80',
+ 'Test::More' => '0.47',
+ },
+ distribution_type => 'module',
+ generated_by => 'Module::Install version 0.63',
+ license => 'perl',
+ name => 'YAML-Tiny',
+ no_index => {
+ directory => [ qw{inc t} ],
+ },
+ requires => {
+ perl => '5.005',
+ },
+ version => '0.03',
+ } ],
+ 'CPAN::Meta::YAML',
);
# Testing a META.yml from a commercial project that crashed
yaml_ok(
- <<'END_YAML',
+ <<'END_YAML',
# http://module-build.sourceforge.net/META-spec.html
#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
name: ITS-SIN-FIDS-Content-XML
distribution_type: module
generated_by: ExtUtils::MakeMaker version 6.30
END_YAML
- [ {
- name => 'ITS-SIN-FIDS-Content-XML',
- version => "0.01", # this kludge is to prevent floating point comparison errors
- version_from => 'lib/ITS/SIN/FIDS/Content/XML.pm',
- installdirs => 'site',
- requires => {
- 'Test::More' => 0.45,
- 'XML::Simple' => 2,
- },
- distribution_type => 'module',
- generated_by => 'ExtUtils::MakeMaker version 6.30',
- } ],
- 'CPAN::Meta::YAML',
+ [ {
+ name => 'ITS-SIN-FIDS-Content-XML',
+ version => "0.01", # this kludge is to prevent floating point comparison errors
+ version_from => 'lib/ITS/SIN/FIDS/Content/XML.pm',
+ installdirs => 'site',
+ requires => {
+ 'Test::More' => 0.45,
+ 'XML::Simple' => 2,
+ },
+ distribution_type => 'module',
+ generated_by => 'ExtUtils::MakeMaker version 6.30',
+ } ],
+ 'CPAN::Meta::YAML',
);
# Testing various failing META.yml files from CPAN
yaml_ok(
- <<'END_YAML',
+ <<'END_YAML',
---
abstract: Mii in Nintendo Wii data parser and builder
author: Toru Yamaguchi <zigorou@cpan.org>
XML::LibXML: 1.62
version: 0.02
END_YAML
- [ {
- abstract => 'Mii in Nintendo Wii data parser and builder',
- author => 'Toru Yamaguchi <zigorou@cpan.org>',
- distribution_type => 'module',
- generated_by => 'Module::Install version 0.65',
- license => 'perl',
- 'meta-spec' => {
- url => 'http://module-build.sourceforge.net/META-spec-v1.3.html',
- version => '1.3',
- },
- name => 'Games-Nintendo-Wii-Mii',
- no_index => {
- directory => [ qw{ inc t } ],
- },
- requires => {
- 'Carp' => '1.03',
- 'Class::Accessor::Fast' => '0.3',
- 'File::Slurp' => '9999.12',
- 'IO::File' => '1.1',
- 'Readonly' => '0',
- 'Tie::IxHash' => '1.21',
- 'URI' => '1.35',
- 'XML::LibXML' => '1.62',
- },
- version => '0.02',
- } ],
- 'Games-Nintendo-Wii-Mii',
+ [ {
+ abstract => 'Mii in Nintendo Wii data parser and builder',
+ author => 'Toru Yamaguchi <zigorou@cpan.org>',
+ distribution_type => 'module',
+ generated_by => 'Module::Install version 0.65',
+ license => 'perl',
+ 'meta-spec' => {
+ url => 'http://module-build.sourceforge.net/META-spec-v1.3.html',
+ version => '1.3',
+ },
+ name => 'Games-Nintendo-Wii-Mii',
+ no_index => {
+ directory => [ qw{ inc t } ],
+ },
+ requires => {
+ 'Carp' => '1.03',
+ 'Class::Accessor::Fast' => '0.3',
+ 'File::Slurp' => '9999.12',
+ 'IO::File' => '1.1',
+ 'Readonly' => '0',
+ 'Tie::IxHash' => '1.21',
+ 'URI' => '1.35',
+ 'XML::LibXML' => '1.62',
+ },
+ version => '0.02',
+ } ],
+ 'Games-Nintendo-Wii-Mii',
);
yaml_ok(
- <<'END_YAML',
+ <<'END_YAML',
# http://module-build.sourceforge.net/META-spec.html
#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
name: Acme-Time-Baby
distribution_type: module
generated_by: ExtUtils::MakeMaker version 6.17
END_YAML
- [ {
- name => 'Acme-Time-Baby',
- version => '2.106',
- version_from => 'Baby.pm',
- installdirs => 'site',
- requires => {
- warnings => undef,
- },
- distribution_type => 'module',
- generated_by => 'ExtUtils::MakeMaker version 6.17',
- } ],
- 'Acme-Time-Baby',
- noyamlperl => 1,
+ [ {
+ name => 'Acme-Time-Baby',
+ version => '2.106',
+ version_from => 'Baby.pm',
+ installdirs => 'site',
+ requires => {
+ warnings => undef,
+ },
+ distribution_type => 'module',
+ generated_by => 'ExtUtils::MakeMaker version 6.17',
+ } ],
+ 'Acme-Time-Baby',
+ noyamlperl => 1,
);
# File with a YAML header
yaml_ok(
- <<'END_YAML',
+ <<'END_YAML',
--- #YAML:1.0
name: Data-Swap
version: 0.05
perl: 5.6.0
dynamic_config: 0
END_YAML
- [ {
- name => 'Data-Swap',
- version => '0.05',
- license => 'perl',
- distribution_type => 'module',
- requires => {
- perl => '5.6.0',
- },
- dynamic_config => '0',
- } ],
- 'Data-Swap',
- nosyck => 1,
+ [ {
+ name => 'Data-Swap',
+ version => '0.05',
+ license => 'perl',
+ distribution_type => 'module',
+ requires => {
+ perl => '5.6.0',
+ },
+ dynamic_config => '0',
+ } ],
+ 'Data-Swap',
+ nosyck => 1,
);
# Various files that fail for unknown reasons
SCOPE: {
- my $content = load_ok(
- 'Template-Provider-Unicode-Japanese.yml',
- catfile( test_data_directory(), 'Template-Provider-Unicode-Japanese.yml' ),
- 100
- );
- yaml_ok(
- $content,
- [ {
- abstract => 'Decode all templates by Unicode::Japanese',
- author => 'Hironori Yoshida C<< <yoshida@cpan.org> >>',
- distribution_type => 'module',
- generated_by => 'Module::Install version 0.65',
- license => 'perl',
- 'meta-spec' => {
- url => 'http://module-build.sourceforge.net/META-spec-v1.3.html',
- version => '1.3',
- },
- name => 'Template-Provider-Unicode-Japanese',
- no_index => {
- directory => [ qw{ inc t } ],
- },
- requires => {
- 'Template::Config' => 0,
- 'Unicode::Japanese' => 0,
- perl => '5.6.0',
- version => '0',
- },
- version => '1.2.1',
- } ],
- 'Template-Provider-Unicode-Japanese',
- noyamlperl => 1,
- );
+ my $content = load_ok(
+ 'Template-Provider-Unicode-Japanese.yml',
+ catfile( test_data_directory(), 'Template-Provider-Unicode-Japanese.yml' ),
+ 100
+ );
+ yaml_ok(
+ $content,
+ [ {
+ abstract => 'Decode all templates by Unicode::Japanese',
+ author => 'Hironori Yoshida C<< <yoshida@cpan.org> >>',
+ distribution_type => 'module',
+ generated_by => 'Module::Install version 0.65',
+ license => 'perl',
+ 'meta-spec' => {
+ url => 'http://module-build.sourceforge.net/META-spec-v1.3.html',
+ version => '1.3',
+ },
+ name => 'Template-Provider-Unicode-Japanese',
+ no_index => {
+ directory => [ qw{ inc t } ],
+ },
+ requires => {
+ 'Template::Config' => 0,
+ 'Unicode::Japanese' => 0,
+ perl => '5.6.0',
+ version => '0',
+ },
+ version => '1.2.1',
+ } ],
+ 'Template-Provider-Unicode-Japanese',
+ noyamlperl => 1,
+ );
}
SCOPE: {
- my $content = load_ok(
- 'HTML-WebDAO.yml',
- catfile( test_data_directory(), 'HTML-WebDAO.yml' ),
- 100
- );
- yaml_ok(
- $content,
- [ {
- abstract => 'Perl extension for create complex web application',
- author => [
- 'Zahatski Aliaksandr, E<lt>zagap@users.sourceforge.netE<gt>',
- ],
- license => 'perl',
- name => 'HTML-WebDAO',
- version => '0.04',
- } ],
- 'HTML-WebDAO',
- nosyck => 1,
- );
+ my $content = load_ok(
+ 'HTML-WebDAO.yml',
+ catfile( test_data_directory(), 'HTML-WebDAO.yml' ),
+ 100
+ );
+ yaml_ok(
+ $content,
+ [ {
+ abstract => 'Perl extension for create complex web application',
+ author => [
+ 'Zahatski Aliaksandr, E<lt>zagap@users.sourceforge.netE<gt>',
+ ],
+ license => 'perl',
+ name => 'HTML-WebDAO',
+ version => '0.04',
+ } ],
+ 'HTML-WebDAO',
+ nosyck => 1,
+ );
}
SCOPE: {
- my $content = load_ok(
- 'Spreadsheet-Read.yml',
- catfile( test_data_directory(), 'Spreadsheet-Read.yml' ),
- 100
- );
- yaml_ok(
- $content,
- [ {
- 'resources' => {
- 'license' => 'http://dev.perl.org/licenses/'
- },
- 'meta-spec' => {
- 'version' => '1.4',
- 'url' => 'http://module-build.sourceforge.net/META-spec-v1.4.html'
- },
- 'distribution_type' => 'module',
- 'generated_by' => 'Author',
- 'version' => 'VERSION',
- 'name' => 'Read',
- 'author' => [
- 'H.Merijn Brand <h.m.brand@xs4all.nl>'
- ],
- 'license' => 'perl',
- 'build_requires' => {
- 'Test::More' => '0',
- 'Test::Harness' => '0',
- 'perl' => '5.006'
- },
- 'provides' => {
- 'Spreadsheet::Read' => {
- 'version' => 'VERSION',
- 'file' => 'Read.pm'
- }
- },
- 'optional_features' => [
- {
- 'opt_csv' => {
- 'requires' => {
- 'Text::CSV_XS' => '0.23'
- },
- 'recommends' => {
- 'Text::CSV_PP' => '1.10',
- 'Text::CSV_XS' => '0.58',
- 'Text::CSV' => '1.10'
- },
- 'description' => 'Provides parsing of CSV streams'
- }
- },
- {
- 'opt_excel' => {
- 'requires' => {
- 'Spreadsheet::ParseExcel' => '0.26',
- 'Spreadsheet::ParseExcel::FmtDefault' => '0'
- },
- 'recommends' => {
- 'Spreadsheet::ParseExcel' => '0.42'
- },
- 'description' => 'Provides parsing of Microsoft Excel files'
- }
- },
- {
- 'opt_excelx' => {
- 'requires' => {
- 'Spreadsheet::XLSX' => '0.07'
- },
- 'description' => 'Provides parsing of Microsoft Excel 2007 files'
- }
- },
- {
- 'opt_oo' => {
- 'requires' => {
- 'Spreadsheet::ReadSXC' => '0.2'
- },
- 'description' => 'Provides parsing of OpenOffice spreadsheets'
- }
- },
- {
- 'opt_tools' => {
- 'recommends' => {
- 'Tk::TableMatrix::Spreadsheet' => '0',
- 'Tk::NoteBook' => '0',
- 'Tk' => '0'
- },
- 'description' => 'Spreadsheet tools'
- }
- }
- ],
- 'requires' => {
- 'perl' => '5.006',
- 'Data::Dumper' => '0',
- 'Exporter' => '0',
- 'Carp' => '0'
- },
- 'recommends' => {
- 'perl' => '5.008005',
- 'IO::Scalar' => '0',
- 'File::Temp' => '0.14'
- },
- 'abstract' => 'Meta-Wrapper for reading spreadsheet data'
- } ],
- 'Spreadsheet-Read',
- noyamlpm => 1,
- noyamlperl => 1,
- );
+ my $content = load_ok(
+ 'Spreadsheet-Read.yml',
+ catfile( test_data_directory(), 'Spreadsheet-Read.yml' ),
+ 100
+ );
+ yaml_ok(
+ $content,
+ [ {
+ 'resources' => {
+ 'license' => 'http://dev.perl.org/licenses/'
+ },
+ 'meta-spec' => {
+ 'version' => '1.4',
+ 'url' => 'http://module-build.sourceforge.net/META-spec-v1.4.html'
+ },
+ 'distribution_type' => 'module',
+ 'generated_by' => 'Author',
+ 'version' => 'VERSION',
+ 'name' => 'Read',
+ 'author' => [
+ 'H.Merijn Brand <h.m.brand@xs4all.nl>'
+ ],
+ 'license' => 'perl',
+ 'build_requires' => {
+ 'Test::More' => '0',
+ 'Test::Harness' => '0',
+ 'perl' => '5.006'
+ },
+ 'provides' => {
+ 'Spreadsheet::Read' => {
+ 'version' => 'VERSION',
+ 'file' => 'Read.pm'
+ }
+ },
+ 'optional_features' => [
+ {
+ 'opt_csv' => {
+ 'requires' => {
+ 'Text::CSV_XS' => '0.23'
+ },
+ 'recommends' => {
+ 'Text::CSV_PP' => '1.10',
+ 'Text::CSV_XS' => '0.58',
+ 'Text::CSV' => '1.10'
+ },
+ 'description' => 'Provides parsing of CSV streams'
+ }
+ },
+ {
+ 'opt_excel' => {
+ 'requires' => {
+ 'Spreadsheet::ParseExcel' => '0.26',
+ 'Spreadsheet::ParseExcel::FmtDefault' => '0'
+ },
+ 'recommends' => {
+ 'Spreadsheet::ParseExcel' => '0.42'
+ },
+ 'description' => 'Provides parsing of Microsoft Excel files'
+ }
+ },
+ {
+ 'opt_excelx' => {
+ 'requires' => {
+ 'Spreadsheet::XLSX' => '0.07'
+ },
+ 'description' => 'Provides parsing of Microsoft Excel 2007 files'
+ }
+ },
+ {
+ 'opt_oo' => {
+ 'requires' => {
+ 'Spreadsheet::ReadSXC' => '0.2'
+ },
+ 'description' => 'Provides parsing of OpenOffice spreadsheets'
+ }
+ },
+ {
+ 'opt_tools' => {
+ 'recommends' => {
+ 'Tk::TableMatrix::Spreadsheet' => '0',
+ 'Tk::NoteBook' => '0',
+ 'Tk' => '0'
+ },
+ 'description' => 'Spreadsheet tools'
+ }
+ }
+ ],
+ 'requires' => {
+ 'perl' => '5.006',
+ 'Data::Dumper' => '0',
+ 'Exporter' => '0',
+ 'Carp' => '0'
+ },
+ 'recommends' => {
+ 'perl' => '5.008005',
+ 'IO::Scalar' => '0',
+ 'File::Temp' => '0.14'
+ },
+ 'abstract' => 'Meta-Wrapper for reading spreadsheet data'
+ } ],
+ 'Spreadsheet-Read',
+ noyamlpm => 1,
+ noyamlperl => 1,
+ );
}
-#!/usr/bin/perl
-
# Testing Plagger config samples from Miyagawa-san's YAPC::NA 2006 talk
use strict;
+use warnings;
+
BEGIN {
- $| = 1;
- $^W = 1;
+ $| = 1;
+ $^W = 1;
}
use File::Spec::Functions ':ALL';
# Example Plagger Configuration 1
yaml_ok(
- <<'END_YAML',
+ <<'END_YAML',
plugins:
- module: Subscription::Bloglines
config:
via: smtp
host: smtp.example.com
END_YAML
- [ { plugins => [
- {
- module => 'Subscription::Bloglines',
- config => {
- username => 'you@example.pl',
- password => 'foobar',
- mark_read => 1,
- },
- },
- {
- module => 'Publish::Gmail',
- config => {
- mailto => 'example@gmail.com',
- mailfrom => 'miyagawa@example.com',
- mailroute => {
- via => 'smtp',
- host => 'smtp.example.com',
- },
- },
- },
- ] } ],
- 'Plagger',
+ [ { plugins => [
+ {
+ module => 'Subscription::Bloglines',
+ config => {
+ username => 'you@example.pl',
+ password => 'foobar',
+ mark_read => 1,
+ },
+ },
+ {
+ module => 'Publish::Gmail',
+ config => {
+ mailto => 'example@gmail.com',
+ mailfrom => 'miyagawa@example.com',
+ mailroute => {
+ via => 'smtp',
+ host => 'smtp.example.com',
+ },
+ },
+ },
+ ] } ],
+ 'Plagger',
);
# Example Plagger Configuration 2
yaml_ok(
- <<'END_YAML',
+ <<'END_YAML',
plugins:
- module: Subscription::Config
config:
- '#plagger-ja'
- '#plagger'
-
+
END_YAML
- [ { plugins => [ {
- module => 'Subscription::Config',
- config => {
- feed => [ 'http://plagger.org/.../rss' ],
- },
- }, {
- module => 'Filter::Rule',
- rule => {
- module => 'Fresh',
- mtime => {
- path => '/tmp/rssbot.time',
- autoupdate => 1,
- },
- },
- }, {
- module => 'Notify::IRC',
- config => {
- daemon_port => 9999,
- nickname => 'plaggerbot',
- server_host => 'chat.freenode.net',
- server_channels => [
- '#plagger-ja',
- '#plagger',
- ],
- },
- } ] } ],
- 'plagger2',
-);
+ [ { plugins => [ {
+ module => 'Subscription::Config',
+ config => {
+ feed => [ 'http://plagger.org/.../rss' ],
+ },
+ }, {
+ module => 'Filter::Rule',
+ rule => {
+ module => 'Fresh',
+ mtime => {
+ path => '/tmp/rssbot.time',
+ autoupdate => 1,
+ },
+ },
+ }, {
+ module => 'Notify::IRC',
+ config => {
+ daemon_port => 9999,
+ nickname => 'plaggerbot',
+ server_host => 'chat.freenode.net',
+ server_channels => [
+ '#plagger-ja',
+ '#plagger',
+ ],
+ },
+ } ] } ],
+ 'plagger2',
+);
-#!/usr/bin/perl
-
# Testing of common META.yml examples
use strict;
+use warnings;
+
BEGIN {
- $| = 1;
- $^W = 1;
+ $| = 1;
+ $^W = 1;
}
use File::Spec::Functions ':ALL';
my $vanilla = load_ok( 'yanilla.yml', $vanilla_file, 1000 );
yaml_ok(
- $vanilla,
- [ {
- package_name => 'VanillaPerl',
- package_version => 5,
- download_dir => 'c:\temp\vp_sources',
- build_dir => 'c:\temp\vp_build',
- image_dir => 'c:\vanilla-perl',
- binary => [
- {
- name => 'dmake',
- url => 'http://search.cpan.org/CPAN/authors/id/S/SH/SHAY/dmake-4.5-20060619-SHAY.zip',
- license => {
- 'dmake/COPYING' => 'dmake/COPYING',
- 'dmake/readme/license.txt' => 'dmake/license.txt',
- },
- install_to => {
- 'dmake/dmake.exe' => 'dmake/bin/dmake.exe',
- 'dmake/startup' => 'dmake/bin/startup',
- },
- },
- {
- name => 'gcc-core',
- url => 'http://umn.dl.sourceforge.net/mingw/gcc-core-3.4.5-20060117-1.tar.gz',
- license => {
- 'COPYING' => 'gcc/COPYING',
- 'COPYING.lib' => 'gcc/COPYING.lib',
- },
- install_to => 'mingw',
- },
- {
- name => 'gcc-g++',
- url => 'http://umn.dl.sourceforge.net/mingw/gcc-g++-3.4.5-20060117-1.tar.gz',
- license => undef,
- install_to => 'mingw',
- },
- {
- name => 'binutils',
- url => 'http://umn.dl.sourceforge.net/mingw/binutils-2.16.91-20060119-1.tar.gz',
- license => {
- 'Copying' => 'binutils/Copying',
- 'Copying.lib' => 'binutils/Copying.lib',
- },
- install_to => 'mingw',
- },
- {
- name => 'mingw-runtime',
- url => 'http://umn.dl.sourceforge.net/mingw/mingw-runtime-3.10.tar.gz',
- license => {
- 'doc/mingw-runtime/Contributors' => 'mingw/Contributors',
- 'doc/mingw-runtime/Disclaimer' => 'mingw/Disclaimer',
- },
- install_to => 'mingw',
- },
- {
- name => 'w32api',
- url => 'http://umn.dl.sourceforge.net/mingw/w32api-3.6.tar.gz',
- license => undef,
- install_to => 'mingw',
- extra => {
- 'extra\README.w32api' => 'licenses\win32api\README.w32api',
- },
- }
- ],
- source => [
- {
- name => 'perl',
- url => 'http://mirrors.kernel.org/CPAN/src/perl-5.8.8.tar.gz',
- license => {
- 'perl-5.8.8/Readme' => 'perl/Readme',
- 'perl-5.8.8/Artistic' => 'perl/Artistic',
- 'perl-5.8.8/Copying' => 'perl/Copying',
- },
- unpack_to => 'perl',
- install_to => 'perl',
- after => {
- 'extra\Config.pm' => 'lib\CPAN\Config.pm',
- },
- }
- ],
- modules => [
- {
- name => 'Win32::Job',
- unpack_to => {
- APIFile => 'Win32API-File',
- },
- },
- {
- name => 'IO',
- force => 1,
- },
- {
- name => 'Compress::Zlib',
- },
- {
- name => 'IO::Zlib',
- },
- {
- name => 'Archive::Tar',
- },
- {
- name => 'Net::FTP',
- extra => {
- 'extra\libnet.cfg' => 'libnet.cfg',
- },
- },
- ],
- extra => {
- 'README' => 'README.txt',
- 'LICENSE.txt' => 'LICENSE.txt',
- 'Changes' => 'Release-Notes.txt',
- 'extra\Config.pm' => 'perl\lib\CPAN\Config.pm',
- 'extra\links\Perl-Documentation.url' => 'links\Perl Documentation.url',
- 'extra\links\Perl-Homepage.url' => 'links\Perl Homepage.url',
- 'extra\links\Perl-Mailing-Lists.url' => 'links\Perl Mailing Lists.url',
- 'extra\links\Perlmonks-Community-Forum.url' => 'links\Perlmonks Community Forum.url',
- 'extra\links\Search-CPAN-Modules.url' => 'links\Search CPAN Modules.url',
- 'extra\links\Vanilla-Perl-Homepage.url' => 'links\Vanilla Perl Homepage.url',
- },
- } ],
- 'vanilla.yml',
- nosyck => 1,
- noyamlperl => 1,
+ $vanilla,
+ [ {
+ package_name => 'VanillaPerl',
+ package_version => 5,
+ download_dir => 'c:\temp\vp_sources',
+ build_dir => 'c:\temp\vp_build',
+ image_dir => 'c:\vanilla-perl',
+ binary => [
+ {
+ name => 'dmake',
+ url => 'http://search.cpan.org/CPAN/authors/id/S/SH/SHAY/dmake-4.5-20060619-SHAY.zip',
+ license => {
+ 'dmake/COPYING' => 'dmake/COPYING',
+ 'dmake/readme/license.txt' => 'dmake/license.txt',
+ },
+ install_to => {
+ 'dmake/dmake.exe' => 'dmake/bin/dmake.exe',
+ 'dmake/startup' => 'dmake/bin/startup',
+ },
+ },
+ {
+ name => 'gcc-core',
+ url => 'http://umn.dl.sourceforge.net/mingw/gcc-core-3.4.5-20060117-1.tar.gz',
+ license => {
+ 'COPYING' => 'gcc/COPYING',
+ 'COPYING.lib' => 'gcc/COPYING.lib',
+ },
+ install_to => 'mingw',
+ },
+ {
+ name => 'gcc-g++',
+ url => 'http://umn.dl.sourceforge.net/mingw/gcc-g++-3.4.5-20060117-1.tar.gz',
+ license => undef,
+ install_to => 'mingw',
+ },
+ {
+ name => 'binutils',
+ url => 'http://umn.dl.sourceforge.net/mingw/binutils-2.16.91-20060119-1.tar.gz',
+ license => {
+ 'Copying' => 'binutils/Copying',
+ 'Copying.lib' => 'binutils/Copying.lib',
+ },
+ install_to => 'mingw',
+ },
+ {
+ name => 'mingw-runtime',
+ url => 'http://umn.dl.sourceforge.net/mingw/mingw-runtime-3.10.tar.gz',
+ license => {
+ 'doc/mingw-runtime/Contributors' => 'mingw/Contributors',
+ 'doc/mingw-runtime/Disclaimer' => 'mingw/Disclaimer',
+ },
+ install_to => 'mingw',
+ },
+ {
+ name => 'w32api',
+ url => 'http://umn.dl.sourceforge.net/mingw/w32api-3.6.tar.gz',
+ license => undef,
+ install_to => 'mingw',
+ extra => {
+ 'extra\README.w32api' => 'licenses\win32api\README.w32api',
+ },
+ }
+ ],
+ source => [
+ {
+ name => 'perl',
+ url => 'http://mirrors.kernel.org/CPAN/src/perl-5.8.8.tar.gz',
+ license => {
+ 'perl-5.8.8/Readme' => 'perl/Readme',
+ 'perl-5.8.8/Artistic' => 'perl/Artistic',
+ 'perl-5.8.8/Copying' => 'perl/Copying',
+ },
+ unpack_to => 'perl',
+ install_to => 'perl',
+ after => {
+ 'extra\Config.pm' => 'lib\CPAN\Config.pm',
+ },
+ }
+ ],
+ modules => [
+ {
+ name => 'Win32::Job',
+ unpack_to => {
+ APIFile => 'Win32API-File',
+ },
+ },
+ {
+ name => 'IO',
+ force => 1,
+ },
+ {
+ name => 'Compress::Zlib',
+ },
+ {
+ name => 'IO::Zlib',
+ },
+ {
+ name => 'Archive::Tar',
+ },
+ {
+ name => 'Net::FTP',
+ extra => {
+ 'extra\libnet.cfg' => 'libnet.cfg',
+ },
+ },
+ ],
+ extra => {
+ 'README' => 'README.txt',
+ 'LICENSE.txt' => 'LICENSE.txt',
+ 'Changes' => 'Release-Notes.txt',
+ 'extra\Config.pm' => 'perl\lib\CPAN\Config.pm',
+ 'extra\links\Perl-Documentation.url' => 'links\Perl Documentation.url',
+ 'extra\links\Perl-Homepage.url' => 'links\Perl Homepage.url',
+ 'extra\links\Perl-Mailing-Lists.url' => 'links\Perl Mailing Lists.url',
+ 'extra\links\Perlmonks-Community-Forum.url' => 'links\Perlmonks Community Forum.url',
+ 'extra\links\Search-CPAN-Modules.url' => 'links\Search CPAN Modules.url',
+ 'extra\links\Vanilla-Perl-Homepage.url' => 'links\Vanilla Perl Homepage.url',
+ },
+ } ],
+ 'vanilla.yml',
+ nosyck => 1,
+ noyamlperl => 1,
);
-#!/usr/bin/perl
-
# Testing of common META.yml examples
use strict;
+use warnings;
+
BEGIN {
- $| = 1;
- $^W = 1;
+ $| = 1;
+ $^W = 1;
}
use File::Spec::Functions ':ALL';
my $sample = load_ok( 'sample.yml', $sample_file, 500 );
yaml_ok(
- $sample,
- [ {
- invoice => 34843,
- date => '2001-01-23',
- 'bill-to' => {
- given => 'Chris',
- family => 'Dumars',
- address => {
- lines => "458 Walkman Dr.\nSuite #292\n",
- city => 'Royal Oak',
- state => 'MI',
- postal => 48046,
- },
- },
- product => [
- {
- sku => 'BL394D',
- quantity => '4',
- description => 'Basketball',
- price => '450.00',
- },
- {
- sku => 'BL4438H',
- quantity => '1',
- description => 'Super Hoop',
- price => '2392.00',
- },
- ],
- tax => '251.42',
- total => '4443.52',
- comments => <<'END_TEXT',
+ $sample,
+ [ {
+ invoice => 34843,
+ date => '2001-01-23',
+ 'bill-to' => {
+ given => 'Chris',
+ family => 'Dumars',
+ address => {
+ lines => "458 Walkman Dr.\nSuite #292\n",
+ city => 'Royal Oak',
+ state => 'MI',
+ postal => 48046,
+ },
+ },
+ product => [
+ {
+ sku => 'BL394D',
+ quantity => '4',
+ description => 'Basketball',
+ price => '450.00',
+ },
+ {
+ sku => 'BL4438H',
+ quantity => '1',
+ description => 'Super Hoop',
+ price => '2392.00',
+ },
+ ],
+ tax => '251.42',
+ total => '4443.52',
+ comments => <<'END_TEXT',
Late afternoon is best. Backup contact is Nancy Billsmer @ 338-4338.
END_TEXT
- } ],
- 'sample.yml',
- # nosyck => 1,
+ } ],
+ 'sample.yml',
+ # nosyck => 1,
);
-#!/usr/bin/perl
-
# Testing of META.yml containing AVAR's name
use strict;
+use warnings;
+
BEGIN {
- $| = 1;
- $^W = 1;
+ $| = 1;
+ $^W = 1;
}
use File::Spec::Functions ':ALL';
is( $@, '', "$name: CPAN::Meta::YAML parses without error" );
is( $yaml_copy, $sample, "$name: CPAN::Meta::YAML does not modify the input string" );
SKIP: {
- skip( "Shortcutting after failure", 2 ) if $@;
- isa_ok( $yaml, 'CPAN::Meta::YAML' );
- is_deeply( $yaml->[0]->{build_requires}, {
- 'Config' => 0,
- 'Test::More' => 0,
- 'XSLoader' => 0,
- }, 'build_requires ok' );
+ skip( "Shortcutting after failure", 2 ) if $@;
+ isa_ok( $yaml, 'CPAN::Meta::YAML' );
+ is_deeply( $yaml->[0]->{build_requires}, {
+ 'Config' => 0,
+ 'Test::More' => 0,
+ 'XSLoader' => 0,
+ }, 'build_requires ok' );
}
SKIP: {
- unless ( CPAN::Meta::YAML::HAVE_UTF8() ) {
- skip("no utf8 support", 2 );
- }
- eval { utf8::is_utf8('') };
- if ( $@ ) {
- skip("no is_utf8 to test with until 5.8.1", 2);
- }
- ok( utf8::is_utf8($yaml->[0]->{author}), "utf8 decoded" );
- is( length($yaml->[0]->{author}), 39, "utf8 decoded as characters" );
+ unless ( CPAN::Meta::YAML::HAVE_UTF8() ) {
+ skip("no utf8 support", 2 );
+ }
+ eval { utf8::is_utf8('') };
+ if ( $@ ) {
+ skip("no is_utf8 to test with until 5.8.1", 2);
+ }
+ ok( utf8::is_utf8($yaml->[0]->{author}), "utf8 decoded" );
+ is( length($yaml->[0]->{author}), 39, "utf8 decoded as characters" );
}
-#!/usr/bin/perl
-
# Testing for null references
use strict;
+use warnings;
+
BEGIN {
- $| = 1;
- $^W = 1;
+ $| = 1;
+ $^W = 1;
}
use File::Spec::Functions ':ALL';
# Example Empty References
yaml_ok(
- <<'END_YAML',
+ <<'END_YAML',
--- []
--- {}
END_YAML
- [ [], {} ],
- 'Empty references',
+ [ [], {} ],
+ 'Empty references',
);
-#!/usr/bin/perl
-
# Testing of a known-bad file from an editor
use strict;
+use warnings;
+
BEGIN {
- $| = 1;
- $^W = 1;
+ $| = 1;
+ $^W = 1;
}
use File::Spec::Functions ':ALL';
my $toolbar = load_ok( 'toolbar.yml', $toolbar_file, 100 );
yaml_ok(
- $toolbar,
- [ {
- main_toolbar => [
- 'item file-new',
- 'item file-open',
- 'item file-print#',
- 'item file-close#',
- 'item file-save-all',
- 'item file-save',
- undef,
- 'item edit-changes-undo',
- 'item edit-changes-redo',
- undef,
- 'item edit-cut',
- 'item edit-copy',
- 'item edit-paste',
- 'item edit-replace',
- 'item edit-delete',
- ]
- } ],
- 'toolbar.yml',
- noyamlperl => 1,
+ $toolbar,
+ [ {
+ main_toolbar => [
+ 'item file-new',
+ 'item file-open',
+ 'item file-print#',
+ 'item file-close#',
+ 'item file-save-all',
+ 'item file-save',
+ undef,
+ 'item edit-changes-undo',
+ 'item edit-changes-redo',
+ undef,
+ 'item edit-cut',
+ 'item edit-copy',
+ 'item edit-paste',
+ 'item edit-replace',
+ 'item edit-delete',
+ ]
+ } ],
+ 'toolbar.yml',
+ noyamlperl => 1,
);
-#!/usr/bin/perl
-
# Testing relating to functionality in the Test Anything Protocol
use strict;
+use warnings;
+
BEGIN {
- $| = 1;
- $^W = 1;
+ $| = 1;
+ $^W = 1;
}
use File::Spec::Functions ':ALL';
# Make sure we support x-foo keys
yaml_ok(
- "---\nx-foo: 1\n",
- [ { 'x-foo' => 1 } ],
- 'x-foo key',
+ "---\nx-foo: 1\n",
+ [ { 'x-foo' => 1 } ],
+ 'x-foo key',
);
# Document ending (hash)
yaml_ok(
- "---\n"
- . " foo: bar\n"
- . "...\n",
- [ { foo => "bar" } ],
- 'document_end_hash',
- noyamlpm => 1,
- nosyck => 1,
- noyamlperl => 1,
+ "---\n"
+ . " foo: bar\n"
+ . "...\n",
+ [ { foo => "bar" } ],
+ 'document_end_hash',
+ noyamlpm => 1,
+ nosyck => 1,
+ noyamlperl => 1,
);
# Document ending (array)
yaml_ok(
- "---\n"
- . "- foo\n"
- . "...\n",
- [ [ 'foo' ] ],
- 'document_end_array',
- noyamlpm => 1,
- noyamlperl => 1,
+ "---\n"
+ . "- foo\n"
+ . "...\n",
+ [ [ 'foo' ] ],
+ 'document_end_array',
+ noyamlpm => 1,
+ noyamlperl => 1,
);
# Multiple documents (simple)
yaml_ok(
- "---\n"
- . "- foo\n"
- . "...\n"
- . "---\n"
- . "- foo\n"
- . "...\n",
- [ [ 'foo' ], [ 'foo' ] ],
- 'multi_document_simple',
- noyamlpm => 1,
- noyamlperl => 1,
+ "---\n"
+ . "- foo\n"
+ . "...\n"
+ . "---\n"
+ . "- foo\n"
+ . "...\n",
+ [ [ 'foo' ], [ 'foo' ] ],
+ 'multi_document_simple',
+ noyamlpm => 1,
+ noyamlperl => 1,
);
# Multiple documents (whitespace-separated)
yaml_ok(
- "---\n"
- . "- foo\n"
- . "...\n"
- . "\n"
- . "---\n"
- . "- foo\n"
- . "...\n",
- [ [ 'foo' ], [ 'foo' ] ],
- 'multi_document_space',
- noyamlpm => 1,
- noyamlperl => 1,
+ "---\n"
+ . "- foo\n"
+ . "...\n"
+ . "\n"
+ . "---\n"
+ . "- foo\n"
+ . "...\n",
+ [ [ 'foo' ], [ 'foo' ] ],
+ 'multi_document_space',
+ noyamlpm => 1,
+ noyamlperl => 1,
);
-#!/usr/bin/perl
-
# Testing documents that should fail
use strict;
+use warnings;
+
BEGIN {
- $| = 1;
- $^W = 1;
+ $| = 1;
+ $^W = 1;
}
use File::Spec::Functions ':ALL';
yaml_error( <<'END_YAML', $FEATURE );
---
-version: !!perl/hash:version
+version: !!perl/hash:version
original: v2.0.2
qv: 1
- version:
+ version:
- 2
- 0
- 2
-#!/usr/bin/perl
-
# Testing documents that should fail
use strict;
+use warnings;
+
BEGIN {
- $| = 1;
- $^W = 1;
+ $| = 1;
+ $^W = 1;
}
use File::Spec::Functions ':ALL';
# Customized Class
SCOPE: {
- package Foo;
-
- use CPAN::Meta::YAML;
-
- use vars qw{@ISA};
- BEGIN {
- @ISA = 'CPAN::Meta::YAML';
- }
-
- sub _write_scalar {
- my $self = shift;
- my $string = shift;
- my $indent = shift;
- if ( defined $indent ) {
- return "'$indent'";
- } else {
- return 'undef';
- }
- }
-
- 1;
+ package Foo;
+
+ use CPAN::Meta::YAML;
+
+ use vars qw{@ISA};
+ BEGIN {
+ @ISA = 'CPAN::Meta::YAML';
+ }
+
+ sub _write_scalar {
+ my $self = shift;
+ my $string = shift;
+ my $indent = shift;
+ if ( defined $indent ) {
+ return "'$indent'";
+ } else {
+ return 'undef';
+ }
+ }
+
+ 1;
}
# Generate the value
my $object = Foo->new(
- { foo => 'bar' }
+ { foo => 'bar' }
);
is( $object->write_string, "---\nfoo: '1'\n", 'Subclassing works' );
-#!/usr/bin/perl
-
use strict;
+use warnings;
+
BEGIN {
- $| = 1;
- $^W = 1;
+ $| = 1;
+ $^W = 1;
}
use File::Spec::Functions ':ALL';
is( $@, '', "$name: CPAN::Meta::YAML parses without error" );
is( $yaml_copy, $sample, "$name: CPAN::Meta::YAML does not modify the input string" );
SKIP: {
- skip( "Shortcutting after failure", 2 ) if $@;
- is( $yaml, undef, "file not parsed" );
- is( CPAN::Meta::YAML->errstr, "Stream has a non UTF-8 BOM", "correct error" );
+ skip( "Shortcutting after failure", 2 ) if $@;
+ is( $yaml, undef, "file not parsed" );
+ is( CPAN::Meta::YAML->errstr, "Stream has a non UTF-8 BOM", "correct error" );
}
-#!/usr/bin/perl
-
# Testing of inline comments. These comments can be quite useful in config
# files and people will expect them to work.
use strict;
+use warnings;
+
BEGIN {
- $| = 1;
- $^W = 1;
+ $| = 1;
+ $^W = 1;
}
use File::Spec::Functions ':ALL';
# Main Tests
yaml_ok(
- <<'END_YAML',
+ <<'END_YAML',
---
a: b#content
c: d #comment
m: # comment
n: o
END_YAML
- [
- {
- a => 'b#content',
- c => 'd',
- e => [
- 'f',
- 'g# content',
- ],
- h => 'single',
- h2 => 'single # content',
- i => 'double',
- i2 => 'double # content',
- j => "literal # content\nblock # content\n",
- k => {},
- l => [],
- m => {
- n => 'o',
- },
- },
- ],
- 'Properly ignore comments',
- noyamlpm => 1,
+ [
+ {
+ a => 'b#content',
+ c => 'd',
+ e => [
+ 'f',
+ 'g# content',
+ ],
+ h => 'single',
+ h2 => 'single # content',
+ i => 'double',
+ i2 => 'double # content',
+ j => "literal # content\nblock # content\n",
+ k => {},
+ l => [],
+ m => {
+ n => 'o',
+ },
+ },
+ ],
+ 'Properly ignore comments',
+ noyamlpm => 1,
);
# Repeat, with otherwise illegal characters in the comments
yaml_ok(
- <<'END_YAML',
+ <<'END_YAML',
---
a: b#content
c: d #comment '"!&@%`
m: # comment '"!&@%`
n: o
END_YAML
- [
- {
- a => 'b#content',
- c => 'd',
- e => [
- 'f',
- 'g# content',
- ],
- h => 'single',
- h2 => 'single # content',
- i => 'double',
- i2 => 'double # content',
- j => "literal # content\nblock # content\n",
- k => {},
- l => [],
- m => {
- n => 'o',
- },
- },
- ],
- 'Properly ignore comments (with otherwise illegal characters)',
- noyamlpm => 1,
+ [
+ {
+ a => 'b#content',
+ c => 'd',
+ e => [
+ 'f',
+ 'g# content',
+ ],
+ h => 'single',
+ h2 => 'single # content',
+ i => 'double',
+ i2 => 'double # content',
+ j => "literal # content\nblock # content\n",
+ k => {},
+ l => [],
+ m => {
+ n => 'o',
+ },
+ },
+ ],
+ 'Properly ignore comments (with otherwise illegal characters)',
+ noyamlpm => 1,
);
package t::lib::Test;
use strict;
+use warnings;
+
use Exporter ();
use File::Spec ();
use Test::More ();
use vars qw{@ISA @EXPORT};
BEGIN {
- @ISA = qw{ Exporter };
- @EXPORT = qw{
- tests yaml_ok yaml_error slurp load_ok
- test_data_directory
- };
+ @ISA = qw{ Exporter };
+ @EXPORT = qw{
+ tests yaml_ok yaml_error slurp load_ok
+ test_data_directory
+ };
}
# Do we have the authorative YAML to test against
eval {
- require YAML;
+ require YAML;
- # This doesn't currently work, but is documented to.
- # So if it ever turns up, use it.
- $YAML::UseVersion = 1;
+ # This doesn't currently work, but is documented to.
+ # So if it ever turns up, use it.
+ $YAML::UseVersion = 1;
};
my $HAVE_YAMLPM = !! (
- $YAML::VERSION
- and
- $YAML::VERSION >= 0.66
+ $YAML::VERSION
+ and
+ $YAML::VERSION >= 0.66
);
sub have_yamlpm { $HAVE_YAMLPM }
# Do we have YAML::Perl to test against?
eval {
- require YAML::Perl;
+ require YAML::Perl;
};
my $HAVE_YAMLPERL = !! (
- $YAML::Perl::VERSION
- and
- $YAML::Perl::VERSION >= 0.02
+ $YAML::Perl::VERSION
+ and
+ $YAML::Perl::VERSION >= 0.02
);
sub have_yamlperl { $HAVE_YAMLPERL }
# Do we have YAML::Syck to test against?
eval {
- require YAML::Syck;
+ require YAML::Syck;
};
my $HAVE_SYCK = !! (
- $YAML::Syck::VERSION
- and
- $YAML::Syck::VERSION >= 1.05
+ $YAML::Syck::VERSION
+ and
+ $YAML::Syck::VERSION >= 1.05
);
sub have_syck { $HAVE_SYCK }
# Do we have YAML::XS to test against?
eval {
- require YAML::XS;
+ require YAML::XS;
};
my $HAVE_XS = !! (
- $YAML::XS::VERSION
- and
- $YAML::XS::VERSION >= 0.29
+ $YAML::XS::VERSION
+ and
+ $YAML::XS::VERSION >= 0.29
);
sub have_xs{ $HAVE_XS }
# 22 tests per call to yaml_ok
# 4 tests per call to load_ok
sub tests {
- return ( tests => count(@_) );
+ return ( tests => count(@_) );
}
sub test_data_directory {
- return File::Spec->catdir( 't', 'data' );
+ return File::Spec->catdir( 't', 'data' );
}
sub count {
- my $yaml_ok = shift || 0;
- my $load_ok = shift || 0;
- my $single = shift || 0;
- my $count = $yaml_ok * 38 + $load_ok * 4 + $single;
- return $count;
+ my $yaml_ok = shift || 0;
+ my $load_ok = shift || 0;
+ my $single = shift || 0;
+ my $count = $yaml_ok * 38 + $load_ok * 4 + $single;
+ return $count;
}
sub yaml_ok {
- my $string = shift;
- my $object = shift;
- my $name = shift || 'unnamed';
- my %options = ( @_ );
- bless $object, 'CPAN::Meta::YAML';
-
- # If YAML itself is available, test with it
- SKIP: {
- unless ( $HAVE_YAMLPM ) {
- Test::More::skip( "Skipping YAML.pm, not available for testing", 7 );
- }
- if ( $options{noyamlpm} ) {
- Test::More::skip( "Skipping YAML.pm for known-broken feature", 7 );
- }
-
- # Test writing with YAML.pm
- my $yamlpm_out = eval { YAML::Dump( @$object ) };
- Test::More::is( $@, '', "$name: YAML.pm saves without error" );
- SKIP: {
- Test::More::skip( "Shortcutting after failure", 4 ) if $@;
- Test::More::ok(
- !!(defined $yamlpm_out and ! ref $yamlpm_out),
- "$name: YAML.pm serializes correctly",
- );
- my @yamlpm_round = eval { YAML::Load( $yamlpm_out ) };
- Test::More::is( $@, '', "$name: YAML.pm round-trips without error" );
- Test::More::skip( "Shortcutting after failure", 2 ) if $@;
- my $round = bless [ @yamlpm_round ], 'CPAN::Meta::YAML';
- Test::More::is_deeply( $round, $object, "$name: YAML.pm round-trips correctly" );
- }
-
- # Test reading with YAML.pm
- my $yamlpm_copy = $string;
- my @yamlpm_in = eval { YAML::Load( $yamlpm_copy ) };
- Test::More::is( $@, '', "$name: YAML.pm loads without error" );
- Test::More::is( $yamlpm_copy, $string, "$name: YAML.pm does not modify the input string" );
- SKIP: {
- Test::More::skip( "Shortcutting after failure", 1 ) if $@;
- Test::More::is_deeply( \@yamlpm_in, $object, "$name: YAML.pm parses correctly" );
- }
- }
-
- # If YAML::Syck itself is available, test with it
- SKIP: {
- unless ( $HAVE_SYCK ) {
- Test::More::skip( "Skipping YAML::Syck, not available for testing", 7 );
- }
- if ( $options{nosyck} ) {
- Test::More::skip( "Skipping YAML::Syck for known-broken feature", 7 );
- }
- unless ( @$object == 1 ) {
- Test::More::skip( "Skipping YAML::Syck for unsupported feature", 7 );
- }
-
- # Test writing with YAML::Syck
- my $syck_out = eval { YAML::Syck::Dump( @$object ) };
- Test::More::is( $@, '', "$name: YAML::Syck saves without error" );
- SKIP: {
- Test::More::skip( "Shortcutting after failure", 4 ) if $@;
- Test::More::ok(
- !!(defined $syck_out and ! ref $syck_out),
- "$name: YAML::Syck serializes correctly",
- );
- my @syck_round = eval { YAML::Syck::Load( $syck_out ) };
- Test::More::is( $@, '', "$name: YAML::Syck round-trips without error" );
- Test::More::skip( "Shortcutting after failure", 2 ) if $@;
- my $round = bless [ @syck_round ], 'CPAN::Meta::YAML';
- Test::More::is_deeply( $round, $object, "$name: YAML::Syck round-trips correctly" );
- }
-
- # Test reading with YAML::Syck
- my $syck_copy = $string;
- my @syck_in = eval { YAML::Syck::Load( $syck_copy ) };
- Test::More::is( $@, '', "$name: YAML::Syck loads without error" );
- Test::More::is( $syck_copy, $string, "$name: YAML::Syck does not modify the input string" );
- SKIP: {
- Test::More::skip( "Shortcutting after failure", 1 ) if $@;
- Test::More::is_deeply( \@syck_in, $object, "$name: YAML::Syck parses correctly" );
- }
- }
-
- # If YAML::XS itself is available, test with it
- SKIP: {
- unless ( $HAVE_XS ) {
- Test::More::skip( "Skipping YAML::XS, not available for testing", 7 );
- }
- if ( $options{noxs} ) {
- Test::More::skip( "Skipping YAML::XS for known-broken feature", 7 );
- }
-
- # Test writing with YAML::XS
- my $xs_out = eval { YAML::XS::Dump( @$object ) };
- Test::More::is( $@, '', "$name: YAML::XS saves without error" );
- SKIP: {
- Test::More::skip( "Shortcutting after failure", 4 ) if $@;
- Test::More::ok(
- !!(defined $xs_out and ! ref $xs_out),
- "$name: YAML::XS serializes correctly",
- );
- my @xs_round = eval { YAML::XS::Load( $xs_out ) };
- Test::More::is( $@, '', "$name: YAML::XS round-trips without error" );
- Test::More::skip( "Shortcutting after failure", 2 ) if $@;
- my $round = bless [ @xs_round ], 'CPAN::Meta::YAML';
- Test::More::is_deeply( $round, $object, "$name: YAML::XS round-trips correctly" );
- }
-
- # Test reading with YAML::XS
- my $xs_copy = $string;
- my @xs_in = eval { YAML::XS::Load( $xs_copy ) };
- Test::More::is( $@, '', "$name: YAML::XS loads without error" );
- Test::More::is( $xs_copy, $string, "$name: YAML::XS does not modify the input string" );
- SKIP: {
- Test::More::skip( "Shortcutting after failure", 1 ) if $@;
- Test::More::is_deeply( \@xs_in, $object, "$name: YAML::XS parses correctly" );
- }
- }
-
- # If YAML::Perl is available, test with it
- SKIP: {
- unless ( $HAVE_YAMLPERL ) {
- Test::More::skip( "Skipping YAML::Perl, not available for testing", 7 );
- }
- if ( $options{noyamlperl} ) {
- Test::More::skip( "Skipping YAML::Perl for known-broken feature", 7 );
- }
-
- # Test writing with YAML.pm
- my $yamlperl_out = eval { YAML::Perl::Dump( @$object ) };
- Test::More::is( $@, '', "$name: YAML::Perl saves without error" );
- SKIP: {
- Test::More::skip( "Shortcutting after failure", 4 ) if $@;
- Test::More::ok(
- !!(defined $yamlperl_out and ! ref $yamlperl_out),
- "$name: YAML::Perl serializes correctly",
- );
- my @yamlperl_round = eval { YAML::Perl::Load( $yamlperl_out ) };
- Test::More::is( $@, '', "$name: YAML::Perl round-trips without error" );
- Test::More::skip( "Shortcutting after failure", 2 ) if $@;
- my $round = bless [ @yamlperl_round ], 'CPAN::Meta::YAML';
- Test::More::is_deeply( $round, $object, "$name: YAML::Perl round-trips correctly" );
- }
-
- # Test reading with YAML::Perl
- my $yamlperl_copy = $string;
- my @yamlperl_in = eval { YAML::Perl::Load( $yamlperl_copy ) };
- Test::More::is( $@, '', "$name: YAML::Perl loads without error" );
- Test::More::is( $yamlperl_copy, $string, "$name: YAML::Perl does not modify the input string" );
- SKIP: {
- Test::More::skip( "Shortcutting after failure", 1 ) if $@;
- Test::More::is_deeply( \@yamlperl_in, $object, "$name: YAML::Perl parses correctly" );
- }
- }
-
- # Does the string parse to the structure
- my $yaml_copy = $string;
- my $yaml = eval { CPAN::Meta::YAML->read_string( $yaml_copy ); };
- Test::More::is( $@, '', "$name: CPAN::Meta::YAML parses without error" );
- Test::More::is( $yaml_copy, $string, "$name: CPAN::Meta::YAML does not modify the input string" );
- SKIP: {
- Test::More::skip( "Shortcutting after failure", 2 ) if $@;
- Test::More::isa_ok( $yaml, 'CPAN::Meta::YAML' );
- Test::More::is_deeply( $yaml, $object, "$name: CPAN::Meta::YAML parses correctly" );
- }
-
- # Does the structure serialize to the string.
- # We can't test this by direct comparison, because any
- # whitespace or comments would be lost.
- # So instead we parse back in.
- my $output = eval { $object->write_string };
- Test::More::is( $@, '', "$name: CPAN::Meta::YAML serializes without error" );
- SKIP: {
- Test::More::skip( "Shortcutting after failure", 5 ) if $@;
- Test::More::ok(
- !!(defined $output and ! ref $output),
- "$name: CPAN::Meta::YAML serializes correctly",
- );
- my $roundtrip = eval { CPAN::Meta::YAML->read_string( $output ) };
- Test::More::is( $@, '', "$name: CPAN::Meta::YAML round-trips without error" );
- Test::More::skip( "Shortcutting after failure", 2 ) if $@;
- Test::More::isa_ok( $roundtrip, 'CPAN::Meta::YAML' );
- Test::More::is_deeply( $roundtrip, $object, "$name: CPAN::Meta::YAML round-trips correctly" );
-
- # Testing the serialization
- Test::More::skip( "Shortcutting perfect serialization tests", 1 ) unless $options{serializes};
- Test::More::is( $output, $string, 'Serializes ok' );
- }
-
- # Return true as a convenience
- return 1;
+ my $string = shift;
+ my $object = shift;
+ my $name = shift || 'unnamed';
+ my %options = ( @_ );
+ bless $object, 'CPAN::Meta::YAML';
+
+ # If YAML itself is available, test with it
+ SKIP: {
+ unless ( $HAVE_YAMLPM ) {
+ Test::More::skip( "Skipping YAML.pm, not available for testing", 7 );
+ }
+ if ( $options{noyamlpm} ) {
+ Test::More::skip( "Skipping YAML.pm for known-broken feature", 7 );
+ }
+
+ # Test writing with YAML.pm
+ my $yamlpm_out = eval { YAML::Dump( @$object ) };
+ Test::More::is( $@, '', "$name: YAML.pm saves without error" );
+ SKIP: {
+ Test::More::skip( "Shortcutting after failure", 4 ) if $@;
+ Test::More::ok(
+ !!(defined $yamlpm_out and ! ref $yamlpm_out),
+ "$name: YAML.pm serializes correctly",
+ );
+ my @yamlpm_round = eval { YAML::Load( $yamlpm_out ) };
+ Test::More::is( $@, '', "$name: YAML.pm round-trips without error" );
+ Test::More::skip( "Shortcutting after failure", 2 ) if $@;
+ my $round = bless [ @yamlpm_round ], 'CPAN::Meta::YAML';
+ Test::More::is_deeply( $round, $object, "$name: YAML.pm round-trips correctly" );
+ }
+
+ # Test reading with YAML.pm
+ my $yamlpm_copy = $string;
+ my @yamlpm_in = eval { YAML::Load( $yamlpm_copy ) };
+ Test::More::is( $@, '', "$name: YAML.pm loads without error" );
+ Test::More::is( $yamlpm_copy, $string, "$name: YAML.pm does not modify the input string" );
+ SKIP: {
+ Test::More::skip( "Shortcutting after failure", 1 ) if $@;
+ Test::More::is_deeply( \@yamlpm_in, $object, "$name: YAML.pm parses correctly" );
+ }
+ }
+
+ # If YAML::Syck itself is available, test with it
+ SKIP: {
+ unless ( $HAVE_SYCK ) {
+ Test::More::skip( "Skipping YAML::Syck, not available for testing", 7 );
+ }
+ if ( $options{nosyck} ) {
+ Test::More::skip( "Skipping YAML::Syck for known-broken feature", 7 );
+ }
+ unless ( @$object == 1 ) {
+ Test::More::skip( "Skipping YAML::Syck for unsupported feature", 7 );
+ }
+
+ # Test writing with YAML::Syck
+ my $syck_out = eval { YAML::Syck::Dump( @$object ) };
+ Test::More::is( $@, '', "$name: YAML::Syck saves without error" );
+ SKIP: {
+ Test::More::skip( "Shortcutting after failure", 4 ) if $@;
+ Test::More::ok(
+ !!(defined $syck_out and ! ref $syck_out),
+ "$name: YAML::Syck serializes correctly",
+ );
+ my @syck_round = eval { YAML::Syck::Load( $syck_out ) };
+ Test::More::is( $@, '', "$name: YAML::Syck round-trips without error" );
+ Test::More::skip( "Shortcutting after failure", 2 ) if $@;
+ my $round = bless [ @syck_round ], 'CPAN::Meta::YAML';
+ Test::More::is_deeply( $round, $object, "$name: YAML::Syck round-trips correctly" );
+ }
+
+ # Test reading with YAML::Syck
+ my $syck_copy = $string;
+ my @syck_in = eval { YAML::Syck::Load( $syck_copy ) };
+ Test::More::is( $@, '', "$name: YAML::Syck loads without error" );
+ Test::More::is( $syck_copy, $string, "$name: YAML::Syck does not modify the input string" );
+ SKIP: {
+ Test::More::skip( "Shortcutting after failure", 1 ) if $@;
+ Test::More::is_deeply( \@syck_in, $object, "$name: YAML::Syck parses correctly" );
+ }
+ }
+
+ # If YAML::XS itself is available, test with it
+ SKIP: {
+ unless ( $HAVE_XS ) {
+ Test::More::skip( "Skipping YAML::XS, not available for testing", 7 );
+ }
+ if ( $options{noxs} ) {
+ Test::More::skip( "Skipping YAML::XS for known-broken feature", 7 );
+ }
+
+ # Test writing with YAML::XS
+ my $xs_out = eval { YAML::XS::Dump( @$object ) };
+ Test::More::is( $@, '', "$name: YAML::XS saves without error" );
+ SKIP: {
+ Test::More::skip( "Shortcutting after failure", 4 ) if $@;
+ Test::More::ok(
+ !!(defined $xs_out and ! ref $xs_out),
+ "$name: YAML::XS serializes correctly",
+ );
+ my @xs_round = eval { YAML::XS::Load( $xs_out ) };
+ Test::More::is( $@, '', "$name: YAML::XS round-trips without error" );
+ Test::More::skip( "Shortcutting after failure", 2 ) if $@;
+ my $round = bless [ @xs_round ], 'CPAN::Meta::YAML';
+ Test::More::is_deeply( $round, $object, "$name: YAML::XS round-trips correctly" );
+ }
+
+ # Test reading with YAML::XS
+ my $xs_copy = $string;
+ my @xs_in = eval { YAML::XS::Load( $xs_copy ) };
+ Test::More::is( $@, '', "$name: YAML::XS loads without error" );
+ Test::More::is( $xs_copy, $string, "$name: YAML::XS does not modify the input string" );
+ SKIP: {
+ Test::More::skip( "Shortcutting after failure", 1 ) if $@;
+ Test::More::is_deeply( \@xs_in, $object, "$name: YAML::XS parses correctly" );
+ }
+ }
+
+ # If YAML::Perl is available, test with it
+ SKIP: {
+ unless ( $HAVE_YAMLPERL ) {
+ Test::More::skip( "Skipping YAML::Perl, not available for testing", 7 );
+ }
+ if ( $options{noyamlperl} ) {
+ Test::More::skip( "Skipping YAML::Perl for known-broken feature", 7 );
+ }
+
+ # Test writing with YAML.pm
+ my $yamlperl_out = eval { YAML::Perl::Dump( @$object ) };
+ Test::More::is( $@, '', "$name: YAML::Perl saves without error" );
+ SKIP: {
+ Test::More::skip( "Shortcutting after failure", 4 ) if $@;
+ Test::More::ok(
+ !!(defined $yamlperl_out and ! ref $yamlperl_out),
+ "$name: YAML::Perl serializes correctly",
+ );
+ my @yamlperl_round = eval { YAML::Perl::Load( $yamlperl_out ) };
+ Test::More::is( $@, '', "$name: YAML::Perl round-trips without error" );
+ Test::More::skip( "Shortcutting after failure", 2 ) if $@;
+ my $round = bless [ @yamlperl_round ], 'CPAN::Meta::YAML';
+ Test::More::is_deeply( $round, $object, "$name: YAML::Perl round-trips correctly" );
+ }
+
+ # Test reading with YAML::Perl
+ my $yamlperl_copy = $string;
+ my @yamlperl_in = eval { YAML::Perl::Load( $yamlperl_copy ) };
+ Test::More::is( $@, '', "$name: YAML::Perl loads without error" );
+ Test::More::is( $yamlperl_copy, $string, "$name: YAML::Perl does not modify the input string" );
+ SKIP: {
+ Test::More::skip( "Shortcutting after failure", 1 ) if $@;
+ Test::More::is_deeply( \@yamlperl_in, $object, "$name: YAML::Perl parses correctly" );
+ }
+ }
+
+ # Does the string parse to the structure
+ my $yaml_copy = $string;
+ my $yaml = eval { CPAN::Meta::YAML->read_string( $yaml_copy ); };
+ Test::More::is( $@, '', "$name: CPAN::Meta::YAML parses without error" );
+ Test::More::is( $yaml_copy, $string, "$name: CPAN::Meta::YAML does not modify the input string" );
+ SKIP: {
+ Test::More::skip( "Shortcutting after failure", 2 ) if $@;
+ Test::More::isa_ok( $yaml, 'CPAN::Meta::YAML' );
+ Test::More::is_deeply( $yaml, $object, "$name: CPAN::Meta::YAML parses correctly" );
+ }
+
+ # Does the structure serialize to the string.
+ # We can't test this by direct comparison, because any
+ # whitespace or comments would be lost.
+ # So instead we parse back in.
+ my $output = eval { $object->write_string };
+ Test::More::is( $@, '', "$name: CPAN::Meta::YAML serializes without error" );
+ SKIP: {
+ Test::More::skip( "Shortcutting after failure", 5 ) if $@;
+ Test::More::ok(
+ !!(defined $output and ! ref $output),
+ "$name: CPAN::Meta::YAML serializes correctly",
+ );
+ my $roundtrip = eval { CPAN::Meta::YAML->read_string( $output ) };
+ Test::More::is( $@, '', "$name: CPAN::Meta::YAML round-trips without error" );
+ Test::More::skip( "Shortcutting after failure", 2 ) if $@;
+ Test::More::isa_ok( $roundtrip, 'CPAN::Meta::YAML' );
+ Test::More::is_deeply( $roundtrip, $object, "$name: CPAN::Meta::YAML round-trips correctly" );
+
+ # Testing the serialization
+ Test::More::skip( "Shortcutting perfect serialization tests", 1 ) unless $options{serializes};
+ Test::More::is( $output, $string, 'Serializes ok' );
+ }
+
+ # Return true as a convenience
+ return 1;
}
sub yaml_error {
- my $string = shift;
- my $like = shift;
- my $yaml = CPAN::Meta::YAML->read_string( $string );
- Test::More::is( $yaml, undef, '->read_string returns undef' );
- Test::More::ok( CPAN::Meta::YAML->errstr =~ /$like/, "Got expected error" );
- # NOTE: like() gives better diagnostics (but requires 5.005)
- # Test::More::like( $@, qr/$_[0]/, "CPAN::Meta::YAML throws expected error" );
+ my $string = shift;
+ my $like = shift;
+ my $yaml = CPAN::Meta::YAML->read_string( $string );
+ Test::More::is( $yaml, undef, '->read_string returns undef' );
+ Test::More::ok( CPAN::Meta::YAML->errstr =~ /$like/, "Got expected error" );
+ # NOTE: like() gives better diagnostics (but requires 5.005)
+ # Test::More::like( $@, qr/$_[0]/, "CPAN::Meta::YAML throws expected error" );
}
sub slurp {
- my $file = shift;
- local $/ = undef;
- open( FILE, " $file" ) or die "open($file) failed: $!";
- binmode( FILE, $_[0] ) if @_ > 0 && $] > 5.006;
- # binmode(FILE); # disable perl's BOM interpretation
- my $source = <FILE>;
- close( FILE ) or die "close($file) failed: $!";
- $source;
+ my $file = shift;
+ local $/ = undef;
+ open( FILE, " $file" ) or die "open($file) failed: $!";
+ binmode( FILE, $_[0] ) if @_ > 0 && $] > 5.006;
+ # binmode(FILE); # disable perl's BOM interpretation
+ my $source = <FILE>;
+ close( FILE ) or die "close($file) failed: $!";
+ $source;
}
sub load_ok {
- my $name = shift;
- my $file = shift;
- my $size = shift;
- Test::More::ok( -f $file, "Found $name" );
- Test::More::ok( -r $file, "Can read $name" );
- my $content = slurp( $file );
- Test::More::ok( (defined $content and ! ref $content), "Loaded $name" );
- Test::More::ok( ($size < length $content), "Content of $name larger than $size bytes" );
- return $content;
+ my $name = shift;
+ my $file = shift;
+ my $size = shift;
+ Test::More::ok( -f $file, "Found $name" );
+ Test::More::ok( -r $file, "Can read $name" );
+ my $content = slurp( $file );
+ Test::More::ok( (defined $content and ! ref $content), "Loaded $name" );
+ Test::More::ok( ($size < length $content), "Content of $name larger than $size bytes" );
+ return $content;
}
1;
projects / platform / upstream / perl.git / commitdiff