view release on metacpan or  search on metacpan

t/000_report_versions.t  view on Meta::CPAN

#!perl
use warnings;
use strict;
use Test::More 0.88;
use Config;

# Include a cut-down version of YAML::Tiny so we don't introduce unnecessary
# dependencies ourselves.

package Local::YAML::Tiny;

use strict;
use Carp 'croak';

# UTF Support?
sub HAVE_UTF8 () { $] >= 5.007003 }

BEGIN {
	if (HAVE_UTF8) {

		# The string eval helps hide this from Test::MinimumVersion
		eval "require utf8;";
		die "Failed to load UTF-8 support" if $@;
	}

	# Class structure
	require 5.004;
	$YAML::Tiny::VERSION = '1.40';

	# Error storage
	$YAML::Tiny::errstr = '';
} ## end BEGIN

# Printable characters for escapes
my %UNESCAPES = (
	z    => "\x00",
	a    => "\x07",
	t    => "\x09",
	n    => "\x0a",
	v    => "\x0b",
	f    => "\x0c",
	r    => "\x0d",
	e    => "\x1b",
	'\\' => '\\',
);


#####################################################################
# Implementation

# Create an empty YAML::Tiny object
sub new {
	my $class = shift;
	bless [@_], $class;
}

# Create an object from a file
sub read {
	my $class = ref $_[0] ? ref shift : shift;

	# Check the file
	my $file = shift
	  or return $class->_error('You did not specify a file name');
	return $class->_error("File '$file' does not exist") unless -e $file;
	return $class->_error("'$file' is a directory, not a file") unless -f _;
	return $class->_error("Insufficient permissions to read '$file'")
	  unless -r _;

	# Slurp in the file
	local $/ = undef;
	local *CFG;
	unless ( open( CFG, $file ) ) {
		return $class->_error("Failed to open file '$file': $!");
	}
	my $contents = <CFG>;
	unless ( close(CFG) ) {
		return $class->_error("Failed to close file '$file': $!");
	}

	$class->read_string($contents);
} ## end sub read

# Create an object from a string
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");
	}

	# 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)/ ) {
		return $self->_error("Stream has a non UTF-8 BOM");
	} else {

		# Strip UTF-8 bom if found, we'll just ignore it
		$string =~ s/^\357\273\277//;
	}

	# Try to decode as utf8
	utf8::decode($string) if HAVE_UTF8;

	# Check for some special cases
	return $self unless length $string;
	unless ( $string =~ /[\012\015]+\z/ ) {
		return $self->_error("Stream does not end with newline character");
	}

	# Split the file into lines
	my @lines = grep { !/^\s*(?:\#.*)?\z/ }
	  split /(?:\015{1,2}\012|\015|\012)/, $string;

	# Strip the initial YAML header
	@lines and $lines[0] =~ /^\%YAML[: ][\d\.]+.*\z/ and shift @lines;

	# A nibbling parser
	while (@lines) {

		# Do we have a document header?
		if ( $lines[0] =~ /^---\s*(?:(.+)\s*)?\z/ ) {

			# Handle scalar documents
			shift @lines;
			if ( defined $1 and $1 !~ /^(?:\#.+|\%YAML[: ][\d\.]+)\z/ ) {
				push @$self, $self->_read_scalar( "$1", [undef], \@lines );
				next;
			}
		}

		if ( !@lines or $lines[0] =~ /^(?:---|\.\.\.)/ ) {

			# A naked document
			push @$self, undef;
			while ( @lines and $lines[0] !~ /^---/ ) {
				shift @lines;
			}

		} elsif ( $lines[0] =~ /^\s*\-/ ) {

			# An array at the root
			my $document = [];
			push @$self, $document;
			$self->_read_array( $document, [0], \@lines );

		} elsif ( $lines[0] =~ /^(\s*)\S/ ) {

			# A hash at the root
			my $document = {};
			push @$self, $document;
			$self->_read_hash( $document, [ length($1) ], \@lines );

		} else {
			croak("YAML::Tiny failed to classify the line '$lines[0]'");
		}
	} ## end while (@lines)

	$self;
} ## end sub read_string

# Deparse a scalar string to the actual scalar
sub _read_scalar {