view release on metacpan or  search on metacpan

inc/YAML/Tiny.pm  view on Meta::CPAN

    r => "\x0d", e => "\x1b", '\\' => '\\',
);

# Special magic boolean words
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
};





#####################################################################
# 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];
    eval {
        unless ( defined $string ) {
            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//;
        }

        # 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/ ) {
            die \"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 {
                die \"YAML::Tiny failed to classify the line '$lines[0]'";
            }
        }
    };
    if ( ref $@ eq 'SCALAR' ) {
        return $self->_error(${$@});
    } elsif ( $@ ) {