6 # Include a cut-down version of YAML::Tiny so we don't introduce unnecessary
7 # dependencies ourselves.
9 package Local::YAML::Tiny;
15 sub HAVE_UTF8 () { $] >= 5.007003 }
18 # The string eval helps hide this from Test::MinimumVersion
20 die "Failed to load UTF-8 support" if $@;
25 $YAML::Tiny::VERSION = '1.40';
28 $YAML::Tiny::errstr = '';
31 # Printable characters for escapes
33 z => "\x00", a => "\x07", t => "\x09",
34 n => "\x0a", v => "\x0b", f => "\x0c",
35 r => "\x0d", e => "\x1b", '\\' => '\\',
39 #####################################################################
42 # Create an empty YAML::Tiny object
48 # Create an object from a file
50 my $class = ref $_[0] ? ref shift : shift;
53 my $file = shift or return $class->_error( 'You did not specify a file name' );
54 return $class->_error( "File '$file' does not exist" ) unless -e $file;
55 return $class->_error( "'$file' is a directory, not a file" ) unless -f _;
56 return $class->_error( "Insufficient permissions to read '$file'" ) unless -r _;
61 unless ( open(CFG, $file) ) {
62 return $class->_error("Failed to open file '$file': $!");
65 unless ( close(CFG) ) {
66 return $class->_error("Failed to close file '$file': $!");
69 $class->read_string( $contents );
72 # Create an object from a string
74 my $class = ref $_[0] ? ref shift : shift;
75 my $self = bless [], $class;
77 unless ( defined $string ) {
78 return $self->_error("Did not provide a string to load");
82 # NOTE: Keeping this here to educate maintainers
84 # "\357\273\277" => 'UTF-8',
85 # "\376\377" => 'UTF-16BE',
86 # "\377\376" => 'UTF-16LE',
87 # "\377\376\0\0" => 'UTF-32LE'
88 # "\0\0\376\377" => 'UTF-32BE',
90 if ( $string =~ /^(?:\376\377|\377\376|\377\376\0\0|\0\0\376\377)/ ) {
91 return $self->_error("Stream has a non UTF-8 BOM");
93 # Strip UTF-8 bom if found, we'll just ignore it
94 $string =~ s/^\357\273\277//;
97 # Try to decode as utf8
98 utf8::decode($string) if HAVE_UTF8;
100 # Check for some special cases
101 return $self unless length $string;
102 unless ( $string =~ /[\012\015]+\z/ ) {
103 return $self->_error("Stream does not end with newline character");
106 # Split the file into lines
107 my @lines = grep { ! /^\s*(?:\#.*)?\z/ }
108 split /(?:\015{1,2}\012|\015|\012)/, $string;
110 # Strip the initial YAML header
111 @lines and $lines[0] =~ /^\%YAML[: ][\d\.]+.*\z/ and shift @lines;
115 # Do we have a document header?
116 if ( $lines[0] =~ /^---\s*(?:(.+)\s*)?\z/ ) {
117 # Handle scalar documents
119 if ( defined $1 and $1 !~ /^(?:\#.+|\%YAML[: ][\d\.]+)\z/ ) {
120 push @$self, $self->_read_scalar( "$1", [ undef ], \@lines );
125 if ( ! @lines or $lines[0] =~ /^(?:---|\.\.\.)/ ) {
128 while ( @lines and $lines[0] !~ /^---/ ) {
132 } elsif ( $lines[0] =~ /^\s*\-/ ) {
133 # An array at the root
135 push @$self, $document;
136 $self->_read_array( $document, [ 0 ], \@lines );
138 } elsif ( $lines[0] =~ /^(\s*)\S/ ) {
141 push @$self, $document;
142 $self->_read_hash( $document, [ length($1) ], \@lines );
145 croak("YAML::Tiny failed to classify the line '$lines[0]'");
152 # Deparse a scalar string to the actual scalar
154 my ($self, $string, $indent, $lines) = @_;
156 # Trim trailing whitespace
157 $string =~ s/\s*\z//;
159 # Explitic null/undef
160 return undef if $string eq '~';
163 if ( $string =~ /^\'(.*?)\'\z/ ) {
164 return '' unless defined $1;
166 $string =~ s/\'\'/\'/g;
169 if ( $string =~ /^\"((?:\\.|[^\"])*)\"\z/ ) {
170 # Reusing the variable is a little ugly,
171 # but avoids a new variable and a string copy.
173 $string =~ s/\\"/"/g;
174 $string =~ s/\\([never\\fartz]|x([0-9a-fA-F]{2}))/(length($1)>1)?pack("H2",$2):$UNESCAPES{$1}/gex;
179 if ( $string =~ /^[\'\"!&]/ ) {
180 croak("YAML::Tiny does not support a feature in line '$lines->[0]'");
182 return {} if $string eq '{}';
183 return [] if $string eq '[]';
185 # Regular unquoted string
186 return $string unless $string =~ /^[>|]/;
189 croak("YAML::Tiny failed to find multi-line scalar content") unless @$lines;
191 # Check the indent depth
192 $lines->[0] =~ /^(\s*)/;
193 $indent->[-1] = length("$1");
194 if ( defined $indent->[-2] and $indent->[-1] <= $indent->[-2] ) {
195 croak("YAML::Tiny found bad indenting in line '$lines->[0]'");
201 $lines->[0] =~ /^(\s*)/;
202 last unless length($1) >= $indent->[-1];
203 push @multiline, substr(shift(@$lines), length($1));
206 my $j = (substr($string, 0, 1) eq '>') ? ' ' : "\n";
207 my $t = (substr($string, 1, 1) eq '-') ? '' : "\n";
208 return join( $j, @multiline ) . $t;
213 my ($self, $array, $indent, $lines) = @_;
216 # Check for a new document
217 if ( $lines->[0] =~ /^(?:---|\.\.\.)/ ) {
218 while ( @$lines and $lines->[0] !~ /^---/ ) {
224 # Check the indent level
225 $lines->[0] =~ /^(\s*)/;
226 if ( length($1) < $indent->[-1] ) {
228 } elsif ( length($1) > $indent->[-1] ) {
229 croak("YAML::Tiny found bad indenting in line '$lines->[0]'");
232 if ( $lines->[0] =~ /^(\s*\-\s+)[^\'\"]\S*\s*:(?:\s+|$)/ ) {
234 my $indent2 = length("$1");
235 $lines->[0] =~ s/-/ /;
237 $self->_read_hash( $array->[-1], [ @$indent, $indent2 ], $lines );
239 } elsif ( $lines->[0] =~ /^\s*\-(\s*)(.+?)\s*\z/ ) {
240 # Array entry with a value
242 push @$array, $self->_read_scalar( "$2", [ @$indent, undef ], $lines );
244 } elsif ( $lines->[0] =~ /^\s*\-\s*\z/ ) {
250 if ( $lines->[0] =~ /^(\s*)\-/ ) {
251 my $indent2 = length("$1");
252 if ( $indent->[-1] == $indent2 ) {
258 $self->_read_array( $array->[-1], [ @$indent, $indent2 ], $lines );
261 } elsif ( $lines->[0] =~ /^(\s*)\S/ ) {
263 $self->_read_hash( $array->[-1], [ @$indent, length("$1") ], $lines );
266 croak("YAML::Tiny failed to classify line '$lines->[0]'");
269 } elsif ( defined $indent->[-2] and $indent->[-1] == $indent->[-2] ) {
270 # This is probably a structure like the following...
276 # ... so lets return and let the hash parser handle it
280 croak("YAML::Tiny failed to classify line '$lines->[0]'");
289 my ($self, $hash, $indent, $lines) = @_;
292 # Check for a new document
293 if ( $lines->[0] =~ /^(?:---|\.\.\.)/ ) {
294 while ( @$lines and $lines->[0] !~ /^---/ ) {
300 # Check the indent level
301 $lines->[0] =~ /^(\s*)/;
302 if ( length($1) < $indent->[-1] ) {
304 } elsif ( length($1) > $indent->[-1] ) {
305 croak("YAML::Tiny found bad indenting in line '$lines->[0]'");
309 unless ( $lines->[0] =~ s/^\s*([^\'\" ][^\n]*?)\s*:(\s+|$)// ) {
310 if ( $lines->[0] =~ /^\s*[?\'\"]/ ) {
311 croak("YAML::Tiny does not support a feature in line '$lines->[0]'");
313 croak("YAML::Tiny failed to classify line '$lines->[0]'");
317 # Do we have a value?
318 if ( length $lines->[0] ) {
320 $hash->{$key} = $self->_read_scalar( shift(@$lines), [ @$indent, undef ], $lines );
325 $hash->{$key} = undef;
328 if ( $lines->[0] =~ /^(\s*)-/ ) {
330 $self->_read_array( $hash->{$key}, [ @$indent, length($1) ], $lines );
331 } elsif ( $lines->[0] =~ /^(\s*)./ ) {
332 my $indent2 = length("$1");
333 if ( $indent->[-1] >= $indent2 ) {
335 $hash->{$key} = undef;
338 $self->_read_hash( $hash->{$key}, [ @$indent, length($1) ], $lines );
349 $YAML::Tiny::errstr = $_[1];
360 #####################################################################
361 # Use Scalar::Util if possible, otherwise emulate it
365 require Scalar::Util;
368 # Failed to load Scalar::Util
371 my $pkg = ref($_[0]) or return undef;
372 if (!!UNIVERSAL::can($_[0], 'can')) {
373 bless $_[0], 'Scalar::Util::Fake';
377 "$_[0]" =~ /0x(\w+)/;
378 my $i = do { local $^W; hex $1 };
379 bless $_[0], $pkg if defined $pkg;
384 Scalar::Util->import('refaddr');
389 #####################################################################
391 #####################################################################
397 # Skip modules that either don't want to be loaded directly, such as
398 # Module::Install, or that mess with the test count, such as the Test::*
399 # modules listed here.
401 # Moose::Role conflicts if Moose is loaded as well, but Moose::Role is in
402 # the Moose distribution and it's certain that someone who uses
403 # Moose::Role also uses Moose somewhere, so if we disallow Moose::Role,
404 # we'll still get the relevant version number.
406 my %skip = map { $_ => 1 } qw(
408 Class::Accessor::Classy
416 Test::Portability::Files
420 my $Test = Test::Builder->new;
422 $Test->plan(skip_all => "META.yml could not be found")
423 unless -f 'META.yml' and -r _;
425 my $meta = (Local::YAML::Tiny->read('META.yml'))->[0];
427 for my $require_key (grep { /requires/ } keys %$meta) {
428 my %h = %{ $meta->{$require_key} };
429 $requires{$_}++ for keys %h;
431 delete $requires{perl};
433 diag("Testing with Perl $], $^X");
434 for my $module (sort keys %requires) {
435 if ($skip{$module}) {
436 note "$module doesn't want to be loaded directly, skipping";
439 local $SIG{__WARN__} = sub { note "$module: $_[0]" };
440 use_ok $module or BAIL_OUT("can't load $module");
441 my $version = $module->VERSION;
442 $version = 'undefined' unless defined $version;
443 diag(" $module version is $version");