#!perl
sub
HAVE_UTF8 () { $] >= 5.007003 }
BEGIN {
if
( HAVE_UTF8 ) {
eval
"require utf8;"
;
die
"Failed to load UTF-8 support"
if
$@;
}
require
5.004;
$YAML::Tiny::VERSION
=
'1.40'
;
$YAML::Tiny::errstr
=
''
;
}
my
%UNESCAPES
= (
z
=>
"\x00"
,
a
=>
"\x07"
,
t
=>
"\x09"
,
n
=>
"\x0a"
,
v
=>
"\x0b"
,
f
=>
"\x0c"
,
r
=>
"\x0d"
,
e
=>
"\x1b"
,
'\\'
=>
'\\'
, );
sub
new {
my
$class
=
shift
;
bless
[
@_
],
$class
;
}
sub
read
{
my
$class
=
ref
$_
[ 0 ] ?
ref
shift
:
shift
;
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 _;
local
$/ =
undef
;
local
*CFG
;
unless
(
open
( CFG,
$file
) ) {
return
$class
->_error(
"Failed to open file '$file': $!"
);
}
my
$contents
= <CFG>;
unless
(
close
( CFG ) ) {
return
$class
->_error(
"Failed to close file '$file': $!"
);
}
$class
->read_string(
$contents
);
}
sub
read_string {
my
$class
=
ref
$_
[ 0 ] ?
ref
shift
:
shift
;
my
$self
=
bless
[],
$class
;
my
$string
=
$_
[ 0 ];
unless
(
defined
$string
) {
return
$self
->_error(
"Did not provide a string to load"
);
}
if
(
$string
=~ /^(?:\376\377|\377\376|\377\376\0\0|\0\0\376\377)/ ) {
return
$self
->_error(
"Stream has a non UTF-8 BOM"
);
}
else
{
$string
=~ s/^\357\273\277//;
}
utf8::decode(
$string
)
if
HAVE_UTF8;
return
$self
unless
length
$string
;
unless
(
$string
=~ /[\012\015]+\z/ ) {
return
$self
->_error(
"Stream does not end with newline character"
);
}
my
@lines
=
grep
{ ! /^\s*(?:\
split
/(?:\015{1,2}\012|\015|\012)/,
$string
;
@lines
and
$lines
[ 0 ] =~ /^\
%YAML
[: ][\d\.]+.*\z/ and
shift
@lines
;
while
(
@lines
) {
if
(
$lines
[ 0 ] =~ /^---\s*(?:(.+)\s*)?\z/ ) {
shift
@lines
;
if
(
defined
$1 and $1 !~ /^(?:\
push
@$self
,
$self
->_read_scalar(
"$1"
, [
undef
], \
@lines
);
next
;
}
}
if
( !
@lines
or
$lines
[ 0 ] =~ /^(?:---|\.\.\.)/ ) {
push
@$self
,
undef
;
while
(
@lines
and
$lines
[ 0 ] !~ /^---/ ) {
shift
@lines
;
}
}
elsif
(
$lines
[ 0 ] =~ /^\s*\-/ ) {
my
$document
= [];
push
@$self
,
$document
;
$self
->_read_array(
$document
, [ 0 ], \
@lines
);
}
elsif
(
$lines
[ 0 ] =~ /^(\s*)\S/ ) {
my
$document
= {};
push
@$self
,
$document
;
$self
->_read_hash(
$document
, [
length
( $1 ) ], \
@lines
);
}
else
{
croak(
"YAML::Tiny failed to classify the line '$lines[0]'"
);
}
}
$self
;
}
sub
_read_scalar {
my
(
$self
,
$string
,
$indent
,
$lines
) =
@_
;
$string
=~ s/\s*\z//;
return
undef
if
$string
eq
'~'
;
if
(
$string
=~ /^\'(.*?)\'\z/ ) {
return
''
unless
defined
$1;
$string
= $1;
$string
=~ s/\'\'/\'/g;
return
$string
;
}
if
(
$string
=~ /^\"((?:\\.|[^\"])*)\"\z/ ) {
$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
=~ /^[\'\"!&]/ ) {
croak(
"YAML::Tiny does not support a feature in line '$lines->[0]'"
);
}
return
{}
if
$string
eq
'{}'
;
return
[]
if
$string
eq
'[]'
;
return
$string
unless
$string
=~ /^[>|]/;
croak(
"YAML::Tiny failed to find multi-line scalar content"
)
unless
@$lines
;
$lines
->[ 0 ] =~ /^(\s*)/;
$indent
->[ -1 ] =
length
(
"$1"
);
if
(
defined
$indent
->[ -2 ] and
$indent
->[ -1 ] <=
$indent
->[ -2 ] ) {
croak(
"YAML::Tiny found bad indenting in line '$lines->[0]'"
);
}
my
@multiline
= ();
while
(
@$lines
) {
$lines
->[ 0 ] =~ /^(\s*)/;
last
unless
length
( $1 ) >=
$indent
->[ -1 ];
push
@multiline
,
substr
(
shift
(
@$lines
),
length
( $1 ) );
}
my
$j
= (
substr
(
$string
, 0, 1 ) eq
'>'
) ?
' '
:
"\n"
;
my
$t
= (
substr
(
$string
, 1, 1 ) eq
'-'
) ?
''
:
"\n"
;
return
join
(
$j
,
@multiline
) .
$t
;
}
sub
_read_array {
my
(
$self
,
$array
,
$indent
,
$lines
) =
@_
;
while
(
@$lines
) {
if
(
$lines
->[ 0 ] =~ /^(?:---|\.\.\.)/ ) {
while
(
@$lines
and
$lines
->[ 0 ] !~ /^---/ ) {
shift
@$lines
;
}
return
1;
}
$lines
->[ 0 ] =~ /^(\s*)/;
if
(
length
( $1 ) <
$indent
->[ -1 ] ) {
return
1;
}
elsif
(
length
( $1 ) >
$indent
->[ -1 ] ) {
croak(
"YAML::Tiny found bad indenting in line '$lines->[0]'"
);
}
if
(
$lines
->[ 0 ] =~ /^(\s*\-\s+)[^\'\"]\S*\s*:(?:\s+|$)/ ) {
my
$indent2
=
length
(
"$1"
);
$lines
->[ 0 ] =~ s/-/ /;
push
@$array
, {};
$self
->_read_hash(
$array
->[ -1 ], [
@$indent
,
$indent2
],
$lines
);
}
elsif
(
$lines
->[ 0 ] =~ /^\s*\-(\s*)(.+?)\s*\z/ ) {
shift
@$lines
;
push
@$array
,
$self
->_read_scalar(
"$2"
, [
@$indent
,
undef
],
$lines
);
}
elsif
(
$lines
->[ 0 ] =~ /^\s*\-\s*\z/ ) {
shift
@$lines
;
unless
(
@$lines
) {
push
@$array
,
undef
;
return
1;
}
if
(
$lines
->[ 0 ] =~ /^(\s*)\-/ ) {
my
$indent2
=
length
(
"$1"
);
if
(
$indent
->[ -1 ] ==
$indent2
) {
push
@$array
,
undef
;
}
else
{
push
@$array
, [];
$self
->_read_array(
$array
->[ -1 ], [
@$indent
,
$indent2
],
$lines
);
}
}
elsif
(
$lines
->[ 0 ] =~ /^(\s*)\S/ ) {
push
@$array
, {};
$self
->_read_hash(
$array
->[ -1 ], [
@$indent
,
length
(
"$1"
) ],
$lines
);
}
else
{
croak(
"YAML::Tiny failed to classify line '$lines->[0]'"
);
}
}
elsif
(
defined
$indent
->[ -2 ] and
$indent
->[ -1 ] ==
$indent
->[ -2 ] ) {
return
1;
}
else
{
croak(
"YAML::Tiny failed to classify line '$lines->[0]'"
);
}
}
return
1;
}
sub
_read_hash {
my
(
$self
,
$hash
,
$indent
,
$lines
) =
@_
;
while
(
@$lines
) {
if
(
$lines
->[ 0 ] =~ /^(?:---|\.\.\.)/ ) {
while
(
@$lines
and
$lines
->[ 0 ] !~ /^---/ ) {
shift
@$lines
;
}
return
1;
}
$lines
->[ 0 ] =~ /^(\s*)/;
if
(
length
( $1 ) <
$indent
->[ -1 ] ) {
return
1;
}
elsif
(
length
( $1 ) >
$indent
->[ -1 ] ) {
croak(
"YAML::Tiny found bad indenting in line '$lines->[0]'"
);
}
unless
(
$lines
->[ 0 ] =~ s/^\s*([^\'\" ][^\n]*?)\s*:(\s+|$)// ) {
if
(
$lines
->[ 0 ] =~ /^\s*[?\'\"]/ ) {
croak(
"YAML::Tiny does not support a feature in line '$lines->[0]'"
);
}
croak(
"YAML::Tiny failed to classify line '$lines->[0]'"
);
}
my
$key
= $1;
if
(
length
$lines
->[ 0 ] ) {
$hash
->{
$key
} =
$self
->_read_scalar(
shift
(
@$lines
), [
@$indent
,
undef
],
$lines
);
}
else
{
shift
@$lines
;
unless
(
@$lines
) {
$hash
->{
$key
} =
undef
;
return
1;
}
if
(
$lines
->[ 0 ] =~ /^(\s*)-/ ) {
$hash
->{
$key
} = [];
$self
->_read_array(
$hash
->{
$key
}, [
@$indent
,
length
( $1 ) ],
$lines
);
}
elsif
(
$lines
->[ 0 ] =~ /^(\s*)./ ) {
my
$indent2
=
length
(
"$1"
);
if
(
$indent
->[ -1 ] >=
$indent2
) {
$hash
->{
$key
} =
undef
;
}
else
{
$hash
->{
$key
} = {};
$self
->_read_hash(
$hash
->{
$key
}, [
@$indent
,
length
( $1 ) ],
$lines
);
}
}
}
}
return
1;
}
sub
_error {
$YAML::Tiny::errstr
=
$_
[ 1 ];
undef
;
}
sub
errstr {
$YAML::Tiny::errstr
;
}
BEGIN {
if
( $@ ) {
eval
<<'END_PERL';
sub refaddr {
my $pkg = ref($_[0]) or return undef;
if (!!UNIVERSAL::can($_[0], 'can')) {
bless $_[0], 'Scalar::Util::Fake';
} else {
$pkg = undef;
}
"$_[0]" =~ /0x(\w+)/;
my $i = do { local $^W; hex $1 };
bless $_[0], $pkg if defined $pkg;
$i;
}
END_PERL
}
else
{
Scalar::Util->
import
(
'refaddr'
);
}
}
BEGIN {
my
%skip
=
map
{
$_
=> 1 }
qw(
App::FatPacker
Class::Accessor::Classy
Devel::Cover
Module::Install
Moose::Role
POE::Loop::Tk
Template::Test
Test::Kwalitee
Test::Pod::Coverage
Test::Portability::Files
Test::YAML::Meta
open
)
;
my
$Test
= Test::Builder->new;
$Test
->plan(
skip_all
=>
"META.yml could not be found"
)
unless
-f
'META.yml'
and -r _;
my
$meta
= ( Local::YAML::Tiny->
read
(
'META.yml'
) )->[ 0 ];
my
%requires
;
for
my
$require_key
(
grep
{ /requires/ }
keys
%$meta
) {
my
%h
= %{
$meta
->{
$require_key
} };
$requires
{
$_
}++
for
keys
%h
;
}
delete
$requires
{ perl };
diag(
"Testing with Perl $], $^X"
);
for
my
$module
(
sort
keys
%requires
) {
if
(
$skip
{
$module
} ) {
note
"$module doesn't want to be loaded directly, skipping"
;
next
;
}
local
$SIG
{ __WARN__ } =
sub
{ note
"$module: $_[0]"
};
require_ok
$module
or BAIL_OUT(
"can't load $module"
);
my
$version
=
$module
->VERSION;
$version
=
'undefined'
unless
defined
$version
;
diag(
" $module version is $version"
);
}
done_testing;
}