cpan/CPAN-Meta/t/strings.t
cpan/CPAN-Meta/t/validator.t
cpan/CPAN-Meta-YAML/lib/CPAN/Meta/YAML.pm CPAN-Meta-YAML files
+cpan/CPAN-Meta-YAML/t/01_api.t
cpan/CPAN-Meta-YAML/t/01_compile.t CPAN-Meta-YAML files
-cpan/CPAN-Meta-YAML/t/02_basic.t CPAN-Meta-YAML files
-cpan/CPAN-Meta-YAML/t/03_regression.t CPAN-Meta-YAML files
-cpan/CPAN-Meta-YAML/t/05_export.t CPAN-Meta-YAML files
-cpan/CPAN-Meta-YAML/t/11_meta_yml.t CPAN-Meta-YAML files
-cpan/CPAN-Meta-YAML/t/12_plagger.t CPAN-Meta-YAML files
-cpan/CPAN-Meta-YAML/t/13_perl_smith.t CPAN-Meta-YAML files
-cpan/CPAN-Meta-YAML/t/14_yaml_org.t CPAN-Meta-YAML files
-cpan/CPAN-Meta-YAML/t/15_multibyte.t CPAN-Meta-YAML files
-cpan/CPAN-Meta-YAML/t/16_nullrefs.t CPAN-Meta-YAML files
-cpan/CPAN-Meta-YAML/t/17_toolbar.t CPAN-Meta-YAML files
-cpan/CPAN-Meta-YAML/t/18_tap.t CPAN-Meta-YAML files
-cpan/CPAN-Meta-YAML/t/19_errors.t CPAN-Meta-YAML files
+cpan/CPAN-Meta-YAML/t/10_read.t
+cpan/CPAN-Meta-YAML/t/11_read_string.t
+cpan/CPAN-Meta-YAML/t/12_write.t
+cpan/CPAN-Meta-YAML/t/13_write_string.t
cpan/CPAN-Meta-YAML/t/20_subclass.t CPAN-Meta-YAML files
-cpan/CPAN-Meta-YAML/t/21_bom.t CPAN-Meta-YAML files
-cpan/CPAN-Meta-YAML/t/22_comments.t CPAN-Meta-YAML files
-cpan/CPAN-Meta-YAML/t/data/HTML-WebDAO.yml CPAN-Meta-YAML files
+cpan/CPAN-Meta-YAML/t/21_yamlpm_compat.t
+cpan/CPAN-Meta-YAML/t/30_yaml_spec_tml.t
+cpan/CPAN-Meta-YAML/t/31_local_tml.t
+cpan/CPAN-Meta-YAML/t/32_world_tml.t
+cpan/CPAN-Meta-YAML/t/data/ascii.yml
+cpan/CPAN-Meta-YAML/t/data/latin1.yml
cpan/CPAN-Meta-YAML/t/data/multibyte.yml CPAN-Meta-YAML files
-cpan/CPAN-Meta-YAML/t/data/one.yml CPAN-Meta-YAML files
-cpan/CPAN-Meta-YAML/t/data/sample.yml CPAN-Meta-YAML files
-cpan/CPAN-Meta-YAML/t/data/Spreadsheet-Read.yml CPAN-Meta-YAML files
-cpan/CPAN-Meta-YAML/t/data/Template-Provider-Unicode-Japanese.yml CPAN-Meta-YAML files
-cpan/CPAN-Meta-YAML/t/data/toolbar.yml CPAN-Meta-YAML files
-cpan/CPAN-Meta-YAML/t/data/two.yml CPAN-Meta-YAML files
cpan/CPAN-Meta-YAML/t/data/utf_16_le_bom.yml CPAN-Meta-YAML files
-cpan/CPAN-Meta-YAML/t/data/vanilla.yml CPAN-Meta-YAML files
-cpan/CPAN-Meta-YAML/t/lib/Test.pm CPAN-Meta-YAML files
+cpan/CPAN-Meta-YAML/t/data/utf_8_bom.yml
+cpan/CPAN-Meta-YAML/t/lib/TestBridge.pm
+cpan/CPAN-Meta-YAML/t/lib/TestML/Tiny.pm
+cpan/CPAN-Meta-YAML/t/lib/TestUtils.pm
+cpan/CPAN-Meta-YAML/t/README.md
+cpan/CPAN-Meta-YAML/t/tml
+cpan/CPAN-Meta-YAML/t/tml-local/dump-error/circular.tml
+cpan/CPAN-Meta-YAML/t/tml-local/load-error/document.tml
+cpan/CPAN-Meta-YAML/t/tml-local/load-error/scalar.tml
+cpan/CPAN-Meta-YAML/t/tml-local/load-error/tag.tml
+cpan/CPAN-Meta-YAML/t/tml-local/perl-to-yaml/quoting.tml
+cpan/CPAN-Meta-YAML/t/tml-local/yaml-roundtrip/collection.tml
+cpan/CPAN-Meta-YAML/t/tml-local/yaml-roundtrip/comment.tml
+cpan/CPAN-Meta-YAML/t/tml-local/yaml-roundtrip/document.tml
+cpan/CPAN-Meta-YAML/t/tml-local/yaml-roundtrip/mapping.tml
+cpan/CPAN-Meta-YAML/t/tml-local/yaml-roundtrip/quoting.tml
+cpan/CPAN-Meta-YAML/t/tml-local/yaml-roundtrip/scalar.tml
+cpan/CPAN-Meta-YAML/t/tml-local/yaml-roundtrip/sequence.tml
+cpan/CPAN-Meta-YAML/t/tml-spec/basic-data.tml
+cpan/CPAN-Meta-YAML/t/tml-spec/unicode.tml
+cpan/CPAN-Meta-YAML/t/tml-world/Acme-Time-Baby.tml
+cpan/CPAN-Meta-YAML/t/tml-world/Data-Swap.tml
+cpan/CPAN-Meta-YAML/t/tml-world/Games-Nintendo-Wii-Mii.tml
+cpan/CPAN-Meta-YAML/t/tml-world/HTML-WebDAO.tml
+cpan/CPAN-Meta-YAML/t/tml-world/ITS-SIN-FIDS-Content-XML.tml
+cpan/CPAN-Meta-YAML/t/tml-world/Plagger.tml
+cpan/CPAN-Meta-YAML/t/tml-world/Spreadsheet-Read.tml
+cpan/CPAN-Meta-YAML/t/tml-world/Template-Provider-Unicode-Japanese.tml
+cpan/CPAN-Meta-YAML/t/tml-world/toolbar.tml
+cpan/CPAN-Meta-YAML/t/tml-world/Vanilla-Perl.tml
+cpan/CPAN-Meta-YAML/t/tml-world/yaml_org.tml
+cpan/CPAN-Meta-YAML/t/tml-world/YAML-Tiny-META.tml
cpan/CPAN/PAUSE2003.pub CPAN public key
cpan/CPAN/PAUSE2005.pub CPAN public key
cpan/CPAN/PAUSE2007.pub CPAN public key
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
- version: 1.4
+ version: '1.4'
name: perl
no_index:
directory:
homepage: http://www.perl.org/
license: http://dev.perl.org/licenses/
repository: http://perl5.git.perl.org/
-version: 5.019009
+version: '5.019009'
},
'CPAN::Meta::YAML' => {
- 'DISTRIBUTION' => 'DAGOLDEN/CPAN-Meta-YAML-0.010.tar.gz',
+ 'DISTRIBUTION' => 'DAGOLDEN/CPAN-Meta-YAML-0.011.tar.gz',
'FILES' => q[cpan/CPAN-Meta-YAML],
'EXCLUDED' => [
't/00-compile.t',
+ 't/00-report-prereqs.t',
't/04_scalar.t', # requires YAML.pm
qr{^xt},
],
configure.gnu
config_h.SH
cpan/autodie/t/chmod.t
+cpan/CPAN-Meta-YAML/t/tml
cpan/Test-Harness/t/source_tests/source.sh
cpan/Test-Harness/t/source_tests/source_args.sh
installperl
+use 5.008001; # sane UTF-8 support
+use strict;
+use warnings;
package CPAN::Meta::YAML;
-{
- $CPAN::Meta::YAML::VERSION = '0.010';
-}
+$CPAN::Meta::YAML::VERSION = '0.011';
BEGIN {
$CPAN::Meta::YAML::AUTHORITY = 'cpan:ADAMK';
}
-{
+# git description: v1.59-TRIAL-1-g33d9cd2
; # original $VERSION removed by Doppelgaenger
-}
-# git description: v1.54-8-g4c3002d
+# XXX-INGY is 5.8.1 too old/broken for utf8?
+# XXX-XDG Lancaster consensus was that it was sufficient until
+# proven otherwise
-use strict;
-use warnings;
+#####################################################################
+# The CPAN::Meta::YAML API.
+#
+# These are the currently documented API functions/methods and
+# exports:
+
+use Exporter;
+our @ISA = qw{ Exporter };
+our @EXPORT = qw{ Load Dump };
+our @EXPORT_OK = qw{ LoadFile DumpFile freeze thaw };
+
+###
+# Functional/Export API:
+
+sub Dump {
+ return CPAN::Meta::YAML->new(@_)->_dump_string;
+}
-# UTF Support?
-sub HAVE_UTF8 () { $] >= 5.007003 }
+# XXX-INGY Returning last document seems a bad behavior.
+# XXX-XDG I think first would seem more natural, but I don't know
+# that it's worth changing now
+sub Load {
+ my $self = CPAN::Meta::YAML->_load_string(@_);
+ if ( wantarray ) {
+ return @$self;
+ } else {
+ # To match YAML.pm, return the last document
+ return $self->[-1];
+ }
+}
+
+# XXX-INGY Do we really need freeze and thaw?
+# XXX-XDG I don't think so. I'd support deprecating them.
BEGIN {
- if ( HAVE_UTF8 ) {
- # The string eval helps hide this from Test::MinimumVersion
- eval "require utf8;";
- die "Failed to load UTF-8 support" if $@;
+ *freeze = \&Dump;
+ *thaw = \&Load;
+}
+
+sub DumpFile {
+ my $file = shift;
+ return CPAN::Meta::YAML->new(@_)->_dump_file($file);
+}
+
+sub LoadFile {
+ my $file = shift;
+ my $self = CPAN::Meta::YAML->_load_file($file);
+ if ( wantarray ) {
+ return @$self;
+ } else {
+ # Return only the last document to match YAML.pm,
+ return $self->[-1];
}
+}
- # 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 = '';
+###
+# Object Oriented API:
+
+# Create an empty CPAN::Meta::YAML object
+# XXX-INGY Why do we use ARRAY object?
+# NOTE: I get it now, but I think it's confusing and not needed.
+# Will change it on a branch later, for review.
+#
+# XXX-XDG I don't support changing it yet. It's a very well-documented
+# "API" of CPAN::Meta::YAML. I'd support deprecating it, but Adam suggested
+# we not change it until YAML.pm's own OO API is established so that
+# users only have one API change to digest, not two
+sub new {
+ my $class = shift;
+ bless [ @_ ], $class;
+}
+
+# XXX-INGY It probably doesn't matter, and it's probably too late to
+# change, but 'read/write' are the wrong names. Read and Write
+# are actions that take data from storage to memory
+# characters/strings. These take the data to/from storage to native
+# Perl objects, which the terms dump and load are meant. As long as
+# this is a legacy quirk to CPAN::Meta::YAML it's ok, but I'd prefer not
+# to add new {read,write}_* methods to this API.
+
+sub read_string {
+ my $self = shift;
+ $self->_load_string(@_);
+}
+
+sub write_string {
+ my $self = shift;
+ $self->_dump_string(@_);
+}
+
+sub read {
+ my $self = shift;
+ $self->_load_file(@_);
}
-# The character class of all characters we need to escape
-# NOTE: Inlined, since it's only used once
-# my $RE_ESCAPE = '[\\x00-\\x08\\x0b-\\x0d\\x0e-\\x1f\"\n]';
+sub write {
+ my $self = shift;
+ $self->_dump_file(@_);
+}
+
+
+
+
+#####################################################################
+# Constants
# 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
+ 0 x01 x02 x03 x04 x05 x06 a
+ b t n v f r x0E x0F
x10 x11 x12 x13 x14 x15 x16 x17
- x18 x19 x1a e x1c x1d x1e x1f
+ x18 x19 x1A e x1C x1D x1E x1F
);
# Printable characters for escapes
my %UNESCAPES = (
- z => "\x00", a => "\x07", t => "\x09",
+ 0 => "\x00", z => "\x00", N => "\x85",
+ a => "\x07", b => "\x08", t => "\x09",
n => "\x0a", v => "\x0b", f => "\x0c",
r => "\x0d", e => "\x1b", '\\' => '\\',
);
-# Special magic boolean words
+# XXX-INGY
+# I(ngy) need to decide if these values should be quoted in
+# CPAN::Meta::YAML or not. Probably yes.
+
+# These 3 values have special meaning when unquoted and using the
+# default YAML schema. They need quotes if they are strings.
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 true false
};
+# 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.
+# qr/\"((?:\\.|[^\"])*)\"/
+my $re_capture_double_quoted = qr/\"([^\\"]*(?:\\.[^\\"]*)*)\"/;
+my $re_capture_single_quoted = qr/\'([^\']*(?:\'\'[^\']*)*)\'/;
+# unquoted re gets trailing space that needs to be stripped
+my $re_capture_unquoted_key = qr/([^:]+(?::+\S[^:]*)*)(?=\s*\:(?:\s+|$))/;
+my $re_trailing_comment = qr/(?:\s+\#.*)?/;
+my $re_key_value_separator = qr/\s*:(?:\s+(?:\#.*)?|$)/;
+
#####################################################################
-# Implementation
+# CPAN::Meta::YAML Implementation.
+#
+# These are the private methods that do all the work. They may change
+# at any time.
-# Create an empty CPAN::Meta::YAML object
-sub new {
- my $class = shift;
- bless [ @_ ], $class;
-}
+
+###
+# Loader functions:
# Create an object from a file
-sub read {
+sub _load_file {
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 $file = shift or $class->_error( 'You did not specify a file name' );
+ $class->_error( "File '$file' does not exist" )
+ unless -e $file;
+ $class->_error( "'$file' is a directory, not a file" )
+ unless -f _;
+ $class->_error( "Insufficient permissions to read '$file'" )
+ unless -r _;
+
+ # Open unbuffered with strict UTF-8 decoding and no translation layers
+ open( my $fh, "<:unix:encoding(UTF-8)", $file );
+ unless ( $fh ) {
+ $class->_error("Failed to open file '$file': $!");
+ }
+
+ # flock if available (or warn if not possible for OS-specific reasons)
+ if ( _can_flock() ) {
+ flock( $fh, Fcntl::LOCK_SH() )
+ or warn "Couldn't lock '$file' for reading: $!";
+ }
+
+ # slurp the contents
+ my $contents = eval {
+ use warnings FATAL => 'utf8';
+ local $/;
+ <$fh>
+ };
+ if ( my $err = $@ ) {
+ $class->_error("Error reading from file '$file': $err");
}
- my $contents = <CFG>;
- unless ( close(CFG) ) {
- return $class->_error("Failed to close file '$file': $!");
+
+ # close the file (release the lock)
+ unless ( close $fh ) {
+ $class->_error("Failed to close file '$file': $!");
}
- $class->read_string( $contents );
+ $class->_load_string( $contents );
}
# Create an object from a string
-sub read_string {
+sub _load_string {
my $class = ref $_[0] ? ref shift : shift;
my $self = bless [], $class;
my $string = $_[0];
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//;
+ # Check if Perl has it marked as characters, but it's internally
+ # inconsistent. E.g. maybe latin1 got read on a :utf8 layer
+ if ( utf8::is_utf8($string) && ! utf8::valid($string) ) {
+ die \<<'...';
+Read an invalid UTF-8 string (maybe mixed UTF-8 and 8-bit character set).
+Did you decode with lax ":utf8" instead of strict ":encoding(UTF-8)"?
+...
}
- # Try to decode as utf8
- utf8::decode($string) if HAVE_UTF8;
+ # Ensure Unicode character semantics, even for 0x80-0xff
+ utf8::upgrade($string);
+
+ # Check for and strip any leading UTF-8 BOM
+ $string =~ s/^\x{FEFF}//;
# 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/ }
@lines and $lines[0] =~ /^\%YAML[: ][\d\.]+.*\z/ and shift @lines;
# A nibbling parser
+ my $in_document = 0;
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 );
+ push @$self,
+ $self->_load_scalar( "$1", [ undef ], \@lines );
next;
}
+ $in_document = 1;
}
if ( ! @lines or $lines[0] =~ /^(?:---|\.\.\.)/ ) {
while ( @lines and $lines[0] !~ /^---/ ) {
shift @lines;
}
+ $in_document = 0;
- } elsif ( $lines[0] =~ /^\s*\-/ ) {
+ # XXX The final '-+$' is to look for -- which ends up being an
+ # error later.
+ } elsif ( ! $in_document && @$self ) {
+ # only the first document can be explicit
+ die \"CPAN::Meta::YAML failed to classify the line '$lines[0]'";
+ } elsif ( $lines[0] =~ /^\s*\-(?:\s|$|-+$)/ ) {
# An array at the root
my $document = [ ];
push @$self, $document;
- $self->_read_array( $document, [ 0 ], \@lines );
+ $self->_load_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 );
+ $self->_load_hash( $document, [ length($1) ], \@lines );
} else {
+ # Shouldn't get here. @lines have whitespace-only lines
+ # stripped, and previous match is a line with any
+ # non-whitespace. So this clause should only be reachable via
+ # a perlbug where \s is not symmetric with \S
+
+ # uncoverable statement
die \"CPAN::Meta::YAML failed to classify the line '$lines[0]'";
}
}
};
if ( ref $@ eq 'SCALAR' ) {
- return $self->_error(${$@});
+ $self->_error(${$@});
} elsif ( $@ ) {
- require Carp;
- Carp::croak($@);
+ $self->_error($@);
}
return $self;
}
-# Deparse a scalar string to the actual scalar
-sub _read_scalar {
+sub _unquote_single {
+ my ($self, $string) = @_;
+ return '' unless length $string;
+ $string =~ s/\'\'/\'/g;
+ return $string;
+}
+
+sub _unquote_double {
+ my ($self, $string) = @_;
+ return '' unless length $string;
+ $string =~ s/\\"/"/g;
+ $string =~
+ s{\\([Nnever\\fartz0b]|x([0-9a-fA-F]{2}))}
+ {(length($1)>1)?pack("H2",$2):$UNESCAPES{$1}}gex;
+ return $string;
+}
+
+# Load a YAML scalar string to the actual Perl scalar
+sub _load_scalar {
my ($self, $string, $indent, $lines) = @_;
# Trim trailing whitespace
return undef if $string eq '~';
# Single quote
- if ( $string =~ /^\'(.*?)\'(?:\s+\#.*)?\z/ ) {
- return '' unless defined $1;
- $string = $1;
- $string =~ s/\'\'/\'/g;
- return $string;
+ if ( $string =~ /^$re_capture_single_quoted$re_trailing_comment\z/ ) {
+ return $self->_unquote_single($1);
}
# 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;
+ if ( $string =~ /^$re_capture_double_quoted$re_trailing_comment\z/ ) {
+ return $self->_unquote_double($1);
}
# Special cases
# Regular unquoted string
if ( $string !~ /^[>|]/ ) {
- if (
- $string =~ /^(?:-(?:\s|$)|[\@\%\`])/
- or
- $string =~ /:(?:\s|$)/
- ) {
- die \"CPAN::Meta::YAML found illegal characters in plain scalar: '$string'";
- }
+ die \"CPAN::Meta::YAML found illegal characters in plain scalar: '$string'"
+ if $string =~ /^(?:-(?:\s|$)|[\@\%\`])/ or
+ $string =~ /:(?:\s|$)/;
$string =~ s/\s+#.*\z//;
return $string;
}
return join( $j, @multiline ) . $t;
}
-# Parse an array
-sub _read_array {
+# Load an array
+sub _load_array {
my ($self, $array, $indent, $lines) = @_;
while ( @$lines ) {
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 );
+ $self->_load_hash( $array->[-1], [ @$indent, $indent2 ], $lines );
} elsif ( $lines->[0] =~ /^\s*\-\s*\z/ ) {
shift @$lines;
} else {
# Naked indenter
push @$array, [ ];
- $self->_read_array( $array->[-1], [ @$indent, $indent2 ], $lines );
+ $self->_load_array(
+ $array->[-1], [ @$indent, $indent2 ], $lines
+ );
}
} elsif ( $lines->[0] =~ /^(\s*)\S/ ) {
push @$array, { };
- $self->_read_hash( $array->[-1], [ @$indent, length("$1") ], $lines );
+ $self->_load_hash(
+ $array->[-1], [ @$indent, length("$1") ], $lines
+ );
} else {
die \"CPAN::Meta::YAML failed to classify line '$lines->[0]'";
}
+ } elsif ( $lines->[0] =~ /^\s*\-(\s*)(.+?)\s*\z/ ) {
+ # Array entry with a value
+ shift @$lines;
+ push @$array, $self->_load_scalar(
+ "$2", [ @$indent, undef ], $lines
+ );
+
} elsif ( defined $indent->[-2] and $indent->[-1] == $indent->[-2] ) {
# This is probably a structure like the following...
# ---
return 1;
}
-# Parse an array
-sub _read_hash {
+# Load a hash
+sub _load_hash {
my ($self, $hash, $indent, $lines) = @_;
while ( @$lines ) {
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]'";
- }
+ # Find the key
+ my $key;
+
+ # Quoted keys
+ if ( $lines->[0] =~
+ s/^\s*$re_capture_single_quoted$re_key_value_separator//
+ ) {
+ $key = $self->_unquote_single($1);
+ }
+ elsif ( $lines->[0] =~
+ s/^\s*$re_capture_double_quoted$re_key_value_separator//
+ ) {
+ $key = $self->_unquote_double($1);
+ }
+ elsif ( $lines->[0] =~
+ s/^\s*$re_capture_unquoted_key$re_key_value_separator//
+ ) {
+ $key = $1;
+ $key =~ s/\s+$//;
+ }
+ elsif ( $lines->[0] =~ /^\s*\?/ ) {
+ die \"CPAN::Meta::YAML does not support a feature in line '$lines->[0]'";
+ }
+ else {
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 );
+ $hash->{$key} = $self->_load_scalar(
+ shift(@$lines), [ @$indent, undef ], $lines
+ );
} else {
# An indent
shift @$lines;
}
if ( $lines->[0] =~ /^(\s*)-/ ) {
$hash->{$key} = [];
- $self->_read_array( $hash->{$key}, [ @$indent, length($1) ], $lines );
+ $self->_load_array(
+ $hash->{$key}, [ @$indent, length($1) ], $lines
+ );
} elsif ( $lines->[0] =~ /^(\s*)./ ) {
my $indent2 = length("$1");
if ( $indent->[-1] >= $indent2 ) {
$hash->{$key} = undef;
} else {
$hash->{$key} = {};
- $self->_read_hash( $hash->{$key}, [ @$indent, length($1) ], $lines );
+ $self->_load_hash(
+ $hash->{$key}, [ @$indent, length($1) ], $lines
+ );
}
}
}
return 1;
}
+
+###
+# Dumper functions:
+
# Save an object to a file
-sub write {
+sub _dump_file {
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;
+ require Fcntl;
+
+ # Check the file
+ my $file = shift or $self->_error( 'You did not specify a file name' );
+
+ my $fh;
+ # flock if available (or warn if not possible for OS-specific reasons)
+ if ( _can_flock() ) {
+ # Open without truncation (truncate comes after lock)
+ my $flags = Fcntl::O_WRONLY()|Fcntl::O_CREAT();
+ sysopen( $fh, $file, $flags );
+ unless ( $fh ) {
+ $self->_error("Failed to open file '$file' for writing: $!");
+ }
+
+ # Use no translation and strict UTF-8
+ binmode( $fh, ":raw:encoding(UTF-8)");
+
+ flock( $fh, Fcntl::LOCK_EX() )
+ or warn "Couldn't lock '$file' for reading: $!";
+
+ # truncate and spew contents
+ truncate $fh, 0;
+ seek $fh, 0, 0;
+ }
+ else {
+ open $fh, ">:unix:encoding(UTF-8)", $file;
+ }
+
+ # serialize and spew to the handle
+ print {$fh} $self->_dump_string;
+
+ # close the file (release the lock)
+ unless ( close $fh ) {
+ $self->_error("Failed to close file '$file': $!");
+ }
return 1;
}
# Save an object to a string
-sub write_string {
+sub _dump_string {
my $self = shift;
- return '' unless @$self;
+ return '' unless ref $self && @$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, {} );
+ eval {
+ foreach my $cursor ( @$self ) {
+ push @lines, '---';
- } else {
- Carp::croak("Cannot serialize " . ref($cursor));
+ # An empty document
+ if ( ! defined $cursor ) {
+ # Do nothing
+
+ # A scalar document
+ } elsif ( ! ref $cursor ) {
+ $lines[-1] .= ' ' . $self->_dump_scalar( $cursor );
+
+ # A list at the root
+ } elsif ( ref $cursor eq 'ARRAY' ) {
+ unless ( @$cursor ) {
+ $lines[-1] .= ' []';
+ next;
+ }
+ push @lines, $self->_dump_array( $cursor, $indent, {} );
+
+ # A hash at the root
+ } elsif ( ref $cursor eq 'HASH' ) {
+ unless ( %$cursor ) {
+ $lines[-1] .= ' {}';
+ next;
+ }
+ push @lines, $self->_dump_hash( $cursor, $indent, {} );
+
+ } else {
+ die \("Cannot serialize " . ref($cursor));
+ }
}
+ };
+ if ( ref $@ eq 'SCALAR' ) {
+ $self->_error(${$@});
+ } elsif ( $@ ) {
+ $self->_error($@);
}
join '', map { "$_\n" } @lines;
}
-sub _write_scalar {
+sub _has_internal_string_value {
+ my $value = shift;
+ my $b_obj = B::svref_2object(\$value); # for round trip problem
+ return $b_obj->FLAGS & B::SVf_POK();
+}
+
+sub _dump_scalar {
my $string = $_[1];
+ my $is_key = $_[2];
+ # Check this before checking length or it winds up looking like a string!
+ my $has_string_flag = _has_internal_string_value($string);
return '~' unless defined $string;
return "''" unless length $string;
- if ( $string =~ /[\x00-\x08\x0b-\x0d\x0e-\x1f\"\'\n]/ ) {
+ if (Scalar::Util::looks_like_number($string)) {
+ # keys and values that have been used as strings get quoted
+ if ( $is_key || $has_string_flag ) {
+ return qq['$string'];
+ }
+ else {
+ return $string;
+ }
+ }
+ if ( $string =~ /[\x00-\x09\x0b-\x0d\x0e-\x1f\x7f-\x9f\'\n]/ ) {
$string =~ s/\\/\\\\/g;
$string =~ s/"/\\"/g;
$string =~ s/\n/\\n/g;
+ $string =~ s/[\x85]/\\N/g;
$string =~ s/([\x00-\x1f])/\\$UNPRINTABLE[ord($1)]/g;
+ $string =~ s/([\x7f-\x9f])/'\x' . sprintf("%X",ord($1))/ge;
return qq|"$string"|;
}
- if ( $string =~ /(?:^\W|\s|:\z)/ or $QUOTE{$string} ) {
+ if ( $string =~ /(?:^[~!@#%&*|>?:,'"`{}\[\]]|^-+$|\s|:\z)/ or
+ $QUOTE{$string}
+ ) {
return "'$string'";
}
return $string;
}
-sub _write_array {
+sub _dump_array {
my ($self, $array, $indent, $seen) = @_;
if ( $seen->{refaddr($array)}++ ) {
- die "CPAN::Meta::YAML does not support circular references";
+ 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 );
+ $line .= ' ' . $self->_dump_scalar( $el );
push @lines, $line;
} elsif ( $type eq 'ARRAY' ) {
if ( @$el ) {
push @lines, $line;
- push @lines, $self->_write_array( $el, $indent + 1, $seen );
+ push @lines, $self->_dump_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 );
+ push @lines, $self->_dump_hash( $el, $indent + 1, $seen );
} else {
$line .= ' {}';
push @lines, $line;
}
} else {
- die "CPAN::Meta::YAML does not support $type references";
+ die \"CPAN::Meta::YAML does not support $type references";
}
}
@lines;
}
-sub _write_hash {
+sub _dump_hash {
my ($self, $hash, $indent, $seen) = @_;
if ( $seen->{refaddr($hash)}++ ) {
- die "CPAN::Meta::YAML does not support circular references";
+ 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 $line = (' ' x $indent) . $self->_dump_scalar($name, 1) . ":";
my $type = ref $el;
if ( ! $type ) {
- $line .= ' ' . $self->_write_scalar( $el, $indent + 1 );
+ $line .= ' ' . $self->_dump_scalar( $el );
push @lines, $line;
} elsif ( $type eq 'ARRAY' ) {
if ( @$el ) {
push @lines, $line;
- push @lines, $self->_write_array( $el, $indent + 1, $seen );
+ push @lines, $self->_dump_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 );
+ push @lines, $self->_dump_hash( $el, $indent + 1, $seen );
} else {
$line .= ' {}';
push @lines, $line;
}
} else {
- die "CPAN::Meta::YAML does not support $type references";
+ die \"CPAN::Meta::YAML does not support $type references";
}
}
@lines;
}
+
+
+#####################################################################
+# DEPRECATED API methods:
+
+# Error storage (DEPRECATED as of 1.57)
+our $errstr = '';
+
# Set error
sub _error {
- $CPAN::Meta::YAML::errstr = $_[1];
- undef;
+ require Carp;
+ $errstr = $_[1];
+ $errstr =~ s/ at \S+ line \d+.*//;
+ Carp::croak( $errstr );
}
# Retrieve error
+my $errstr_warned;
sub errstr {
- $CPAN::Meta::YAML::errstr;
+ require Carp;
+ Carp::carp( "CPAN::Meta::YAML->errstr and \$CPAN::Meta::YAML::errstr is deprecated" )
+ unless $errstr_warned++;
+ $errstr;
}
-
#####################################################################
-# YAML Compatibility
-
-sub Dump {
- 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];
- }
-}
+# Helper functions. Possibly not needed.
-BEGIN {
- *freeze = *Dump;
- *thaw = *Load;
-}
-sub DumpFile {
- my $file = shift;
- CPAN::Meta::YAML->new(@_)->write($file);
-}
+# Use to detect nv or iv
+use B;
-sub LoadFile {
- my $self = CPAN::Meta::YAML->read($_[0]);
- unless ( $self ) {
- Carp::croak("Failed to load YAML document from '" . ($_[0] || '') . "'");
+# XXX-INGY Is flock CPAN::Meta::YAML's responsibility?
+# Some platforms can't flock :-(
+# XXX-XDG I think it is. When reading and writing files, we ought
+# to be locking whenever possible. People (foolishly) use YAML
+# files for things like session storage, which has race issues.
+my $HAS_FLOCK;
+sub _can_flock {
+ if ( defined $HAS_FLOCK ) {
+ return $HAS_FLOCK;
}
- if ( wantarray ) {
- return @$self;
- } else {
- # Return only the last document to match YAML.pm,
- return $self->[-1];
+ else {
+ require Config;
+ my $c = \%Config::Config;
+ $HAS_FLOCK = grep { $c->{$_} } qw/d_flock d_fcntl_can_lock d_lockf/;
+ require Fcntl if $HAS_FLOCK;
+ return $HAS_FLOCK;
}
}
-
-
-
+# XXX-INGY Is this core in 5.8.1? Can we remove this?
+# XXX-XDG Scalar::Util 1.18 didn't land until 5.8.8, so we need this
#####################################################################
# 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 ) {
+ if ( eval { require Scalar::Util }
+ && $Scalar::Util::VERSION
+ && eval($Scalar::Util::VERSION) >= 1.18
+ ) {
+ *refaddr = *Scalar::Util::refaddr;
+ }
+ else {
eval <<'END_PERL';
# Scalar::Util failed to load or too old
sub refaddr {
$pkg = undef;
}
"$_[0]" =~ /0x(\w+)/;
- my $i = do { local $^W; hex $1 };
+ my $i = do { no warnings 'portable'; hex $1 };
bless $_[0], $pkg if defined $pkg;
$i;
}
END_PERL
- } else {
- *refaddr = *Scalar::Util::refaddr;
}
}
+
+
+
1;
+# XXX-INGY Doc notes I'm putting up here. Changing the doc when it's wrong
+# but leaving grey area stuff up here.
+#
+# I would like to change Read/Write to Load/Dump below without
+# changing the actual API names.
+#
+# It might be better to put Load/Dump API in the SYNOPSIS instead of the
+# dubious OO API.
+#
+# null and bool explanations may be outdated.
+
=pod
-=encoding utf-8
+=encoding UTF-8
=head1 NAME
=head1 VERSION
-version 0.010
+version 0.011
=head1 SYNOPSIS
--- /dev/null
+# Testing of some API methods;
+
+use strict;
+use warnings;
+
+use lib 't/lib/';
+use Test::More 0.99;
+use TestBridge;
+use CPAN::Meta::YAML;
+
+subtest "default exports" => sub {
+ ok( defined(&Load), 'Found exported Load function' );
+ ok( defined(&Dump), 'Found exported Dump function' );
+ ok( \&main::Load == \&CPAN::Meta::YAML::Load, 'Load is CPAN::Meta::YAML' );
+ ok( \&main::Dump == \&CPAN::Meta::YAML::Dump, 'Dump is CPAN::Meta::YAML' );
+ ok( !defined(&LoadFile), 'LoadFile function not exported' );
+ ok( !defined(&DumpFile), 'DumpFile function not exported' );
+ ok( !defined(&freeze), 'freeze function not exported' );
+ ok( !defined(&thaw), 'thaw functiona not exported' );
+};
+
+subtest "all exports" => sub {
+ package main::all_exports;
+ use Test::More;
+ use CPAN::Meta::YAML qw/Load Dump LoadFile DumpFile freeze thaw/;
+ ok( defined(&Load), 'Found exported Load function' );
+ ok( defined(&Dump), 'Found exported Dump function' );
+ ok( defined(&LoadFile), 'Found exported LoadFile function' );
+ ok( defined(&DumpFile), 'Found exported DumpFile function' );
+ ok( defined(&freeze), 'Found exported freeze function' );
+ ok( defined(&thaw), 'Found exported thaw functiona' );
+};
+
+subtest "constructor and documents" => sub {
+ my @docs = ( { one => 'two' }, { three => 'four' } );
+ ok( my $yaml = CPAN::Meta::YAML->new( @docs ), "constructor" );
+ cmp_deeply( [ @$yaml ], \@docs, "the object is an arrayref of documents" );
+};
+
+done_testing;
use strict;
use warnings;
+use lib 't/lib';
BEGIN {
$| = 1;
- $^W = 1;
}
-use File::Spec::Functions ':ALL';
-use Test::More tests => 3;
+use Test::More 0.99;
# Check their perl version
-ok( $] >= 5.004, "Your perl is new enough" );
+ok( $] ge '5.008001', "Your perl is new enough" );
# Does the module load
-use_ok( 'CPAN::Meta::YAML' );
-use_ok( 't::lib::Test' );
+require_ok( 'CPAN::Meta::YAML' );
+require_ok( 'TestUtils' );
+require_ok( 'TestBridge' );
+require_ok( 'TestML::Tiny' );
+
+done_testing;
+++ /dev/null
-# Testing of basic document structures
-
-use strict;
-use warnings;
-
-BEGIN {
- $| = 1;
- $^W = 1;
-}
-
-use File::Spec::Functions ':ALL';
-use t::lib::Test;
-use Test::More tests(30);
-use CPAN::Meta::YAML;
-
-
-
-
-
-#####################################################################
-# Sample Testing
-
-# Test a completely empty document
-yaml_ok(
- '',
- [ ],
- 'empty',
-);
-
-# Just a newline
-### YAML.pm has a bug where it dies on a single newline
-yaml_ok(
- "\n\n",
- [ ],
- 'only_newlines',
-);
-
-# Just a comment
-yaml_ok(
- "# comment\n",
- [ ],
- 'only_comment',
-);
-
-# Empty documents
-yaml_ok(
- "---\n",
- [ undef ],
- 'only_header',
- noyamlperl => 1,
-);
-yaml_ok(
- "---\n---\n",
- [ undef, undef ],
- 'two_header',
- noyamlperl => 1,
-);
-yaml_ok(
- "--- ~\n",
- [ undef ],
- 'one_undef',
- noyamlperl => 1,
-);
-yaml_ok(
- "--- ~\n",
- [ undef ],
- 'one_undef2',
- noyamlperl => 1,
-);
-yaml_ok(
- "--- ~\n---\n",
- [ undef, undef ],
- 'two_undef',
- noyamlperl => 1,
-);
-
-# Just a scalar
-yaml_ok(
- "--- foo\n",
- [ 'foo' ],
- 'one_scalar',
-);
-yaml_ok(
- "--- foo\n",
- [ 'foo' ],
- 'one_scalar2',
-);
-yaml_ok(
- "--- foo\n--- bar\n",
- [ 'foo', 'bar' ],
- 'two_scalar',
- noyamlperl => 1,
-);
-
-# Simple lists
-yaml_ok(
- "---\n- foo\n",
- [ [ 'foo' ] ],
- 'one_list1',
-);
-yaml_ok(
- "---\n- foo\n- bar\n",
- [ [ 'foo', 'bar' ] ],
- 'one_list2',
-);
-yaml_ok(
- "---\n- ~\n- bar\n",
- [ [ undef, 'bar' ] ],
- 'one_listundef',
- noyamlperl => 1,
-);
-
-# Simple hashs
-yaml_ok(
- "---\nfoo: bar\n",
- [ { foo => 'bar' } ],
- 'one_hash1',
-);
-
-yaml_ok(
- "---\nfoo: bar\nthis: ~\n",
- [ { this => undef, foo => 'bar' } ],
- 'one_hash2',
- noyamlperl => 1,
-);
-
-# Simple array inside a hash with an undef
-yaml_ok(
- <<'END_YAML',
----
-foo:
- - bar
- - ~
- - baz
-END_YAML
- [ { foo => [ 'bar', undef, 'baz' ] } ],
- 'array_in_hash',
- noyamlperl => 1,
-);
-
-# Simple hash inside a hash with an undef
-yaml_ok(
- <<'END_YAML',
----
-foo: ~
-bar:
- foo: bar
-END_YAML
- [ { foo => undef, bar => { foo => 'bar' } } ],
- 'hash_in_hash',
- noyamlperl => 1,
-);
-
-# Mixed hash and scalars inside an array
-yaml_ok(
- <<'END_YAML',
----
--
- foo: ~
- this: that
-- foo
-- ~
--
- foo: bar
- this: that
-END_YAML
- [ [
- { 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',
-);
-yaml_ok(
- "---\n- ' '\n",
- [ [ ' ' ] ],
- 'single_spaces',
-);
-yaml_ok(
- "---\n- ''\n",
- [ [ '' ] ],
- 'single_null',
-);
-
-# Double quotes
-yaml_ok(
- "--- \" \"\n",
- [ ' ' ],
- "only_spaces",
- noyamlpm => 1,
- noyamlperl => 1,
-);
-
-yaml_ok(
- "--- \" 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',
-);
-yaml_ok(
- "- foo\n",
- [ [ 'foo' ] ],
- 'implicit_array',
-);
-
-# Inline nested hash
-yaml_ok(
- <<'END_YAML',
----
-- ~
-- foo: bar
- this: that
-- baz
-END_YAML
- [ [ 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',
-);
-
-yaml_ok(
- "---\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',
-);
+++ /dev/null
-# Testing of common META.yml examples
-
-use strict;
-use warnings;
-
-BEGIN {
- $| = 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
-};
-
-
-
-
-
-#####################################################################
-# Check Exports
-
-ok( defined(&Load), 'Found exported Load function' );
-ok( defined(&Dump), 'Found exported Dump function' );
-ok( defined(&LoadFile), 'Found exported LoadFile function' );
-ok( defined(&DumpFile), 'Found exported DumpFile function' );
-ok( defined(&freeze), 'Found exported freeze function' );
-ok( defined(&thaw), 'Found exported thaw functiona' );
-
-
-
-
-
-#####################################################################
-# In META.yml files, some hash keys contain module names
-
-# Hash key legally containing a colon
-yaml_ok(
- "---\nFoo::Bar: 1\n",
- [ { 'Foo::Bar' => 1 } ],
- 'module_hash_key',
-);
-
-# Hash indented
-yaml_ok(
- "---\n"
- . " foo: bar\n",
- [ { foo => "bar" } ],
- 'hash_indented',
-);
-
-
-
-
-
-#####################################################################
-# Support for literal multi-line scalars
-
-# Declarative multi-line scalar
-yaml_ok(
- "---\n"
- . " foo: >\n"
- . " bar\n"
- . " baz\n",
- [ { foo => "bar baz\n" } ],
- 'simple_multiline',
-);
-
-# Piped multi-line scalar
-yaml_ok(
- <<'END_YAML',
----
-- |
- foo
- bar
-- 1
-END_YAML
- [ [ "foo\nbar\n", 1 ] ],
- 'indented',
-);
-
-# ... with a pointless hyphen
-yaml_ok( <<'END_YAML',
----
-- |-
- foo
- bar
-- 1
-END_YAML
- [ [ "foo\nbar", 1 ] ],
- 'indented',
-);
-
-
-
-
-
-#####################################################################
-# Support for YAML version directives
-
-# Simple inline case (comment variant)
-yaml_ok(
- <<'END_YAML',
---- #YAML:1.0
-foo: bar
-END_YAML
- [ { foo => 'bar' } ],
- 'simple_doctype_comment',
- nosyck => 1,
-);
-
-# Simple inline case (percent variant)
-yaml_ok(
- <<'END_YAML',
---- %YAML:1.0
-foo: bar
-END_YAML
- [ { foo => 'bar' } ],
- 'simple_doctype_percent',
- noyamlpm => 1,
- noxs => 1,
- noyamlperl => 1,
-);
-
-# Simple header (comment variant)
-yaml_ok(
- <<'END_YAML',
-%YAML:1.0
----
-foo: bar
-END_YAML
- [ { foo => 'bar' } ],
- 'predocument_1_0',
- noyamlpm => 1,
- nosyck => 1,
- noxs => 1,
- noyamlperl => 1,
-);
-
-# Simple inline case (comment variant)
-yaml_ok(
- <<'END_YAML',
-%YAML 1.1
----
-foo: bar
-END_YAML
- [ { foo => 'bar' } ],
- 'predocument_1_1',
- noyamlpm => 1,
- nosyck => 1,
- noyamlperl => 1,
-);
-
-# Multiple inline documents (comment variant)
-yaml_ok(
- <<'END_YAML',
---- #YAML:1.0
-foo: bar
---- #YAML:1.0
-- 1
---- #YAML:1.0
-foo: bar
-END_YAML
- [ { foo => 'bar' }, [ 1 ], { foo => 'bar' } ],
- 'multi_doctype_comment',
-);
-
-# Simple pre-document case (comment variant)
-yaml_ok(
- <<'END_YAML',
-%YAML 1.1
----
-foo: bar
-END_YAML
- [ { foo => 'bar' } ],
- 'predocument_percent',
- noyamlpm => 1,
- nosyck => 1,
- noyamlperl => 1,
-);
-
-# Simple pre-document case (comment variant)
-yaml_ok(
- <<'END_YAML',
-#YAML 1.1
----
-foo: bar
-END_YAML
- [ { foo => 'bar' } ],
- 'predocument_comment',
-);
-
-
-
-
-
-#####################################################################
-# Hitchhiker Scalar
-
-yaml_ok(
- <<'END_YAML',
---- 42
-END_YAML
- [ 42 ],
- 'hitchhiker scalar',
- serializes => 1,
-);
-
-
-
-
-
-#####################################################################
-# Null HASH/ARRAY
-
-yaml_ok(
- <<'END_YAML',
----
-- foo
-- {}
-- bar
-END_YAML
- [ [ 'foo', {}, 'bar' ] ],
- 'null hash in array',
-);
-
-yaml_ok(
- <<'END_YAML',
----
-- foo
-- []
-- bar
-END_YAML
- [ [ 'foo', [], 'bar' ] ],
- 'null array in array',
-);
-
-yaml_ok(
- <<'END_YAML',
----
-foo: {}
-bar: 1
-END_YAML
- [ { foo => {}, bar => 1 } ],
- 'null hash in hash',
-);
-
-yaml_ok(
- <<'END_YAML',
----
-foo: []
-bar: 1
-END_YAML
- [ { foo => [], bar => 1 } ],
- 'null array in hash',
-);
-
-
-
-
-#####################################################################
-# Trailing Whitespace
-
-yaml_ok(
- <<'END_YAML',
----
-abstract: Generate fractal curves
-foo: ~
-arr:
- - foo
- - ~
- - 'bar'
-END_YAML
- [ {
- abstract => 'Generate fractal curves',
- foo => undef,
- arr => [ 'foo', undef, 'bar' ],
- } ],
- 'trailing whitespace',
- noyamlperl => 1,
-);
-
-
-
-
-
-#####################################################################
-# Quote vs Hash
-
-yaml_ok(
- <<'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',
-);
-
-
-
-
-
-#####################################################################
-# Quote and Escaping Idiosyncracies
-
-yaml_ok(
- <<'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',
-);
-
-yaml_ok(
- <<'END_YAML',
----
-slash1: '\\'
-slash2: '\\foo'
-slash3: '\\foo\\\\'
-END_YAML
- [ {
- slash1 => "\\\\",
- slash2 => "\\\\foo",
- slash3 => "\\\\foo\\\\\\\\",
- } ],
- 'single quote subtleties',
-);
-
-
-
-
-
-#####################################################################
-# Empty Values and Premature EOF
-
-yaml_ok(
- <<'END_YAML',
----
-foo: 0
-requires:
-build_requires:
-END_YAML
- [ { foo => 0, requires => undef, build_requires => undef } ],
- 'empty hash keys',
- noyamlpm => 1,
- noyamlperl => 1,
-);
-
-yaml_ok(
- <<'END_YAML',
----
-- foo
--
--
-END_YAML
- [ [ 'foo', undef, undef ] ],
- 'empty array keys',
- noyamlpm => 1,
- noyamlperl => 1,
-);
-
-
-
-
-
-#####################################################################
-# Comment on the Document Line
-
-yaml_ok(
- <<'END_YAML',
---- # Comment
-foo: bar
-END_YAML
- [ { foo => 'bar' } ],
- 'comment header',
- noyamlpm => 1,
- noyamlperl => 1,
-);
-
-
-
-
-
-
-#####################################################################
-# Newlines and tabs
-
-yaml_ok(
- <<'END_YAML',
-foo: "foo\\\n\tbar"
-END_YAML
- [ { 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',
- );
-}
-
-
-
-
-
-#####################################################################
-# Confirm we can read the synopsis
-
-yaml_ok(
- <<'END_YAML',
----
-rootproperty: blah
-section:
- one: two
- three: four
- Foo: Bar
- empty: ~
-END_YAML
- [ {
- rootproperty => 'blah',
- section => {
- one => 'two',
- three => 'four',
- Foo => 'Bar',
- empty => undef,
- },
- } ],
- 'synopsis',
- noyamlperl => 1,
-);
-
-
-
-
-
-#####################################################################
-# Unprintable Characters
-
-yaml_ok(
- "--- \"foo\\n\\x00\"\n",
- [ "foo\n\0" ],
- 'unprintable',
-);
-
-
-
-
-
-#####################################################################
-# Empty Quote Line
-
-yaml_ok(
- <<'END_YAML',
----
-- foo
-#
-- bar
-END_YAML
- [ [ "foo", "bar" ] ],
-);
-
-
-
-
-
-#####################################################################
-# Indentation after empty hash value
-
-yaml_ok(
- <<'END_YAML',
----
-Test:
- optmods:
- Bad: 0
- Foo: 1
- Long: 0
- version: 5
-Test_IncludeA:
- optmods:
-Test_IncludeB:
- optmods:
-_meta:
- 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,
-);
-
-
-
-
-
-#####################################################################
-# Spaces in the Key
-
-yaml_ok(
- <<'END_YAML',
----
-the key: the value
-END_YAML
- [ { 'the key' => 'the value' } ],
-);
-
-
-
-
-
-#####################################################################
-# Ticker #32402
-
-# Tests a particular pathological case
-
-yaml_ok(
- <<'END_YAML',
----
-- value
-- '><'
-END_YAML
- [ [ 'value', '><' ] ],
- 'Pathological >< case',
-);
-
-
-
-
-
-#####################################################################
-# Special Characters
-
-#yaml_ok(
-# <<'END_YAML',
-#---
-#- "Ingy d\xC3\xB6t Net"
-#END_YAML
-# [ [ "Ingy d\xC3\xB6t Net" ] ],
-#);
-
-
-
-
-
-
-######################################################################
-# Non-Indenting Sub-List
-
-yaml_ok(
- <<'END_YAML',
----
-foo:
-- list
-bar: value
-END_YAML
- [ { foo => [ 'list' ], bar => 'value' } ],
- 'Non-indenting sub-list',
- noyamlpm => 1,
- noyamlperl => 1,
-);
-
-
-
-
-
-
-#####################################################################
-# Check Multiple-Escaping
-
-# RT #42119: write of two single quotes
-yaml_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',
-);
-
-# Escapes with whitespace
-yaml_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',
-);
-yaml_ok(
- "--- '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',
-);
-
-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
-} ] )->write_string, <<'END_YAML' );
----
-- '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'
-END_YAML
-
-
-
-
-
-######################################################################
-# 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',
-);
+++ /dev/null
-# Testing of basic document structures
-
-use strict;
-use warnings;
-
-BEGIN {
- $| = 1;
- $^W = 1;
-}
-
-use Test::More tests => 6;
-use CPAN::Meta::YAML;
-
-
-
-ok defined &main::Load, 'Load is exported';
-ok defined &main::Dump, 'Dump is exported';
-ok not(defined &main::LoadFile), 'Load is exported';
-ok not(defined &main::DumpFile), 'Dump is exported';
-
-ok \&main::Load == \&CPAN::Meta::YAML::Load, 'Load is CPAN::Meta::YAML';
-ok \&main::Dump == \&CPAN::Meta::YAML::Dump, 'Dump is CPAN::Meta::YAML';
--- /dev/null
+use strict;
+use warnings;
+use utf8;
+use lib 't/lib/';
+use Test::More 0.99;
+use TestUtils;
+use TestBridge;
+
+use CPAN::Meta::YAML;
+
+#--------------------------------------------------------------------------#
+# read() should read these files without error
+#--------------------------------------------------------------------------#
+
+my %passes = (
+ array => {
+ file => 'ascii.yml',
+ perl => [
+ [ 'foo' ]
+ ],
+ },
+ 'multibyte UTF-8' => {
+ file => 'multibyte.yml',
+ perl => [
+ { author => 'Ævar Arnfjörð Bjarmason <avar@cpan.org>' }
+ ],
+ utf8 => 'author',
+ },
+ 'UTF-8 BOM' => {
+ file => 'utf_8_bom.yml',
+ perl => [
+ { author => 'Ævar Arnfjörð Bjarmason <avar@cpan.org>' }
+ ],
+ utf8 => 'author',
+ },
+);
+
+for my $key ( sort keys %passes ) {
+ subtest $key => sub {
+ my $case = $passes{$key};
+ my $file = test_data_file( $case->{file} );
+ ok( -f $file, "Found $case->{file}" );
+
+ my $got = eval { CPAN::Meta::YAML->read( $file ) };
+ is( $@, '', "CPAN::Meta::YAML reads without exception" );
+ SKIP: {
+ skip( "Shortcutting after failure", 2 ) if $@;
+ isa_ok( $got, 'CPAN::Meta::YAML' )
+ or diag "ERROR: " . CPAN::Meta::YAML->errstr;
+ cmp_deeply( $got, $case->{perl}, "CPAN::Meta::YAML parses correctly" );
+ }
+
+ if ( $case->{utf8} ) {
+ ok( utf8::is_utf8( $got->[0]->{$case->{utf8}} ), "utf8 decoded" );
+ }
+
+ # test that read method on object is also a constructor
+ ok( my $got2 = eval { $got->read( $file ) }, "read() object method");
+ isnt( $got, $got2, "objects are different" );
+ cmp_deeply( $got, $got2, "objects have same content" );
+ }
+}
+
+#--------------------------------------------------------------------------#
+# read() should fail to read these files and provide expected errors
+#--------------------------------------------------------------------------#
+
+my %errors = (
+ 'latin1.yml' => qr/latin1\.yml.*does not map to Unicode/,
+ 'utf_16_le_bom.yml' => qr/utf_16_le_bom\.yml.*does not map to Unicode/,
+);
+
+for my $key ( sort keys %errors ) {
+ subtest $key => sub {
+ my $file = test_data_file( $key );
+ ok( -f $file, "Found $key" );
+
+ my $result = eval { CPAN::Meta::YAML->read( $file ) };
+ ok( !$result, "returned false" );
+ error_like( $errors{$key}, "Got expected error" );
+ };
+}
+
+# Additional errors without a file to read
+
+subtest "bad read arguments" => sub {
+ eval { CPAN::Meta::YAML->read(); };
+ error_like(qr/You did not specify a file name/,
+ "Got expected error: no filename provided to read()"
+ );
+
+ eval { CPAN::Meta::YAML->read( test_data_file('nonexistent.yml') ); };
+ error_like(qr/File '.*?' does not exist/,
+ "Got expected error: nonexistent filename provided to read()"
+ );
+
+ eval { CPAN::Meta::YAML->read( test_data_directory() ); };
+ error_like(qr/'.*?' is a directory, not a file/,
+ "Got expected error: directory provided to read()"
+ );
+};
+
+done_testing;
+#
+# This file is part of CPAN-Meta-YAML
+#
+# This software is copyright (c) 2010 by Adam Kennedy.
+#
+# This is free software; you can redistribute it and/or modify it under
+# the same terms as the Perl 5 programming language system itself.
+#
+# vim: ts=4 sts=4 sw=4 et:
+++ /dev/null
-# Testing of common META.yml examples
-
-use strict;
-use warnings;
-
-BEGIN {
- $| = 1;
- $^W = 1;
-}
-
-use File::Spec::Functions ':ALL';
-use t::lib::Test;
-use Test::More tests(8, 3);
-use CPAN::Meta::YAML;
-
-
-
-
-
-#####################################################################
-# Testing CPAN::Meta::YAML's own META.yml file
-
-yaml_ok(
- <<'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:
- - inc
- - t
-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',
-);
-
-
-
-
-
-
-#####################################################################
-# Testing a META.yml from a commercial project that crashed
-
-yaml_ok(
- <<'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
-version: 0.01
-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
-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',
-);
-
-
-
-
-
-
-#####################################################################
-# Testing various failing META.yml files from CPAN
-
-yaml_ok(
- <<'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:
- - 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
-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',
-);
-
-yaml_ok(
- <<'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
-version: 2.106
-version_from: Baby.pm
-installdirs: site
-requires:
- warnings:
-
-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,
-);
-
-
-
-
-
-#####################################################################
-# File with a YAML header
-
-yaml_ok(
- <<'END_YAML',
---- #YAML:1.0
-name: Data-Swap
-version: 0.05
-license: perl
-distribution_type: module
-requires:
- 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,
-);
-
-
-
-
-
-#####################################################################
-# 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,
- );
-}
-
-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,
- );
-}
-
-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,
- );
-}
--- /dev/null
+use strict;
+use warnings;
+use lib 't/lib/';
+use Test::More 0.99;
+use TestUtils;
+use TestBridge;
+
+use CPAN::Meta::YAML ();
+
+#--------------------------------------------------------------------------#
+# Generally, read_string can be tested with .tml files in t/tml-local/*
+#
+# This file is for error tests that can't be easily tested via .tml
+#--------------------------------------------------------------------------#
+
+subtest 'read_string without arg' => sub {
+ eval { CPAN::Meta::YAML->read_string(); };
+ error_like(qr/Did not provide a string to load/,
+ "Got expected error: no string provided to read_string()"
+ );
+};
+
+subtest 'YAML without newline' => sub {
+ my $str = join("\n" => ('---', '- foo', '---', '- bar', '---'));
+ my $obj = eval { CPAN::Meta::YAML->read_string($str); };
+ is( $@, '', "YAML without newline is OK");
+};
+
+subtest 'read_string as object method' => sub {
+ ok( my $obj = CPAN::Meta::YAML->new( { foo => 'bar' } ), "new YAML object" );
+ ok( my $obj2 = $obj->read_string( "---\nfoo: bar\n" ),
+ "read_string object method"
+ );
+ isnt( $obj, $obj2, "objects are different" );
+ cmp_deeply( $obj, $obj2, "objects have same content" );
+};
+
+subtest 'invalid UTF-8' => sub {
+ # get invalid UTF-8 by reading Latin-1 with lax :utf8 layer
+ my $string = do {
+ local $SIG{__WARN__} = sub {};
+ slurp( test_data_file('latin1.yml'), ":utf8" );
+ };
+ my $obj = eval { CPAN::Meta::YAML->read_string($string); };
+ is( $obj, undef, "read_string should return undef" );
+ error_like( qr/invalid UTF-8 string/,
+ "Got expected error about invalid UTF-8 string"
+ );
+};
+
+done_testing;
+++ /dev/null
-# Testing Plagger config samples from Miyagawa-san's YAPC::NA 2006 talk
-
-use strict;
-use warnings;
-
-BEGIN {
- $| = 1;
- $^W = 1;
-}
-
-use File::Spec::Functions ':ALL';
-use t::lib::Test;
-use Test::More tests(2);
-use CPAN::Meta::YAML;
-
-
-
-
-
-#####################################################################
-# Example Plagger Configuration 1
-
-yaml_ok(
- <<'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
-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',
-);
-
-
-
-
-
-#####################################################################
-# Example Plagger Configuration 2
-
-yaml_ok(
- <<'END_YAML',
-plugins:
- - module: Subscription::Config
- config:
- feed:
- # Trac's feed for changesets
- - http://plagger.org/.../rss
-
- # I don't like to be notified of the same items
- # more than once
- - 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'
-
-
-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',
-);
--- /dev/null
+use utf8;
+use strict;
+use warnings;
+use lib 't/lib/';
+use Test::More 0.99;
+use TestBridge;
+use TestUtils;
+
+use CPAN::Meta::YAML;
+use File::Basename qw/basename/;
+use File::Temp qw/tempfile/;
+
+#--------------------------------------------------------------------------#
+# Error conditions
+#--------------------------------------------------------------------------#
+
+subtest 'no filename for write()' => sub {
+ my $obj = CPAN::Meta::YAML->new();
+ eval { $obj->write(); };
+ error_like( qr/You did not specify a file name/,
+ "No filename provided to write()"
+ );
+};
+
+#--------------------------------------------------------------------------#
+# Test that write uses correct encoding and can round-trip
+#--------------------------------------------------------------------------#
+
+my @cases = (
+ { label => "ascii", name => "Mengue" },
+ { label => "latin1", name => "Mengué" },
+ { label => "wide", name => "あ" },
+);
+
+my @warnings;
+local $SIG{__WARN__} = sub { push @warnings, $_[0] };
+
+# CPAN::Meta::YAML doesn't preserve order in the file, so we can't actually check
+# file equivalence. We have to see if we can round-trip a data structure
+# from Perl to YAML and back.
+for my $c ( @cases ) {
+ subtest "write $c->{label} characters" => sub {
+ my $data;
+ @warnings = ();
+
+ # get a tempfile name to write to
+ my ($fh, $tempfile) = tempfile("YAML-Tiny-test-XXXXXXXX", TMPDIR => 1 );
+ my $short_tempfile = basename($tempfile);
+ close $fh; # avoid locks on windows
+
+ # CPAN::Meta::YAML->write
+ ok( CPAN::Meta::YAML->new($c)->write($tempfile),
+ "case $c->{label}: write $short_tempfile" )
+ or diag "ERROR: " . CPAN::Meta::YAML->errstr;
+
+ # CPAN::Meta::YAML->read
+ ok( $data = eval { CPAN::Meta::YAML->read( $tempfile ) },
+ "case $c->{label}: read $short_tempfile" )
+ or diag "ERROR: " . CPAN::Meta::YAML->errstr;
+ is( $@, '', "no error caught" );
+ SKIP : {
+ skip "no data read", 1 unless $data;
+ cmp_deeply( $data, [ $c ],
+ "case $c->{label}: Perl -> File -> Perl roundtrip" );
+ }
+
+ # CPAN::Meta::YAML->read_string on UTF-8 decoded data
+ ok( $data = eval { CPAN::Meta::YAML->read_string( slurp($tempfile, ":utf8") ) },
+ "case $c->{label}: read_string on UTF-8 decoded $short_tempfile" );
+ is( $@, '', "no error caught" );
+ SKIP : {
+ skip "no data read", 1 unless $data;
+ cmp_deeply( $data, [ $c ],
+ "case $c->{label}: Perl -> File -> Decoded -> Perl roundtrip" );
+ }
+
+ is( scalar @warnings, 0, "case $c->{label}: no warnings caught" )
+ or diag @warnings;
+ }
+}
+
+done_testing;
+++ /dev/null
-# Testing of common META.yml examples
-
-use strict;
-use warnings;
-
-BEGIN {
- $| = 1;
- $^W = 1;
-}
-
-use File::Spec::Functions ':ALL';
-use t::lib::Test;
-use Test::More tests(1, 1);
-use CPAN::Meta::YAML;
-
-
-
-
-
-#####################################################################
-# Testing that Perl::Smith config files work
-
-my $vanilla_file = catfile( test_data_directory(), 'vanilla.yml' );
-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,
-);
--- /dev/null
+use strict;
+use warnings;
+use lib 't/lib/';
+use Test::More 0.99;
+use TestUtils;
+use TestBridge;
+
+use CPAN::Meta::YAML ();
+
+#--------------------------------------------------------------------------#
+# Generally, write_string can be tested with .tml files in t/tml-local/*
+#
+# This file is for error tests or conditions that can't be easily tested
+# via .tml
+#--------------------------------------------------------------------------#
+
+subtest 'write_string as class method' => sub {
+ my $got = eval { CPAN::Meta::YAML->write_string };
+ is( $@, '', "write_string lives" );
+ is( $got, '', "returns empty string" );
+};
+
+done_testing;
+++ /dev/null
-# Testing of common META.yml examples
-
-use strict;
-use warnings;
-
-BEGIN {
- $| = 1;
- $^W = 1;
-}
-
-use File::Spec::Functions ':ALL';
-use t::lib::Test;
-use Test::More tests(1, 1);
-use CPAN::Meta::YAML;
-
-
-
-
-
-#####################################################################
-# Testing that Perl::Smith config files work
-
-my $sample_file = catfile( test_data_directory(), 'sample.yml' );
-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',
-Late afternoon is best. Backup contact is Nancy Billsmer @ 338-4338.
-END_TEXT
- } ],
- 'sample.yml',
- # nosyck => 1,
-);
+++ /dev/null
-# Testing of META.yml containing AVAR's name
-
-use strict;
-use warnings;
-
-BEGIN {
- $| = 1;
- $^W = 1;
-}
-
-use File::Spec::Functions ':ALL';
-use t::lib::Test;
-use Test::More tests(0, 1, 6);
-use CPAN::Meta::YAML;
-
-
-
-
-
-#####################################################################
-# Testing that Perl::Smith config files work
-
-my $sample_file = catfile( test_data_directory(), 'multibyte.yml' );
-my $sample = load_ok( 'multibyte.yml', $sample_file, 450 );
-
-# Does the string parse to the structure
-my $name = "multibyte";
-my $yaml_copy = $sample;
-my $yaml = eval { CPAN::Meta::YAML->read_string( $yaml_copy ); };
-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: {
- 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" );
-}
+++ /dev/null
-# Testing for null references
-
-use strict;
-use warnings;
-
-BEGIN {
- $| = 1;
- $^W = 1;
-}
-
-use File::Spec::Functions ':ALL';
-use t::lib::Test;
-use Test::More tests(1);
-use CPAN::Meta::YAML;
-
-
-
-
-
-#####################################################################
-# Example Empty References
-
-yaml_ok(
- <<'END_YAML',
---- []
---- {}
-END_YAML
- [ [], {} ],
- 'Empty references',
-);
+++ /dev/null
-# Testing of a known-bad file from an editor
-
-use strict;
-use warnings;
-
-BEGIN {
- $| = 1;
- $^W = 1;
-}
-
-use File::Spec::Functions ':ALL';
-use t::lib::Test;
-# use Test::More skip_all => 'Temporarily ignoring failing test';
-use Test::More tests(1, 1);
-use CPAN::Meta::YAML;
-
-
-
-
-
-#####################################################################
-# Testing that Perl::Smith config files work
-
-my $toolbar_file = catfile( test_data_directory(), 'toolbar.yml' );
-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,
-);
+++ /dev/null
-# Testing relating to functionality in the Test Anything Protocol
-
-use strict;
-use warnings;
-
-BEGIN {
- $| = 1;
- $^W = 1;
-}
-
-use File::Spec::Functions ':ALL';
-use t::lib::Test;
-use Test::More tests(5, 0, 0);
-use CPAN::Meta::YAML ();
-
-
-
-
-
-#####################################################################
-# TAP Tests
-
-# Make sure we support x-foo keys
-yaml_ok(
- "---\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,
-);
-
-# Document ending (array)
-yaml_ok(
- "---\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,
-);
-
-# Multiple documents (whitespace-separated)
-yaml_ok(
- "---\n"
- . "- foo\n"
- . "...\n"
- . "\n"
- . "---\n"
- . "- foo\n"
- . "...\n",
- [ [ 'foo' ], [ 'foo' ] ],
- 'multi_document_space',
- noyamlpm => 1,
- noyamlperl => 1,
-);
+++ /dev/null
-# Testing documents that should fail
-
-use strict;
-use warnings;
-
-BEGIN {
- $| = 1;
- $^W = 1;
-}
-
-use File::Spec::Functions ':ALL';
-use t::lib::Test;
-use Test::More tests => 20;
-use CPAN::Meta::YAML ();
-
-my $FEATURE = 'does not support a feature';
-my $PLAIN = 'illegal characters in plain scalar';
-
-
-
-
-
-#####################################################################
-# Syntactic Errors
-
-yaml_error( <<'END_YAML', $FEATURE );
-- 'Multiline
-quote'
-END_YAML
-
-yaml_error( <<'END_YAML', $FEATURE );
-- "Multiline
-quote"
-END_YAML
-
-yaml_error( <<'END_YAML', $FEATURE );
----
-version: !!perl/hash:version
- original: v2.0.2
- qv: 1
- version:
- - 2
- - 0
- - 2
-END_YAML
-
-yaml_error( <<'END_YAML', $PLAIN );
-- - 2
-END_YAML
-
-yaml_error( <<'END_YAML', $PLAIN );
-foo: -
-END_YAML
-
-yaml_error( <<'END_YAML', $PLAIN );
-foo: @INC
-END_YAML
-
-yaml_error( <<'END_YAML', $PLAIN );
-foo: %INC
-END_YAML
-
-yaml_error( <<'END_YAML', $PLAIN );
-foo: bar:
-END_YAML
-
-yaml_error( <<'END_YAML', $PLAIN );
-foo: bar: baz
-END_YAML
-
-yaml_error( <<'END_YAML', $PLAIN );
-foo: `perl -V`
-END_YAML
# Testing documents that should fail
-
use strict;
use warnings;
-
-BEGIN {
- $| = 1;
- $^W = 1;
-}
+use lib 't/lib/';
+use Test::More 0.99;
+use TestUtils;
use File::Spec::Functions ':ALL';
-use t::lib::Test;
-use Test::More tests => 1;
-
-
@ISA = 'CPAN::Meta::YAML';
}
- sub _write_scalar {
+ # XXX-INGY subclasses should not use private methods… or if they
+ # do they should expect method name changes.
+ # sub _write_scalar {
+
+ sub _dump_scalar {
my $self = shift;
my $string = shift;
- my $indent = shift;
- if ( defined $indent ) {
- return "'$indent'";
+ my $is_key = shift;
+ if ( defined $is_key ) {
+ return scalar reverse $string;
} else {
- return 'undef';
+ return $string;
}
}
my $object = Foo->new(
{ foo => 'bar' }
);
-is( $object->write_string, "---\nfoo: '1'\n", 'Subclassing works' );
+is( $object->write_string, "---\noof: bar\n", 'Subclassing works' );
+
+done_testing;
+++ /dev/null
-use strict;
-use warnings;
-
-BEGIN {
- $| = 1;
- $^W = 1;
-}
-
-use File::Spec::Functions ':ALL';
-use t::lib::Test;
-use Test::More tests(0, 1, 4);
-use CPAN::Meta::YAML;
-
-
-
-
-
-#####################################################################
-# Testing that Perl::Smith config files work
-
-my $sample_file = catfile( 't', 'data', 'utf_16_le_bom.yml' );
-my $sample = load_ok( 'utf_16_le_bom.yml', $sample_file, 3 );
-
-# Does the string parse to the structure
-my $name = "utf-16";
-my $yaml_copy = $sample;
-my $yaml = eval { CPAN::Meta::YAML->read_string( $yaml_copy ); };
-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" );
-}
--- /dev/null
+use strict;
+use warnings;
+use lib 't/lib/';
+use Test::More 0.99;
+use TestBridge;
+use File::Temp qw(tempfile);
+
+#--------------------------------------------------------------------------#
+# This file test that the YAML.pm compatible Dump/Load/DumpFile/LoadFile
+# work as documented
+#--------------------------------------------------------------------------#
+
+use CPAN::Meta::YAML;
+
+{
+ my $scalar = 'this is a string';
+ my $arrayref = [ 1 .. 5 ];
+ my $hashref = { alpha => 'beta', gamma => 'delta' };
+
+ my $yamldump = CPAN::Meta::YAML::Dump( $scalar, $arrayref, $hashref );
+ my @yamldocsloaded = CPAN::Meta::YAML::Load($yamldump);
+ cmp_deeply(
+ [ @yamldocsloaded ],
+ [ $scalar, $arrayref, $hashref ],
+ "Functional interface: Dump to Load roundtrip works as expected"
+ );
+}
+
+{
+ my $scalar = 'this is a string';
+ my $arrayref = [ 1 .. 5 ];
+ my $hashref = { alpha => 'beta', gamma => 'delta' };
+
+ my ($fh, $filename) = tempfile;
+ close $fh; # or LOCK_SH will hang
+
+ my $rv = CPAN::Meta::YAML::DumpFile(
+ $filename, $scalar, $arrayref, $hashref);
+ ok($rv, "DumpFile returned true value");
+
+ my @yamldocsloaded = CPAN::Meta::YAML::LoadFile($filename);
+ cmp_deeply(
+ [ @yamldocsloaded ],
+ [ $scalar, $arrayref, $hashref ],
+ "Functional interface: DumpFile to LoadFile roundtrip works as expected"
+ );
+}
+
+{
+ my $str = "This is not real YAML";
+ my @yamldocsloaded;
+ eval { @yamldocsloaded = CPAN::Meta::YAML::Load("$str\n"); };
+ error_like(
+ qr/CPAN::Meta::YAML failed to classify line '$str'/,
+ "Correctly failed to load non-YAML string"
+ );
+}
+
+done_testing;
+++ /dev/null
-# 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;
-}
-
-use File::Spec::Functions ':ALL';
-use t::lib::Test;
-use Test::More tests(2);
-use CPAN::Meta::YAML;
-
-
-
-
-
-#####################################################################
-# Main Tests
-
-yaml_ok(
- <<'END_YAML',
----
-a: b#content
-c: d #comment
-e:
-- f #comment
-- g# content
-h: 'single' # comment
-h2: 'single # content' # comment
-i: "double" # comment
-i2: "double # content" # comment
-j: | # comment
- literal # content
- block # content
-k: {} # comment
-l: [] # 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,
-);
-
-# Repeat, with otherwise illegal characters in the comments
-yaml_ok(
- <<'END_YAML',
----
-a: b#content
-c: d #comment '"!&@%`
-e:
-- f #comment '"!&@%`
-- g# content
-h: 'single' # comment '"!&@%`
-h2: 'single # content' # comment '"!&@%`
-i: "double" # comment '"!&@%`
-i2: "double # content" # comment '"!&@%`
-j: | # comment '"!&@%`
- literal # content
- block # content
-k: {} # comment '"!&@%`
-l: [] # 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,
-);
--- /dev/null
+# Run the appropriate tests from https://github.com/ingydotnet/yaml-spec-tml
+use strict;
+use warnings;
+use lib 't/lib/';
+use Test::More 0.99;
+use TestBridge;
+use TestUtils;
+
+my $JSON = json_class()
+ or Test::More::plan skip_all => "no JSON or JSON::PP";
+
+# Each spec test will need a different bridge and arguments:
+my @spec_tests = (
+ ['t/tml-spec/basic-data.tml', 'test_yaml_json', $JSON],
+ # This test is currently failing massively. We use LAST to only run what is
+ # covered so far.
+ ['t/tml-spec/unicode.tml', 'test_code_point'],
+);
+
+for my $test (@spec_tests) {
+ my ($file, $bridge, @args) = @$test;
+ my $code = sub {
+ my ($file, $blocks) = @_;
+ subtest "YAML Spec Test; file: $file" => sub {
+ plan tests => scalar @$blocks;
+ my $func = \&{$bridge};
+ $func->($_) for @$blocks;
+ };
+ };
+ run_testml_file($file, $code, @args);
+}
+
+done_testing;
--- /dev/null
+use strict;
+use warnings;
+use lib 't/lib/';
+use Test::More 0.99;
+use TestBridge;
+use IO::Dir;
+use File::Spec::Functions qw/catdir/;
+
+my $tml_local = "t/tml-local";
+
+for my $dir ( IO::Dir->new($tml_local)->read ) {
+ next if $dir =~ /^\./;
+ my $fn = "test_$dir";
+ $fn =~ s/-/_/g;
+ my $bridge = TestBridge->can($fn);
+ next unless $bridge;
+ run_all_testml_files( "TestML", catdir($tml_local, $dir), $bridge );
+}
+
+done_testing;
--- /dev/null
+use strict;
+use warnings;
+use lib 't/lib/';
+use Test::More 0.99;
+use TestBridge;
+
+run_all_testml_files(
+ "Real-world examples", 't/tml-world', \&test_yaml_roundtrip
+);
+
+done_testing;
--- /dev/null
+# Guide to CPAN::Meta::YAML testing
+
+CPAN::Meta::YAML tests use several components:
+
+* .t files
+* Test libraries in t/lib
+* YAML data files in t/data
+* TestML data files in t/tml-*
+
+The use of each is described below.
+
+## .t files
+
+The .t files are standard Perl test files. They may use one or more of the
+test libraries in t/lib. They may only use modules available in Perl 5.8.1 or
+later (and not subsequently deprecated), but they may use newer non-XS versions
+of those modules as necessary to avoid known bugs.
+
+Some .t files have complete inputs/outputs for their tests. Others iterate
+over .tml files in the t/tml-* directories.
+
+A .t file should load Test::More and either use `done_testing` or provide a
+test plan. If tests iterate over external data, the use of `done_testing` is
+preferred so that external data can be updated with new tests without needing
+to also update a test plan.
+
+Currently, the convention is to name .t files matching the pattern
+qr/^\d\d_\w+\.t$/
+
+## Test libraries
+
+There are currently three test libraries in t/lib. A .t file that uses one or
+more of them should put `use lib 't/lib';` at the top of the .t file. Test
+libraries can assume that if they were loaded, that 't/lib' is already in @INC.
+
+The test libraries are:
+
+* TestML::Tiny
+* TestBridge
+* TestUtils
+
+The TestML::Tiny library contains functions for parsing and executing TestML
+tests with callbacks. TestML is a data-driven testing language; TestML::Tiny
+implements a small subset of its features. See the section on TestML, below,
+for an example. Generally, bugs should be patched upstream on CPAN and then
+a new Test::Tiny CPAN release can be copied here and pod-stripped.
+
+The TestBridge library contains testing functions for use in .t files or to
+be passed to TestML::Tiny functions as callbacks. Test functions should not
+include `done_testing`. They should use `subtest` for any repetitive testing
+that loops over test cases. Callback should check for the expected test
+points (see below) and skip a TML block if those points are not available.
+
+The TestUtils library contains utility functions. Testing functions should
+not be added here (i.e. nothing that uses Test::More).
+
+## YAML data files in t/data
+
+Files in the t/data directory are intended to test how YAML files are loaded
+and decoded and typically need some custom test code to load the file and see
+if the result matches expectations (successful or not).
+
+If a real-world YAML file cannot be loaded due to character set encoding
+issues, it should be placed in this directory for testing. If a real-world
+YAML file is ASCII or UTF-8 encoded, can be decoded successfully, but has
+problems in parsing, it should be reduced to the smallest sample of YAML that
+demonstrates the parsing problem and added to a .tml file for testing. See
+below for more details.
+
+## TestML quick intro
+
+TestML data files are UTF-8 encoded files with a .tml suffix that contain one
+or more test "blocks". Each block has a test label, and one or more 'test
+points', usually representing input and expected output, and possibly
+additional annotations or flags.
+
+Here is an example of a .tml file with a single block:
+
+ # This is a TestML block: (this line is a comment)
+ === This is the test label
+ Lines until the first point are ignored
+
+ # This is a "block" style point. All non-comment lines until next point
+ # are the data for the 'yaml' point. The data ends with newline, and
+ # trailing blank lines are trimmed.
+ --- yaml
+ ---
+ foo: bar
+ # a comment
+ \# not a comment
+
+ # This is the second point; "inline" style. The data after the colon goes
+ # to end of line. Leading/trailing whitespace is trimmed.
+ --- perl: [ { foo => 'bar' } ]
+
+ # This is a point whose value is the empty string
+ --- a_flag
+
+ # This is the next block:
+ === Another test case
+
+The test label is provided on a line beginning with qr/^===/. Test "points"
+are provided in sections beginning with qr/^--- +\w+/. All flush-left comment
+lines are stripped. Lines beginning with '\' are escaped.
+
+Different tests expect different test points in a .tml file, based on the
+specific test callback being used.
+
+Many .tml files have the points 'yaml' and 'perl' as in the example above. The
+'yaml' point is a YAML document and the 'perl' point is a Data::Dumper Perl
+data structure. The test checks whether the YAML parses into a data structure
+identical to the Perl one. The 'a_flag' point is an annotation that the
+testing callback can use to affect the run of a given test.
+
+The semantics of points (including annotations) is specific to the callback
+functions used to process test blocks.
+
+# TestML data files in t/tml-*
+
+TestML data files are organized into three directories:
+
+* t/tml-spec — these test files are provided by the YAML spec maintainers and
+should not be modified except to skip testing features that CPAN::Meta::YAML does not
+support
+
+* t/tml-local — these test files are CPAN::Meta::YAML's own unit tests; generally new
+test cases for coverage or correctness should be added here; these are
+broken into subdirectories, described later
+
+* t/tml-world — these test files represent "real world" YAML and their
+corresponding expected Perl output
+
+Generally, if a "real world" problem can be isolated to a particular snippet of
+YAML, it's best to add it to a t/tml-local file (or create a new one). If the
+problem can only be seen in the context of the entire YAML document, include it
+in t/tml-world. If the problem relates to encoding, it should be put into
+t/data instead.
+
+# t/tml-local subdirectories
+
+The subdirectories in t/tml-local define four types of tests:
+
+* perl-to-yaml: test that perl data dump to an expected YAML string
+
+* yaml-roundtrip: test that a YAML string loads to an expected perl data
+ structure; also tests that the perl data can be dumped and loaded back;
+
+* dump-error: test that certain perl data trigger expected errors
+
+* load-error: test that certain YAML strings trigger expected errors
+
+All .tml files in a t/tml-local directory must have the TestML
+test points required by the corresponding test functions defined
+in the TestBridge library.
+
+Generally, files should be grouped by data type or feature so that
+related tests are kept together.
+++ /dev/null
---- #YAML:1.0
-name: HTML-WebDAO
-version: 0.04
-author:
- - |-
- Zahatski Aliaksandr, E<lt>zagap@users.sourceforge.netE<gt>
-abstract: Perl extension for create complex web application
-license: perl
+++ /dev/null
---- #YAML:1.1
-name: Read
-version: VERSION
-abstract: Meta-Wrapper for reading spreadsheet data
-license: perl
-author:
- - H.Merijn Brand <h.m.brand@xs4all.nl>
-generated_by: Author
-distribution_type: module
-provides:
- Spreadsheet::Read:
- file: Read.pm
- version: VERSION
-requires:
- perl: 5.006
- Exporter: 0
- Carp: 0
- Data::Dumper: 0
-recommends:
- perl: 5.008005
- File::Temp: 0.14
- IO::Scalar: 0
-build_requires:
- perl: 5.006
- Test::Harness: 0
- Test::More: 0
-optional_features:
-- opt_csv:
- description: Provides parsing of CSV streams
- requires:
- Text::CSV_XS: 0.23
- recommends:
- Text::CSV: 1.10
- Text::CSV_PP: 1.10
- Text::CSV_XS: 0.58
-- opt_excel:
- description: Provides parsing of Microsoft Excel files
- requires:
- Spreadsheet::ParseExcel: 0.26
- Spreadsheet::ParseExcel::FmtDefault: 0
- recommends:
- Spreadsheet::ParseExcel: 0.42
-- opt_excelx:
- description: Provides parsing of Microsoft Excel 2007 files
- requires:
- Spreadsheet::XLSX: 0.07
-- opt_oo:
- description: Provides parsing of OpenOffice spreadsheets
- requires:
- Spreadsheet::ReadSXC: 0.2
-- opt_tools:
- description: Spreadsheet tools
- recommends:
- Tk: 0
- Tk::NoteBook: 0
- Tk::TableMatrix::Spreadsheet: 0
-resources:
- license: http://dev.perl.org/licenses/
-meta-spec:
- version: 1.4
- url: http://module-build.sourceforge.net/META-spec-v1.4.html
+++ /dev/null
----
-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:
- - inc
- - t
-requires:
- Template::Config: 0
- Unicode::Japanese: 0
- perl: 5.6.0
- version: 0
-version: 1.2.1
date : 2001-01-23
bill-to:
given : Chris
- family : Dumars
+ family : Dumàrs
address:
lines: |
458 Walkman Dr.
---
-abstract: Perl-compatible regular expression engine
author: "Ævar Arnfjörð Bjarmason <avar@cpan.org>"
-build_requires:
- Config: 0
- Test::More: 0
- XSLoader: 0
-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: re-engine-PCRE
-no_index:
- directory:
- - inc
- - t
-requires:
- perl: 5.9.5
-tests: t/*.t t/*/*.t
-version: 0.10
+++ /dev/null
-main_toolbar:
- - item file-new
- - item file-open
- - item file-print#
- - item file-close#
- - item file-save-all
- - item file-save
- -
- - item edit-changes-undo
- - item edit-changes-redo
- -
- - item edit-cut
- - item edit-copy
- - item edit-paste
- - item edit-replace
- - item edit-delete
+++ /dev/null
----
-- foo
----
-- bar
--- /dev/null
+---
+author: "Ævar Arnfjörð Bjarmason <avar@cpan.org>"
+++ /dev/null
-# VanillaPerl YAML config file
----
-# package info
-package_name: VanillaPerl
-package_version: 5
-
-# directories
-download_dir: c:\temp\vp_sources
-build_dir: c:\temp\vp_build
-image_dir: c:\vanilla-perl
-
-# Binary components
-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:
- 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:
- install_to: mingw
- extra:
- extra\README.w32api: licenses\win32api\README.w32api
-
-# Source components
-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
-
-# Additional modules to bundle in site\lib
-modules:
- # i.e. not used, but gets us the libwin32 dist
- - 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 files to be placed
-# Signature.pm: perl\site\lib\Module\Signature.pm
-extra:
- README: README.txt
- LICENSE.txt: LICENSE.txt
- Changes: Release-Notes.txt
- extra\Config.pm: perl\lib\CPAN\Config.pm
- # reset this again
-
- 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
+++ /dev/null
-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
- };
-}
-
-# Do we have the authorative YAML to test against
-eval {
- require YAML;
-
- # 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
-);
-sub have_yamlpm { $HAVE_YAMLPM }
-
-# Do we have YAML::Perl to test against?
-eval {
- require YAML::Perl;
-};
-my $HAVE_YAMLPERL = !! (
- $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;
-};
-my $HAVE_SYCK = !! (
- $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;
-};
-my $HAVE_XS = !! (
- $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(@_) );
-}
-
-sub test_data_directory {
- 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;
-}
-
-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;
-}
-
-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" );
-}
-
-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;
-}
-
-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;
-}
-
-1;
--- /dev/null
+package TestBridge;
+
+use strict;
+use warnings;
+
+use Test::More 0.99;
+use TestUtils;
+use TestML::Tiny;
+
+BEGIN {
+ $| = 1;
+ binmode(Test::More->builder->$_, ":utf8")
+ for qw/output failure_output todo_output/;
+}
+
+use CPAN::Meta::YAML;
+
+use Exporter ();
+our @ISA = qw{ Exporter };
+our @EXPORT = qw{
+ run_all_testml_files
+ run_testml_file
+ test_yaml_roundtrip
+ test_perl_to_yaml
+ test_dump_error
+ test_load_error
+ test_yaml_json
+ test_code_point
+ error_like
+ cmp_deeply
+ _testml_has_points
+};
+
+# regular expressions for checking error messages; incomplete, but more
+# can be added as more error messages get test coverage
+my %ERROR = (
+ E_CIRCULAR => qr{\QCPAN::Meta::YAML does not support circular references},
+ E_FEATURE => qr{\QCPAN::Meta::YAML does not support a feature},
+ E_PLAIN => qr{\QCPAN::Meta::YAML found illegal characters in plain scalar},
+ E_CLASSIFY => qr{\QCPAN::Meta::YAML failed to classify the line},
+);
+
+# use XXX -with => 'YAML::XS';
+
+#--------------------------------------------------------------------------#
+# run_all_testml_files
+#
+# Iterate over all .tml files in a directory using a particular test bridge
+# code # reference. Each file is wrapped in a subtest with a test plan
+# equal to the number of blocks.
+#--------------------------------------------------------------------------#
+
+sub run_all_testml_files {
+ my ($label, $dir, $bridge, @args) = @_;
+
+ my $code = sub {
+ my ($file, $blocks) = @_;
+ subtest "$label: $file" => sub {
+ plan tests => scalar @$blocks;
+ $bridge->($_, @args) for @$blocks;
+ };
+ };
+
+ my @files = find_tml_files($dir);
+
+ run_testml_file($_, $code) for sort @files;
+}
+
+sub run_testml_file {
+ my ($file, $code) = @_;
+
+ my $blocks = TestML::Tiny->new(
+ testml => $file,
+ version => '0.1.0',
+ )->{function}{data};
+
+ $code->($file, $blocks);
+}
+
+sub _testml_has_points {
+ my ($block, @points) = @_;
+ my @values;
+ for my $point (@points) {
+ defined $block->{$point} or return;
+ push @values, $block->{$point};
+ }
+ push @values, $block->{Label};
+ return @values;
+}
+
+#--------------------------------------------------------------------------#
+# test_yaml_roundtrip
+#
+# two blocks: perl, yaml
+#
+# Tests that a YAML string loads to the expected perl data. Also, tests
+# roundtripping from perl->YAML->perl.
+#
+# We can't compare the YAML for roundtripping because CPAN::Meta::YAML doesn't
+# preserve order and comments. Therefore, all we can test is that given input
+# YAML we can produce output YAML that produces the same Perl data as the
+# input.
+#
+# The perl must be an array reference of data to serialize:
+#
+# [ $thing1, $thing2, ... ]
+#
+# However, if a test point called 'serializes' exists, the output YAML is
+# expected to match the input YAML and will be checked for equality.
+#--------------------------------------------------------------------------#
+
+sub test_yaml_roundtrip {
+ my ($block) = @_;
+
+ my ($yaml, $perl, $label) =
+ _testml_has_points($block, qw(yaml perl)) or return;
+
+ my %options = ();
+ for (qw(serializes)) {
+ if (defined($block->{$_})) {
+ $options{$_} = 1;
+ }
+ }
+
+ my $expected = eval $perl; die $@ if $@;
+ bless $expected, 'CPAN::Meta::YAML';
+
+ subtest $label, sub {
+ # Does the string parse to the structure
+ my $yaml_copy = $yaml;
+ my $got = eval { CPAN::Meta::YAML->read_string( $yaml_copy ); };
+ is( $@, '', "CPAN::Meta::YAML parses without error" );
+ is( $yaml_copy, $yaml, "CPAN::Meta::YAML does not modify the input string" );
+ SKIP: {
+ skip( "Shortcutting after failure", 2 ) if $@;
+ isa_ok( $got, 'CPAN::Meta::YAML' );
+ cmp_deeply( $got, $expected, "CPAN::Meta::YAML parses correctly" )
+ or diag "ERROR: $CPAN::Meta::YAML::errstr\n\nYAML:$yaml";
+ }
+
+ # 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 { $expected->write_string };
+ is( $@, '', "CPAN::Meta::YAML serializes without error" );
+ SKIP: {
+ skip( "Shortcutting after failure", 5 ) if $@;
+ ok(
+ !!(defined $output and ! ref $output),
+ "CPAN::Meta::YAML serializes to scalar",
+ );
+ my $roundtrip = eval { CPAN::Meta::YAML->read_string( $output ) };
+ is( $@, '', "CPAN::Meta::YAML round-trips without error" );
+ skip( "Shortcutting after failure", 2 ) if $@;
+ isa_ok( $roundtrip, 'CPAN::Meta::YAML' );
+ cmp_deeply( $roundtrip, $expected, "CPAN::Meta::YAML round-trips correctly" );
+
+ # Testing the serialization
+ skip( "Shortcutting perfect serialization tests", 1 ) unless $options{serializes};
+ is( $output, $yaml, 'Serializes ok' );
+ }
+
+ };
+}
+
+#--------------------------------------------------------------------------#
+# test_perl_to_yaml
+#
+# two blocks: perl, yaml
+#
+# Tests that perl references serialize correctly to a specific YAML output
+#
+# The perl must be an array reference of data to serialize:
+#
+# [ $thing1, $thing2, ... ]
+#--------------------------------------------------------------------------#
+
+sub test_perl_to_yaml {
+ my ($block) = @_;
+
+ my ($perl, $yaml, $label) =
+ _testml_has_points($block, qw(perl yaml)) or return;
+
+ my $input = eval "no strict; $perl"; die $@ if $@;
+
+ subtest $label, sub {
+ my $result = eval { CPAN::Meta::YAML->new( @$input )->write_string };
+ is( $@, '', "write_string lives" );
+ is( $result, $yaml, "dumped YAML correct" );
+ };
+}
+
+#--------------------------------------------------------------------------#
+# test_dump_error
+#
+# two blocks: perl, error
+#
+# Tests that perl references result in an error when dumped
+#
+# The perl must be an array reference of data to serialize:
+#
+# [ $thing1, $thing2, ... ]
+#
+# The error must be a key in the %ERROR hash in this file
+#--------------------------------------------------------------------------#
+
+sub test_dump_error {
+ my ($block) = @_;
+
+ my ($perl, $error, $label) =
+ _testml_has_points($block, qw(perl error)) or return;
+
+ my $input = eval "no strict; $perl"; die $@ if $@;
+ chomp $error;
+ my $expected = $ERROR{$error};
+
+ subtest $label, sub {
+ my $result = eval { CPAN::Meta::YAML->new( @$input )->write_string };
+ ok( !$result, "returned false" );
+ error_like( $expected, "Got expected error" );
+ };
+}
+
+#--------------------------------------------------------------------------#
+# test_load_error
+#
+# two blocks: yaml, error
+#
+# Tests that a YAML string results in an error when loaded
+#
+# The error must be a key in the %ERROR hash in this file
+#--------------------------------------------------------------------------#
+
+sub test_load_error {
+ my ($block) = @_;
+
+ my ($yaml, $error, $label) =
+ _testml_has_points($block, qw(yaml error)) or return;
+
+ chomp $error;
+ my $expected = $ERROR{$error};
+
+ subtest $label, sub {
+ my $result = eval { CPAN::Meta::YAML->read_string( $yaml ) };
+ is( $result, undef, 'read_string returns undef' );
+ error_like( $expected, "Got expected error" )
+ or diag "YAML:\n$yaml";
+ };
+}
+
+#--------------------------------------------------------------------------#
+# test_yaml_json
+#
+# two blocks: yaml, json
+#
+# Tests that a YAML string can be loaded to Perl and dumped to JSON and
+# match an expected JSON output. The expected JSON is loaded and dumped
+# to ensure similar JSON dump options.
+#--------------------------------------------------------------------------#
+
+sub test_yaml_json {
+ my ($block, $json_lib) = @_;
+ $json_lib ||= do { require JSON::PP; 'JSON::PP' };
+
+ my ($yaml, $json, $label) =
+ _testml_has_points($block, qw(yaml json)) or return;
+
+ subtest "$label", sub {
+ # test YAML Load
+ my $object = eval {
+ CPAN::Meta::YAML::Load($yaml);
+ };
+ my $err = $@;
+ ok !$err, "YAML loads";
+ return if $err;
+
+ # test YAML->Perl->JSON
+ # N.B. round-trip JSON to decode any \uNNNN escapes and get to
+ # characters
+ my $want = $json_lib->new->encode(
+ $json_lib->new->decode($json)
+ );
+ my $got = $json_lib->new->encode($object);
+ is $got, $want, "Load is accurate";
+ };
+}
+
+#--------------------------------------------------------------------------#
+# test_code_point
+#
+# two blocks: code, yaml
+#
+# Tests that a Unicode codepoint is correctly dumped to YAML as both
+# key and value.
+#
+# The code test point must be a non-negative integer
+#
+# The yaml code point is the expected output of { $key => $value } where
+# both key and value are the character represented by the codepoint.
+#--------------------------------------------------------------------------#
+
+sub test_code_point {
+ my ($block) = @_;
+
+ my ($code, $yaml, $label) =
+ _testml_has_points($block, qw(code yaml)) or return;
+
+ subtest "$label - Unicode map key/value test" => sub {
+ my $data = { chr($code) => chr($code) };
+ my $dump = CPAN::Meta::YAML::Dump($data);
+ $dump =~ s/^---\n//;
+ is $dump, $yaml, "Dump key and value of code point char $code";
+
+ my $yny = CPAN::Meta::YAML::Dump(CPAN::Meta::YAML::Load($yaml));
+ $yny =~ s/^---\n//;
+ is $yny, $yaml, "YAML for code point $code YNY roundtrips";
+
+ my $nyn = CPAN::Meta::YAML::Load(CPAN::Meta::YAML::Dump($data));
+ cmp_deeply( $nyn, $data, "YAML for code point $code NYN roundtrips" );
+ }
+}
+
+#--------------------------------------------------------------------------#
+# error_like
+#
+# Test CPAN::Meta::YAML->errstr against a regular expression and clear the
+# errstr afterwards
+#--------------------------------------------------------------------------#
+
+sub error_like {
+ my ($regex, $label) = @_;
+ $label = "Got expected error" unless defined $label;
+ local $Test::Builder::Level = $Test::Builder::Level + 1;
+ my $ok = like( $@, $regex, $label );
+ return $ok;
+}
+
+#--------------------------------------------------------------------------#
+# cmp_deeply
+#
+# is_deeply with some better diagnostics
+#--------------------------------------------------------------------------#
+sub cmp_deeply {
+ my ($got, $want, $label) = @_;
+ local $Test::Builder::Level = $Test::Builder::Level + 1;
+ is_deeply( $got, $want, $label )
+ or diag "GOT:\n", explain($got), "\nWANTED:\n", explain($want);
+}
+
+1;
--- /dev/null
+use 5.008001; use strict; use warnings;
+package TestML::Tiny;
+
+; # original $VERSION removed by Doppelgaenger
+
+use Carp();
+use Test::More 0.99 ();
+
+# use XXX;
+
+sub import {
+ strict->import;
+ warnings->import;
+}
+
+sub new {
+ my $self = bless { @_[1..$#_] }, $_[0];
+ my $testml = $self->_get_testml;
+ my $bridge = $self->_get_bridge;
+ $self->{runtime} ||= TestML::Tiny::Runtime->new(
+ bridge => $bridge,
+ );
+ my $compiler = TestML::Tiny::Compiler->new(
+ $self->{version} ? (version => $self->{version}) : (),
+ );
+ $self->{function} = $compiler->compile($testml);
+ return $self;
+}
+
+sub run {
+ my ($self) = @_;
+ my $runtime = $self->{runtime} || '';
+ Carp::croak "Missing or invalid runtime object for TestML::Tiny::run()"
+ unless defined($runtime) and ref($runtime) eq 'TestML::Tiny::Runtime';
+ $runtime->run;
+}
+
+sub _get_testml {
+ my ($self) = @_;
+ my $testml = $self->{testml}
+ or Carp::croak "TestML object requires a testml attribute";
+ $testml = $self->_slurp($testml)
+ if $testml !~ /\n/;
+ return $testml;
+}
+
+sub _get_bridge {
+ my ($self) = @_;
+ my $bridge = $self->{bridge} || 'main';
+ return $bridge if ref $bridge;
+ eval "require $bridge";
+ Carp::croak $@ if $@ and $@ !~ /^Can't locate /;
+ return (
+ defined(&{"${bridge}::new"})
+ ? $bridge->new
+ : bless {}, $bridge
+ );
+}
+
+sub _slurp {
+ open my $fh, "<:raw:encoding(UTF-8)", $_[1]
+ or die "Can't open $_[1] for input";
+ local $/;
+ <$fh>;
+}
+
+#------------------------------------------------------------------------------
+
+package TestML::Tiny::Runtime;
+
+# use XXX;
+
+sub new {
+ my $self = $TestML::Tiny::Runtime::Singleton =
+ bless { @_[1..$#_] }, $_[0];
+};
+
+sub run {
+ Test::More::fail 'not done yet!';
+ Test::More::done_testing;
+}
+
+#------------------------------------------------------------------------------
+package TestML::Tiny::Compiler;
+
+# use XXX;
+
+my $ID = qr/\w+/;
+my $SP = qr/[\ \t]/;
+my $LINE = qr/.*$/m;
+my $DIRECTIVE = qr/^%($ID)$SP+($LINE)/m;
+
+sub new {
+ my $self = bless { @_[1..$#_] }, $_[0];
+}
+
+sub runtime {
+ $TestML::Tiny::Runtime::Singleton;
+}
+
+sub compile {
+ my ($self, $testml) = @_;
+ my $function = $self->{function} = TestML::Tiny::Function->new;
+ $self->{testml} = $testml;
+ $self->preprocess;
+ my $version = $self->check_version;
+ my ($code_syntax, $data_syntax) =
+ @{$self}{qw(code_syntax data_syntax)};
+ my $code_method = "compile_code_${code_syntax}_$version";
+ Carp::croak "Don't know how to compile TestML '$code_syntax' code"
+ unless $self->can($code_method);
+ my $data_method = "compile_data_${data_syntax}_$version";
+ Carp::croak "Don't know how to compile TestML '$data_syntax' data"
+ unless $self->can($data_method);
+ $function->{statements} = $self->$code_method;
+ $function->{data} = $self->$data_method;
+ return $function;
+}
+
+my %directives = (
+ code_syntax => 'tiny',
+ data_syntax => 'testml',
+ data_marker => '===',
+ block_marker => '===',
+ point_marker => '---',
+);
+sub preprocess {
+ my ($self) = @_;
+
+ my $version = $self->{version} || undef;
+ my $testml = $self->{testml};
+ my $directives = [ $testml =~ /$DIRECTIVE/gm ];
+ $testml =~ s/($DIRECTIVE)/#$1/g;
+ while (@$directives) {
+ my ($key, $value) = splice(@$directives, 0, 2);
+ if ($key eq "TestML") {
+ $self->check_not_set_and_set($key, $value, 'version');
+ }
+ elsif ($key eq "BlockMarker") {
+ $self->check_not_set_and_set(
+ 'BlockMarker', $value, 'block_marker'
+ );
+ ($self->{block_marker} = $value) =~
+ s/([\*\^\$\+\?\(\)\.])/\\$1/g;
+ }
+ elsif ($key eq "PointMarker") {
+ $self->check_not_set_and_set(
+ 'PointMarker', $value, 'point_marker'
+ );
+ ($self->{point_marker} = $value) =~
+ s/([\*\^\$\+\?\(\)\.])/\\$1/g;
+ }
+ elsif ($key eq "CodeSyntax") {
+ die "Untested";
+ $self->check_not_set_and_set(
+ 'CodeSyntax', $value, 'code_syntax'
+ );
+ $self->{code_syntax} = $value;
+ }
+ elsif ($key eq "DataSyntax") {
+ die "Untested";
+ $self->check_not_set_and_set(
+ 'DataSyntax', $value, 'data_syntax'
+ );
+ $self->{data_syntax} = $value;
+ }
+ else {
+ Carp::croak "Unknown TestML directive: '%$key'";
+ }
+ }
+ $self->{data_marker} = $self->{block_marker}
+ if not($self->{data_marker}) and $self->{block_marker};
+ for my $directive (keys %directives) {
+ $self->{$directive} ||= $directives{$directive};
+ }
+
+ ($self->{code}, $self->{data}) =
+ ($testml =~ /(.*?)(^$self->{data_marker}.*)/msg);
+ $self->{code} ||= '';
+ $self->{data} ||= '';
+}
+
+sub check_not_set_and_set {
+ my ($self, $key, $value, $attr) = @_;
+ if (defined $self->{$attr} and $self->{$attr} ne $value) {
+ Carp::croak "Can't set TestML '$key' directive to '$value'. " .
+ "Already set to '$self->{$attr}'";
+ }
+ $self->{$attr} = $value;
+}
+
+sub check_version {
+ my ($self) = @_;
+ my $version = $self->{version} || undef;
+ Carp::croak "TestML syntax version not defined. Cannot continue"
+ unless defined $version;
+ Carp::croak "Invalid value for TestML version '$version'. Must be 0.1.0"
+ unless $version eq '0.1.0';
+ $version =~ s/\./_/g;
+ return $version;
+}
+
+sub compile_code_tiny_0_1_0 {
+ my ($self) = @_;
+ my $num = 1;
+ [ grep { not /(^#|^\s*$)/ } split /\n/, $self->{code} ];
+}
+
+sub compile_data_testml_0_1_0 {
+ my ($self) = @_;
+
+ my $lines = [ grep { ! /^#/ } split /\n/, $self->{data} ];
+
+ my $blocks = [];
+ my $parse = [];
+ push @$lines, undef; # sentinel
+ while (@$lines) {
+ push @$parse, shift @$lines;
+ if (!defined($lines->[0]) or
+ $lines->[0] =~ /^$self->{block_marker}/
+ ) {
+ my $block = $self->_parse_testml_block($parse);
+ push @$blocks, $block
+ unless exists $block->{SKIP};
+ last if exists $block->{LAST};
+ $parse = []; # clear for next parse
+ }
+ last if !defined($lines->[0]);
+ }
+
+ my $only = [ grep { exists $_->{ONLY} } @$blocks ];
+
+ return @$only ? $only : $blocks;
+}
+
+sub _parse_testml_block {
+ my ($self, $lines) = @_;
+
+ my ($label) = $lines->[0] =~ /^$self->{block_marker}(?:\s+(.*))?$/;
+ shift @$lines until not(@$lines) or
+ $lines->[0] =~ /^$self->{point_marker} +\w+/;
+
+ my $block = $self->_parse_testml_points($lines);
+ $block->{Label} = $label || '';
+
+ return $block;
+}
+
+sub _parse_testml_points {
+ my ($self, $lines) = @_;
+
+ my $block = {};
+
+ while (@$lines) {
+ my $line = shift @$lines;
+ $line =~ /^$self->{point_marker} +(\w+)/
+ or die "Invalid TestML line:\n'$line'";
+ my $point_name = $1;
+ die "$block repeats $point_name"
+ if exists $block->{$point_name};
+ $block->{$point_name} = '';
+ if ($line =~ /^$self->{point_marker} +(\w+): +(.*?) *$/) {
+ ($block->{$1} = $2) =~ s/^ *(.*?) *$/$1/;
+ shift @$lines while @$lines and
+ $lines->[0] !~ /^$self->{point_marker} +(\w)/;
+ }
+ elsif ($line =~ /^$self->{point_marker} +(\w+)$/) {
+ $point_name = $1;
+ while ( @$lines ) {
+ $line = shift @$lines;
+ if ($line =~ /^$self->{point_marker} \w+/) {
+ unshift @$lines, $line;
+ last;
+ }
+ $block->{$point_name} .= "$line\n";
+ }
+ $block->{$point_name} =~ s/\n\s*\z/\n/;
+ $block->{$point_name} =~ s/^\\//gm;
+ }
+ else {
+ die "Invalid TestML line:\n'$line'";
+ }
+ }
+ return $block;
+}
+
+#------------------------------------------------------------------------------
+package TestML::Tiny::Function;
+
+sub new {
+ my $self = bless {
+ statements => [],
+ data => [],
+ namespace => {},
+ }, $_[0];
+}
+
+#------------------------------------------------------------------------------
+package TestML::Tiny::Bridge;
+
+sub new {
+ my $self = bless { @_[1..$#_] }, $_[0];
+}
+
+#------------------------------------------------------------------------------
+package TestML::Tiny::Library::Standard;
+
+sub new {
+ my $self = bless { @_[1..$#_] }, $_[0];
+}
+
+1;
--- /dev/null
+package TestUtils;
+
+use strict;
+use warnings;
+
+use Exporter ();
+use File::Spec ();
+use File::Find ();
+
+our @ISA = qw{ Exporter };
+our @EXPORT = qw{
+ find_tml_files
+ json_class
+ slurp
+ test_data_directory
+ test_data_file
+};
+
+sub find_tml_files {
+ my $dir = shift;
+ my @files;
+ File::Find::find(
+ sub { push @files, $File::Find::name if -f and /\.tml$/ },
+ $dir
+ );
+ return @files;
+}
+
+# Prefer JSON to JSON::PP; skip if we don't have at least one
+sub json_class {
+ for (qw/JSON JSON::PP/) {
+ return $_ if eval "require $_; 1";
+ }
+ return;
+}
+
+sub test_data_directory {
+ return File::Spec->catdir( 't', 'data' );
+}
+
+sub test_data_file {
+ return File::Spec->catfile( test_data_directory(), shift );
+}
+
+sub slurp {
+ my $file = shift;
+ local $/ = undef;
+ open( FILE, " $file" ) or die "open($file) failed: $!";
+ binmode( FILE, $_[0] ) if @_ > 0;
+ # binmode(FILE); # disable perl's BOM interpretation
+ my $source = <FILE>;
+ close( FILE ) or die "close($file) failed: $!";
+ $source;
+}
+
+1;
--- /dev/null
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use lib 'lib', 't/lib/';
+use Test::More 0.99;
+use Getopt::Long qw/:config passthrough/;
+use List::Util qw/first/;
+use TestBridge;
+use TestUtils;
+
+#--------------------------------------------------------------------------#
+# Note: This program is both the proxy to select .tml files for 'prove' and the
+# test-runner that 'prove' executes.
+#--------------------------------------------------------------------------#
+
+# match path prefix under t/
+my %BRIDGE_MAP = (
+ 'tml-local/dump-error' => \&test_dump_error,
+ 'tml-local/load-error' => \&test_load_error,
+ 'tml-local/perl-to-yaml' => \&test_perl_to_yaml,
+ 'tml-local/yaml-roundtrip' => \&test_yaml_roundtrip,
+ 'tml-spec/basic-data.tml' => \&test_yaml_json,
+ 'tml-spec/unicode.tml' => \&test_code_point,
+ 'tml-world' => \&test_yaml_roundtrip,
+);
+
+sub main {
+ my ($verbose, $run_tests);
+ GetOptions(
+ 'run_test' => \$run_tests,
+ );
+
+ if ( $run_tests ) {
+ my $file = shift @ARGV;
+ exit 0 unless -f $file;
+ my ($bridge) = first { $file =~ m{^t/\Q$_} } keys %BRIDGE_MAP;
+ die "No bridge found for $file" unless $bridge;
+
+ run_testml_file(
+ $file,
+ sub {
+ my ($file, $blocks) = @_;
+ subtest "TestML dev runner: $file" => sub {
+ plan tests => scalar @$blocks;
+ $BRIDGE_MAP{$bridge}->($_) for @$blocks;
+ };
+ done_testing;
+ },
+ );
+ }
+ else {
+ my (@opts, @files, @patterns);
+ for (@ARGV) {
+ if ( /^-/ ) {
+ push @opts, $_;
+ }
+ elsif ( -f ) {
+ push @files, $_;
+ }
+ else {
+ push @patterns, $_;
+ }
+ }
+
+ # if we got no files or patterns, treat that as taking anything
+ @patterns = "." if !@patterns && !@files;
+
+ if (@patterns) {
+ FILE: for my $file ( find_tml_files('t') ) {
+ if ( first { $file =~ /$_/ } @patterns ) {
+ push @files, $file;
+ }
+ }
+ }
+
+ exec( 'prove', @opts, '--exec', "$0 --run_test", @files )
+ if @files;
+ }
+}
+
+main;
+
+__END__
+
+=head1 NAME
+
+t/tml - run .tml files matching a pattern
+
+=head1 SYNOPSIS
+
+ t/tml [prove options] [patterns]
+
+=head1 USAGE
+
+This program runs F<prove> against a set of F<.tml> files using their
+corresponding test bridge functions.
+
+Any arguments beginning with C<-> will be passed through to F<prove>. All
+other arguments will be used as patterns to select F<.tml> files found anywhere
+under the F<t> directory. You can use shell globbing syntax, and let the shell
+expand the patterns, or you can quote/escape the patterns and let them be
+treated as Perl regular expressions.
+
+For example:
+
+ t/tml unicode # paths matching qr/unicode/
+ t/tml basic uni # paths matching qr/basic/ or qr/uni/
+ t/tml 'local.*re' # paths matching qr/local.*re/
+ t/tml '\d+' # paths matching qr/\d+/
+
+Examples of options for prove:
+
+ t/tml -v quoting # verbose run of paths matching qr/quoting/
+ t/tml -j9 world # parallel run of paths matching qr/world/
+ t/tml -j9 # parallel run of all .tml files
+
+=cut
--- /dev/null
+=== Circular Reference Protection
+# When we try to serialize, it should NOT infinite loop
+--- perl
+$VAR1 = [
+ {
+ 'a' => 'b',
+ 'c' => [
+ {},
+ 2
+ ]
+ },
+ []
+ ];
+$VAR1->[0]{'c'}[0] = $VAR1->[0];
+$VAR1->[1] = $VAR1->[0]{'c'};
+[ $VAR1 ]
+
+--- error: E_CIRCULAR
--- /dev/null
+=== scalar document followed by mapping
+--- yaml
+\--- foo
+a: 1
+--- error: E_CLASSIFY
--- /dev/null
+=== multiline quote
+--- yaml
+- 'Multiline
+quote'
+--- error: E_FEATURE
+
+=== dash dash 2
+--- yaml
+- - 2
+--- error: E_PLAIN
+
+=== dash
+--- yaml
+foo: -
+--- error: E_PLAIN
+
+=== leading ampersand
+--- yaml
+foo: @INC
+--- error: E_PLAIN
+
+=== leading percent
+--- yaml
+foo: %INC
+--- error: E_PLAIN
+
+=== trailing colon
+--- yaml
+foo: bar:
+--- error: E_PLAIN
+
+=== key key value
+--- yaml
+foo: bar: baz
+--- error: E_PLAIN
+
+=== backticks
+--- yaml
+foo: `perl -V`
+--- error: E_PLAIN
+
+=== double-dash
+--- yaml
+--
+--- error: E_PLAIN
+
+=== multi-line scalar document starting on header
+--- yaml
+\--- foo
+bar
+--- error: E_CLASSIFY
--- /dev/null
+=== version object
+--- yaml
+\---
+version: !!perl/hash:version
+ original: v2.0.2
+ qv: 1
+ version:
+ - 2
+ - 0
+ - 2
+--- error: E_FEATURE
--- /dev/null
+=== Quote boolean-like string (scalar)
+# Strings that could be confused with booleans should be quoted
+--- perl
+[ 'true' ]
+
+--- yaml
+\--- 'true'
+
+=== Quote boolean-like string (list)
+--- perl
+[ [ qw{ null true false } ] ]
+
+--- yaml
+\---
+- 'null'
+- 'true'
+- 'false'
+
+=== Quote scalars ending in colon
+--- perl
+[ [ 'A:' ] ]
+
+--- yaml
+\---
+- 'A:'
+
--- /dev/null
+#--------------------------------------------------------------------------#
+# This file is for testing combinations of sequences and mappings
+#--------------------------------------------------------------------------#
+
+#####################################################################
+# Null HASH/ARRAY
+
+=== null hash in array
+--- yaml
+---
+- foo
+- {}
+- bar
+--- perl
+[ [ 'foo', {}, 'bar' ] ]
+
+
+=== null array in array
+--- yaml
+---
+- foo
+- []
+- bar
+--- perl
+[ [ 'foo', [], 'bar' ] ]
+
+
+=== null hash in hash
+--- yaml
+---
+foo: {}
+bar: 1
+--- perl
+[ { foo => {}, bar => 1 } ]
+
+
+=== null array in hash
+--- yaml
+---
+foo: []
+bar: 1
+--- perl
+[ { foo => [], bar => 1 } ]
+
+# Simple array inside a hash with an undef
+=== array_in_hash
+--- yaml
+---
+foo:
+ - bar
+ - ~
+ - baz
+
+--- perl
+[ { foo => [ 'bar', undef, 'baz' ] } ]
+
+
+# Simple hash inside a hash with an undef
+=== hash_in_hash
+--- yaml
+---
+foo: ~
+bar:
+ foo: bar
+
+--- perl
+[ { foo => undef, bar => { foo => 'bar' } } ]
+
+
+# Mixed hash and scalars inside an array
+=== hash_in_array
+--- yaml
+---
+-
+ foo: ~
+ this: that
+- foo
+- ~
+-
+ foo: bar
+ this: that
+
+--- perl
+[ [
+ { foo => undef, this => 'that' },
+ 'foo',
+ undef,
+ { foo => 'bar', this => 'that' },
+] ]
+
+
+######################################################################
+# Non-Indenting Sub-List
+
+=== Non-indenting sub-list
+--- yaml
+---
+foo:
+- list
+bar: value
+--- perl
+[ { foo => [ 'list' ], bar => 'value' } ]
+--- noyamlpm
+
+
+
+# Inline nested hash
+=== inline_nested_hash
+--- yaml
+---
+- ~
+- foo: bar
+ this: that
+- baz
+
+--- perl
+[ [ undef, { foo => 'bar', this => 'that' }, 'baz' ] ]
+
+
+# RT 51491
+=== space after hypen
+--- yaml
+\---
+FOO:
+ -
+ bar: baz
+--- perl
+[ { 'FOO' => [ { bar => 'baz' } ] } ]
--- /dev/null
+#####################################################################
+# Main Tests
+
+=== Properly ignore comments
+--- yaml
+---
+a: b#content
+c: d #comment
+e:
+- f #comment
+- g# content
+h: 'single' # comment
+h2: 'single # content' # comment
+i: "double" # comment
+i2: "double # content" # comment
+j: | # comment
+ literal # content
+ block # content
+k: {} # comment
+l: [] # comment
+m: # comment
+ n: o
+--- perl
+[
+ {
+ 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',
+ },
+ },
+]
+--- noyamlpm
+
+
+# Repeat, with otherwise illegal characters in the comments
+=== Properly ignore comments (with otherwise illegal characters)
+--- yaml
+---
+a: b#content
+c: d #comment '"!&@%`
+e:
+- f #comment '"!&@%`
+- g# content
+h: 'single' # comment '"!&@%`
+h2: 'single # content' # comment '"!&@%`
+i: "double" # comment '"!&@%`
+i2: "double # content" # comment '"!&@%`
+j: | # comment '"!&@%`
+ literal # content
+ block # content
+k: {} # comment '"!&@%`
+l: [] # comment '"!&@%`
+m: # comment '"!&@%`
+ n: o
+--- perl
+[
+ {
+ 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',
+ },
+ },
+]
+--- noyamlpm
+
+####################################################################
+# Comment on the Document Line
+
+=== comment header
+--- yaml
+--- # Comment
+foo: bar
+--- perl
+[ { foo => 'bar' } ]
+--- noyamlpm
+
+
+# Empty comments
+=== empty_comment_in_list
+--- yaml
+---
+- foo
+\#
+- bar
+
+--- perl
+[ [ 'foo', 'bar' ] ]
+
+
+=== empty_comment_in_hash
+--- yaml
+---
+foo: bar
+\# foo
+one: two
+
+--- perl
+[ { foo => 'bar', one => 'two' } ]
+
+
--- /dev/null
+#####################################################################
+# Support for YAML version directives
+
+# Simple inline case (comment variant)
+=== simple_doctype_comment
+--- yaml
+--- #YAML:1.0
+foo: bar
+--- perl
+[ { foo => 'bar' } ]
+--- nosyck
+
+
+# Simple inline case (percent variant)
+=== simple_doctype_percent
+--- yaml
+--- %YAML:1.0
+foo: bar
+--- perl
+[ { foo => 'bar' } ]
+--- noyamlpm
+--- noxs
+
+
+# Simple header (comment variant)
+=== predocument_1_0
+--- yaml
+\%YAML:1.0
+---
+foo: bar
+--- perl
+[ { foo => 'bar' } ]
+--- noyamlpm
+--- nosyck
+--- noxs
+
+
+# Simple inline case (comment variant)
+=== predocument_1_1
+--- yaml
+\%YAML 1.1
+---
+foo: bar
+--- perl
+[ { foo => 'bar' } ]
+--- noyamlpm
+--- nosyck
+
+
+# Multiple inline documents (comment variant)
+=== multi_doctype_comment
+--- yaml
+--- #YAML:1.0
+foo: bar
+--- #YAML:1.0
+- 1
+--- #YAML:1.0
+foo: bar
+--- perl
+[ { foo => 'bar' }, [ 1 ], { foo => 'bar' } ]
+
+
+# Simple pre-document case (comment variant)
+=== predocument_percent
+--- yaml
+\%YAML 1.1
+---
+foo: bar
+--- perl
+[ { foo => 'bar' } ]
+--- noyamlpm
+--- nosyck
+
+
+# Simple pre-document case (comment variant)
+=== predocument_comment
+--- yaml
+\#YAML 1.1
+---
+foo: bar
+--- perl
+[ { foo => 'bar' } ]
+
+
+=== two documents
+--- yaml
+\---
+- foo
+\---
+- bar
+--- perl
+[ [ 'foo' ], [ 'bar' ] ]
+
+# Document ending (hash)
+=== document_end_hash
+--- yaml
+---
+ foo: bar
+...
+--- perl
+[ { foo => "bar" } ]
+--- noyamlpm
+--- nosyck
+
+
+# Document ending (array)
+=== document_end_array
+--- yaml
+---
+- foo
+...
+--- perl
+[ [ 'foo' ] ]
+--- noyamlpm
+
+
+# Multiple documents (simple)
+=== multi_document_simple
+--- yaml
+---
+- foo
+...
+---
+- foo
+...
+--- perl
+[ [ 'foo' ], [ 'foo' ] ]
+--- noyamlpm
+
+
+# Multiple documents (whitespace-separated)
+=== multi_document_space
+--- yaml
+---
+- foo
+...
+
+---
+- foo
+...
+--- perl
+[ [ 'foo' ], [ 'foo' ] ]
+--- noyamlpm
+
+#####################################################################
+# Sample Testing
+
+# Test a completely empty document
+=== empty
+--- yaml
+--- perl
+[ ]
+
+
+# Just a newline
+### YAML.pm has a bug where it dies on a single newline
+=== only_newlines
+--- yaml
+\
+\
+--- perl
+[ ]
+
+
+# Just a comment
+=== only_comment
+--- yaml
+\# comment
+--- perl
+[ ]
+
+
+# Empty documents
+=== only_header
+--- yaml
+---
+
+--- perl
+[ undef ]
+
+
+=== two_header
+--- yaml
+---
+---
+
+--- perl
+[ undef, undef ]
+
+
+=== one_undef
+--- yaml
+--- ~
+
+--- perl
+[ undef ]
+
+
+=== one_undef2
+--- yaml
+--- ~
+--- perl
+[ undef ]
+
+
+=== two_undef
+--- yaml
+--- ~
+---
+
+--- perl
+[ undef, undef ]
+
+
--- /dev/null
+=== Empty mapping
+--- yaml
+\--- {}
+--- perl
+[ {} ]
+
+# Simple hashs
+=== one_hash1
+--- yaml
+---
+foo: bar
+
+--- perl
+[ { foo => 'bar' } ]
+
+
+=== one_hash2
+--- yaml
+---
+foo: bar
+this: ~
+
+--- perl
+[ { this => undef, foo => 'bar' } ]
+
+
+=== one_hash3
+--- yaml
+---
+-foo: bar
+
+--- perl
+[ { '-foo' => 'bar' } ]
+
+
+# Implicit document start
+=== implicit_hash
+--- yaml
+foo: bar
+
+--- perl
+[ { foo => 'bar' } ]
+
+
+
+# Make sure we support x-foo keys
+=== x-foo key
+--- yaml
+---
+x-foo: 1
+--- perl
+[ { 'x-foo' => 1 } ]
+
+
+# Hash key legally containing a colon
+=== module_hash_key
+--- yaml
+---
+Foo::Bar: 1
+--- perl
+[ { 'Foo::Bar' => 1 } ]
+
+
+# Hash indented
+=== hash_indented
+--- yaml
+---
+ foo: bar
+--- perl
+[ { foo => "bar" } ]
+
+#####################################################################
+# Empty Values and Premature EOF
+
+=== empty hash keys
+--- yaml
+---
+foo: 0
+requires:
+build_requires:
+--- perl
+[ { foo => 0, requires => undef, build_requires => undef } ]
+--- noyamlpm
+
+#####################################################################
+# Confirm we can read the synopsis
+
+=== synopsis
+--- yaml
+---
+rootproperty: blah
+section:
+ one: two
+ three: four
+ Foo: Bar
+ empty: ~
+--- perl
+[ {
+ rootproperty => 'blah',
+ section => {
+ one => 'two',
+ three => 'four',
+ Foo => 'Bar',
+ empty => undef,
+ },
+} ]
+
+#####################################################################
+# Indentation after empty hash value
+
+=== Indentation after empty hash value
+--- yaml
+---
+Test:
+ optmods:
+ Bad: 0
+ Foo: 1
+ Long: 0
+ version: 5
+Test_IncludeA:
+ optmods:
+Test_IncludeB:
+ optmods:
+_meta:
+ name: 'test profile'
+ note: 'note this test profile'
+--- perl
+[ {
+ 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',
+ },
+} ]
+
+
+#####################################################################
+# Spaces in the Key
+
+=== spaces in the key
+--- yaml
+---
+the key: the value
+--- perl
+[ { 'the key' => 'the value' } ]
+
+
+# Complex keys
+=== key_with_whitespace
+--- yaml
+---
+a b: c d
+
+--- perl
+[ { 'a b' => 'c d' } ]
+
+=== quoted_empty_key
+--- yaml
+---
+'': foo
+
+--- perl
+[ { '' => 'foo' } ]
+
+
--- /dev/null
+=== Empty double-quote
+--- yaml
+\---
+- ""
+--- perl
+[ [ "" ] ]
+
+# Simple single quote
+=== single_quote1
+--- yaml
+---
+- 'foo'
+
+--- perl
+[ [ 'foo' ] ]
+
+
+=== single_spaces
+--- yaml
+---
+- ' '
+--- perl
+[ [ ' ' ] ]
+
+
+=== single_null
+--- yaml
+---
+- ''
+
+--- perl
+[ [ '' ] ]
+
+
+# Double quotes
+=== only_spaces
+--- noyamlpm
+--- yaml
+--- " "
+
+--- perl
+[ ' ' ]
+
+
+=== leading_trailing_spaces
+--- noyamlpm
+--- yaml
+--- " foo"
+--- "bar "
+
+--- perl
+[ " foo", "bar " ]
+
+=== single quotes in double quotes
+--- yaml
+\--- "'foo'"
+--- perl
+[ "'foo'" ]
+
+=== double quotes in single quotes
+--- yaml
+\--- '"foo"'
+--- perl
+[ '"foo"' ]
+
+#####################################################################
+# Quote vs Hash
+
+=== hash-like quote
+--- yaml
+---
+author:
+ - 'mst: Matt S. Trout <mst@shadowcatsystems.co.uk>'
+--- perl
+[ { author => [ 'mst: Matt S. Trout <mst@shadowcatsystems.co.uk>' ] } ]
+
+#####################################################################
+# Quote and Escaping Idiosyncracies
+
+=== single quote subtleties
+--- yaml
+---
+name1: 'O''Reilly'
+name2: 'O''Reilly O''Tool'
+name3: 'Double '''' Quote'
+--- perl
+[ {
+ name1 => "O'Reilly",
+ name2 => "O'Reilly O'Tool",
+ name3 => "Double '' Quote",
+} ]
+
+
+=== single quote subtleties
+--- yaml
+---
+slash1: '\\'
+slash2: '\\foo'
+slash3: '\\foo\\\\'
+--- perl
+[ {
+ slash1 => "\\\\",
+ slash2 => "\\\\foo",
+ slash3 => "\\\\foo\\\\\\\\",
+} ]
+
+#####################################################################
+# Check Multiple-Escaping
+
+# RT #42119: write of two single quotes
+=== Multiple escaping of quote ok
+--- yaml
+--- "A'B'C"
+--- perl
+[ "A'B'C" ]
+
+
+# Escapes without whitespace
+=== Multiple escaping of escape ok
+--- yaml
+\--- A\B\C
+--- perl
+[ "A\\B\\C" ]
+
+
+# Escapes with whitespace
+=== Multiple escaping of escape with whitespace ok
+--- yaml
+--- 'A\B \C'
+--- perl
+[ "A\\B \\C" ]
+
+
+
--- /dev/null
+%PointMarker +++
+
+# Just a scalar
+=== one_scalar
++++ yaml
+--- foo
+
++++ perl
+[ 'foo' ]
+
+
+=== one_scalar2
++++ yaml
+--- foo
+
++++ perl
+[ 'foo' ]
+
+
+=== two_scalar
++++ yaml
+--- foo
+--- bar
+
++++ perl
+[ 'foo', 'bar' ]
+
+
+#####################################################################
+# Support for literal multi-line scalars
+
+# Declarative multi-line scalar
+=== simple_multiline
++++ yaml
+---
+ foo: >
+ bar
+ baz
++++ perl
+[ { foo => "bar baz\n" } ]
+
+
+# Piped multi-line scalar
+=== indented
++++ yaml
+---
+- |
+ foo
+ bar
+- 1
++++ perl
+[ [ "foo\nbar\n", 1 ] ]
+
+
+# ... with a pointless hyphen
+=== indented
++++ yaml
+---
+- |-
+ foo
+ bar
+- 1
++++ perl
+[ [ "foo\nbar", 1 ] ]
+
+
+#####################################################################
+# Hitchhiker Scalar
+
+=== hitchhiker scalar
++++ yaml
+--- 42
++++ perl
+[ 42 ]
++++ serializes
+
+#####################################################################
+# Newlines and tabs
+
+=== special characters
++++ yaml
+foo: "foo\\\n\tbar"
++++ perl
+[ { foo => "foo\\\n\tbar" } ]
+
+#####################################################################
+# Unprintable Characters
+
+=== unprintable
++++ yaml
+--- "foo\n\x00"
++++ perl
+[ "foo\n\0" ]
+
+#####################################################################
+# Ticker #32402
+
+# Tests a particular pathological case
+
+=== Pathological >< case
++++ yaml
+---
+- value
+- '><'
++++ perl
+[ [ 'value', '><' ] ]
+
+#####################################################################
+# Special Characters
+
+=== Special Characters
++++ SKIP
+# Encoding failure
++++ yaml
+---
+- "Ingy d\xC3\xB6t Net"
++++ perl
+[ [ "Ingy d\xC3\xB6t Net" ] ]
+
+######################################################################
+# Check illegal characters that are in legal places
+
+=== Bang in a quote
++++ yaml
+--- 'Wow!'
++++ perl
+[ "Wow!" ]
+
+
+=== Ampersand in a quote
++++ yaml
+--- 'This&that'
++++ perl
+[ "This&that" ]
+
--- /dev/null
+=== Empty sequence
+--- yaml
+\--- []
+--- perl
+[ [] ]
+
+# Simple lists
+=== one_list1
+--- yaml
+---
+- foo
+
+--- perl
+[ [ 'foo' ] ]
+
+# Implicit document start
+=== implicit_array
+--- yaml
+- foo
+
+--- perl
+[ [ 'foo' ] ]
+
+
+
+=== one_list2
+--- yaml
+---
+- foo
+- bar
+
+--- perl
+[ [ 'foo', 'bar' ] ]
+
+
+=== one_listundef
+--- yaml
+---
+- ~
+- bar
+
+--- perl
+[ [ undef, 'bar' ] ]
+
+
+=== one_listundefs
+--- noyamlpm
+--- yaml
+---
+- ~
+-
+-
+
+--- perl
+[ [ undef, undef, undef ] ]
+
+
+#####################################################################
+# Empty Values and Premature EOF
+
+=== empty array keys
+--- yaml
+---
+- foo
+-
+-
+--- perl
+[ [ 'foo', undef, undef ] ]
+--- noyamlpm
+
+#####################################################################
+# Empty Quote Line
+
+=== empty quote line
+--- yaml
+---
+- foo
+\#
+- bar
+--- perl
+[ [ "foo", "bar" ] ]
+
+#####################################################################
+# Trailing Whitespace
+#
+=== trailing whitespace
+--- yaml
+---
+abstract: Generate fractal curves
+foo: ~
+arr:
+ # THESE LINES HAVE INTENTIONAL TRAILING WHITESPACE
+ - foo
+ - ~
+ - 'bar'
+--- perl
+[ {
+ abstract => 'Generate fractal curves',
+ foo => undef,
+ arr => [ 'foo', undef, 'bar' ],
+} ]
+
+
+
--- /dev/null
+=== basic hash
+# This is just a simple one key hash.
+--- yaml
+a: b
+--- json
+{"a":"b"}
+
+=== double quoted keys
+# Hash with quoted key with embedded newline
+--- yaml
+"a\nb": c
+--- json
+{"a\nb":"c"}
+# --- dump
+# "a\nb": c
+
+=== basic array
+# This is just a simple one key hash.
+--- yaml
+- a
+-b
+--- json
+["a","b"]
+
--- /dev/null
+# Test unicode strings in key and value contexts
+
+%TestML 0.1.0
+
+###
+# These tests target unicode characters that are handled special or known to be
+# problematic. Test YNY (YAML→Native→YAML) and NYN roundtripping.
+#
+# YAML scalar emission does quoting based on first character, presence of
+# escape characters, and special ambiguous cases like ': '. These ones
+# character strings go a long way towards making sure an implementation is
+# correct.
+###
+
+
+# Make a mapping { "$code" : "$code" } where code is a unicode code point:
+
+# Dump mapping matches *yaml
+*code.dump_code_key_value == *yaml
+
+# Load *yaml then dump matches *yaml
+*yaml.load_yaml.dump_yaml == *yaml
+
+# Dump mapping the load memory-matches mapping
+*code.code_key_value.dump_yaml.load_yaml === *code.code_key_value
+
+
+# 0 → \0 "null"
+#
+# \z is the other YAML "null" encoding. Most implementations (including
+# libyaml), seem to go with \0 when emitting.
+=== Code point 0
+--- code: 0
+--- yaml
+"\0": "\0"
+
+
+# 1-6,14-27,29-31 → \x##
+=== Code point 1
+--- code: 1
+--- yaml
+"\x01": "\x01"
+
+
+# 7 → \a "bell" (alarm)
+=== Code point 7
+--- code: 7
+--- yaml
+"\a": "\a"
+
+
+# 8 → \b "backspace"
+=== Code point 8
+--- code: 8
+--- yaml
+"\b": "\b"
+
+
+# 9 → \t "horizontal tab"
+=== Code point 9
+--- code: 9
+--- yaml
+"\t": "\t"
+
+
+# 10 → \n "linefeed" (newline)
+=== Code point 10
+--- code: 10
+--- yaml
+"\n": "\n"
+
+
+# 11 → \v "vertical tab"
+=== Code point 11
+--- code: 11
+--- yaml
+"\v": "\v"
+
+
+# 11 → \f "form feed"
+=== Code point 12
+--- code: 12
+--- yaml
+"\f": "\f"
+
+
+# 11 → \f "carriage return"
+=== Code point 13
+--- code: 13
+--- yaml
+"\r": "\r"
+
+# 27 → \e "escape"
+=== Code point 27
+--- code: 27
+--- yaml
+"\e": "\e"
+
+
+# Space character needs quotes.
+=== Code point 32
+--- code: 32
+--- yaml
+' ': ' '
+
+
+# ! is a tag indicator. Needs quotes.
+=== Code point 33
+--- code: 33
+--- yaml
+'!': '!'
+
+
+# Quote single quotes with double quotes.
+=== Code point 34
+--- code: 34
+--- yaml
+'"': '"'
+
+
+# '#' is comment character. Needs quotes.
+=== Code point 35
+--- code: 35
+--- yaml
+'#': '#'
+
+
+# $ has no special meaning. No quotes.
+=== Code point 36
+--- code: 36
+--- yaml
+$: $
+
+
+# % is directive indicator. Needs quotees.
+=== Code point 37
+--- code: 37
+--- yaml
+'%': '%'
+
+
+# & is anchor indicator. Needs quotes.
+=== Code point 38
+--- code: 38
+--- yaml
+'&': '&'
+
+
+# Quote double quotes with single quotes.
+=== Code point 39
+--- code: 39
+--- yaml
+"'": "'"
+
+
+# ( has no special meaning. No quotes.
+=== Code point 40
+--- code: 40
+--- yaml
+(: (
+
+
+# ) has no special meaning. No quotes.
+=== Code point 41
+--- code: 41
+--- yaml
+): )
+
+
+# * is an alias indicator. Needs quotes.
+=== Code point 42
+--- code: 42
+--- yaml
+'*': '*'
+
+
+# + has no special meaning. No quotes.
+=== Code point 43
+--- code: 43
+--- yaml
++: +
+
+
+# , is a list separator. Needs quotes.
+=== Code point 44
+--- code: 44
+--- yaml
+',': ','
+
+
+# - is a sequence element marker. In many contexts it is not ambiguous when
+# unquoted, but in others it is ambiguous. libyaml always quotes it so going
+# with that for now.
+=== Code point 45
+--- code: 45
+--- yaml
+'-': '-'
+
+
+# . has no special meaning. No quotes.
+=== Code point 46
+--- code: 46
+--- yaml
+.: .
+
+
+# / has no special meaning. No quotes.
+=== Code point 47
+--- code: 47
+--- yaml
+/: /
+
+
+# 48-57 → 0-9 "digitss"
+# These values are strings, so must quote them.
+=== Code point 48
+--- code: 48
+--- yaml
+'0': '0'
+
+
+# : is a key/value separator. It is not always ambigous when not quoted, but
+# libyaml always quotes it at start of a string. Probably wise. Going with that
+# for now.
+=== Code point 58
+--- code: 58
+--- yaml
+':': ':'
+
+
+# ; has no special meaning. No quotes.
+=== Code point 59
+--- code: 59
+--- yaml
+;: ;
+
+
+# < has no special meaning. No quotes.
+=== Code point 60
+--- code: 60
+--- yaml
+<: <
+
+
+# = has no special meaning. No quotes.
+=== Code point 61
+--- code: 61
+--- yaml
+=: =
+
+
+# > is a folded scalar indicator. Needs quotes.
+=== Code point 62
+--- code: 62
+--- yaml
+'>': '>'
+
+
+# ? is a mapping key indicator. Needs quotes.
+=== Code point 63
+--- code: 63
+--- yaml
+'?': '?'
+
+
+# @ is a reserved character. Needs quotes.
+# TODO Check spec on this.
+=== Code point 64
+--- code: 64
+--- yaml
+'@': '@'
+
+
+# 65-90 → A-Z "upper case letters". No quotes.
+=== Code point 65
+--- code: 65
+--- yaml
+A: A
+
+
+# Some implementations think N means false. This should not be the case in a
+# default schema. No quotes.
+#
+# NOTE:
+# http://yaml.org/type/bool.html suggests that many simple strings should be
+# loaded as boolean, but this is an outdated concept. Currently, only the
+# words true/false/null (lower case) should be loaded specially (not as
+# strings). This may become even more restrictive in the future. ie Only
+# true/false/null in a flow context.
+=== Code point 78
+--- code: 78
+--- yaml
+N: N
+
+
+# Some implementations think Y means true. This should not be the case in a
+# default schema. No quotes.
+=== Code point 89
+--- code: 89
+--- yaml
+Y: Y
+
+
+# [ is a flow sequence start indicator. Needs quotes.
+=== Code point 91
+--- code: 91
+--- yaml
+'[': '['
+
+
+# \ is an escape indicator in double quoted strings. Used on its own it has no
+# special meaning. No quotes.
+=== Code point 92
+--- SKIP
+--- code: 92
+--- yaml
+\: \
+
+
+# ] is a flow sequence end indicator. Needs quotes.
+=== Code point 93
+--- code: 93
+--- yaml
+']': ']'
+
+
+# ^ has no special meaning. No quotes.
+=== Code point 94
+--- code: 94
+--- yaml
+^: ^
+
+
+# _ has no special meaning. No quotes.
+=== Code point 95
+--- code: 95
+--- yaml
+_: _
+
+
+# ` is a reserved character. Needs quotes.
+=== Code point 96
+--- code: 96
+--- yaml
+'`': '`'
+
+
+# 65-90 → a-z "lower case letters". No quotes.
+=== Code point 97
+--- code: 97
+--- yaml
+a: a
+
+
+# Some implementations think n means false. This should not be the case in a
+# default schema. No quotes.
+=== Code point 110
+--- code: 110
+--- yaml
+n: n
+
+
+# Some implementations think y means true. This should not be the case in a
+# default schema. No quotes.
+=== Code point 121
+--- code: 121
+--- yaml
+y: y
+
+
+# { is a flow mapping start indicator. Needs quotes.
+=== Code point 123
+--- code: 123
+--- yaml
+'{': '{'
+
+
+# | is a literal scalar indicator. Needs quotes.
+=== Code point 124
+--- code: 124
+--- yaml
+'|': '|'
+
+
+# } is a flow mapping end indicator. Needs quotes.
+=== Code point 125
+--- code: 125
+--- yaml
+'}': '}'
+
+
+# A single ~ has long been used as a plain scalar representation of null. This
+# should be deprecated, but may take a while.
+=== Code point 126
+--- code: 126
+--- yaml
+'~': '~'
+--- unquoted
+~: ~
+
+
+# 127 → "escape"
+# YAML does not have a special character. YAML2 should consider \?.
+=== Code point 127
+--- code: 127
+--- yaml
+"\x7F": "\x7F"
+
+
+# 80-84,86-159 → \x##
+=== Code point 128
+--- code: 128
+--- yaml
+"\x80": "\x80"
+
+
+# 133 (\x85) → "next line" (NEL)
+=== Code point 133
+--- code: 133
+--- yaml
+"\N": "\N"
+
+
+# 160 (\xA0) → "non-breaking space"
+# It seems extremely odd that YAML does not escape this.
+# Investigate further.
+=== Code point 160
+--- SKIP
+--- code: 160
+--- yaml
+ :
+
+
+# 161-… → From here on up use printable unicode chars.
+# XXX Need to look into other special code blocks. Especially those known to
+# libyaml.
+=== Code point 161
+--- code: 161
+--- yaml
+¡: ¡
--- /dev/null
+=== Acme-Time-Baby
+--- 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
+version: 2.106
+version_from: Baby.pm
+installdirs: site
+requires:
+ warnings:
+
+distribution_type: module
+generated_by: ExtUtils::MakeMaker version 6.17
+
+--- perl
+[ {
+ 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',
+} ]
+
--- /dev/null
+=== Data-Swap
+# File with a YAML header
+--- yaml
+\--- #YAML:1.0
+name: Data-Swap
+version: 0.05
+license: perl
+distribution_type: module
+requires:
+ perl: 5.6.0
+dynamic_config: 0
+
+--- perl
+[ {
+ name => 'Data-Swap',
+ version => '0.05',
+ license => 'perl',
+ distribution_type => 'module',
+ requires => {
+ perl => '5.6.0',
+ },
+ dynamic_config => '0',
+} ]
+
+--- nosyck
--- /dev/null
+=== Games-Nintendo-Wii-Mii
+# Testing various failing META.yml files from CPAN
+--- 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:
+ - 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
+
+--- perl
+[ {
+ 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',
+} ]
+
+
--- /dev/null
+=== HTML-WebDAO
+--- yaml
+\--- #YAML:1.0
+name: HTML-WebDAO
+version: 0.04
+author:
+ - |-
+ Zahatski Aliaksandr, E<lt>zagap@users.sourceforge.netE<gt>
+abstract: Perl extension for create complex web application
+license: perl
+
+--- perl
+[ {
+ 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',
+} ]
+
+--- nosyck
+
--- /dev/null
+=== ITS-SIN-FIDS-Content-XML
+# Testing a META.yml from a commercial project that crashed
+--- 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
+version: 0.01
+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
+
+--- perl
+[ {
+ 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',
+} ]
+
--- /dev/null
+#####################################################################
+# Example Plagger Configuration 1
+
+=== Plagger
+--- 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
+--- perl
+[ { 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',
+ },
+ },
+ },
+] } ]
+
+
+#####################################################################
+# Example Plagger Configuration 2
+
+=== plagger2
+--- yaml
+plugins:
+ - module: Subscription::Config
+ config:
+ feed:
+ # Trac's feed for changesets
+ - http://plagger.org/.../rss
+
+ # I don't like to be notified of the same items
+ # more than once
+ - 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'
+
+
+--- perl
+[ { 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',
+ ],
+ },
+} ] } ]
--- /dev/null
+=== Spreadsheet-Read
+--- yaml
+\--- #YAML:1.1
+name: Read
+version: VERSION
+abstract: Meta-Wrapper for reading spreadsheet data
+license: perl
+author:
+ - H.Merijn Brand <h.m.brand@xs4all.nl>
+generated_by: Author
+distribution_type: module
+provides:
+ Spreadsheet::Read:
+ file: Read.pm
+ version: VERSION
+requires:
+ perl: 5.006
+ Exporter: 0
+ Carp: 0
+ Data::Dumper: 0
+recommends:
+ perl: 5.008005
+ File::Temp: 0.14
+ IO::Scalar: 0
+build_requires:
+ perl: 5.006
+ Test::Harness: 0
+ Test::More: 0
+optional_features:
+- opt_csv:
+ description: Provides parsing of CSV streams
+ requires:
+ Text::CSV_XS: 0.23
+ recommends:
+ Text::CSV: 1.10
+ Text::CSV_PP: 1.10
+ Text::CSV_XS: 0.58
+- opt_excel:
+ description: Provides parsing of Microsoft Excel files
+ requires:
+ Spreadsheet::ParseExcel: 0.26
+ Spreadsheet::ParseExcel::FmtDefault: 0
+ recommends:
+ Spreadsheet::ParseExcel: 0.42
+- opt_excelx:
+ description: Provides parsing of Microsoft Excel 2007 files
+ requires:
+ Spreadsheet::XLSX: 0.07
+- opt_oo:
+ description: Provides parsing of OpenOffice spreadsheets
+ requires:
+ Spreadsheet::ReadSXC: 0.2
+- opt_tools:
+ description: Spreadsheet tools
+ recommends:
+ Tk: 0
+ Tk::NoteBook: 0
+ Tk::TableMatrix::Spreadsheet: 0
+resources:
+ license: http://dev.perl.org/licenses/
+meta-spec:
+ version: 1.4
+ url: http://module-build.sourceforge.net/META-spec-v1.4.html
+
+--- perl
+[ {
+ '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'
+} ]
+
+--- noyamlpm
+
--- /dev/null
+=== Template-Provider-Unicode-Japanese
+--- yaml
+---
+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:
+ - inc
+ - t
+requires:
+ Template::Config: 0
+ Unicode::Japanese: 0
+ perl: 5.6.0
+ version: 0
+version: 1.2.1
+
+--- perl
+[ {
+ 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',
+} ]
+
--- /dev/null
+=== vanilla_perl
+# VanillaPerl YAML config file
+--- yaml
+# package info
+package_name: VanillaPerl
+package_version: 5
+
+# directories
+download_dir: c:\temp\vp_sources
+build_dir: c:\temp\vp_build
+image_dir: c:\vanilla-perl
+
+# Binary components
+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:
+ 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:
+ install_to: mingw
+ extra:
+ extra\README.w32api: licenses\win32api\README.w32api
+
+# Source components
+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
+
+# Additional modules to bundle in site\lib
+modules:
+ # i.e. not used, but gets us the libwin32 dist
+ - 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 files to be placed
+# Signature.pm: perl\site\lib\Module\Signature.pm
+extra:
+ README: README.txt
+ LICENSE.txt: LICENSE.txt
+ Changes: Release-Notes.txt
+ extra\Config.pm: perl\lib\CPAN\Config.pm
+ # reset this again
+
+ 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
+
+--- perl
+[ {
+ 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',
+ },
+} ]
+
+--- nosyck
--- /dev/null
+=== CPAN::Meta::YAML
+# Testing CPAN::Meta::YAML's own META.yml file -- at least as of some time ago
+--- 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:
+ - inc
+ - t
+requires:
+ perl: 5.005
+version: 0.03
+
+--- perl
+[ {
+ 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',
+} ]
+
--- /dev/null
+=== toolbar
+# Testing of a known-bad file from an editor
+--- yaml
+main_toolbar:
+ - item file-new
+ - item file-open
+ - item file-print#
+ - item file-close#
+ - item file-save-all
+ - item file-save
+ -
+ - item edit-changes-undo
+ - item edit-changes-redo
+ -
+ - item edit-cut
+ - item edit-copy
+ - item edit-paste
+ - item edit-replace
+ - item edit-delete
+
+--- perl
+[ {
+ 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',
+ ]
+} ]
+
--- /dev/null
+=== yaml_org_example
+# Testing sample data structure from yaml.org
+--- yaml
+---
+invoice: 34843
+date : 2001-01-23
+bill-to:
+ given : Chris
+ family : Dumars
+ address:
+ lines: |
+ 458 Walkman Dr.
+ Suite #292
+ 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: >
+ Late afternoon is best.
+ Backup contact is Nancy
+ Billsmer @ 338-4338.
+
+--- perl
+[ {
+ 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
+} ]
+
+--- nosyck
+
projects / platform / upstream / perl.git / commitdiff