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.94;

# 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    = '';
}

# 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 );
}

# 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");