view release on metacpan or  search on metacpan

t/000-report-versions.t  view on Meta::CPAN

#!perl
#
# This file is part of App-KeePass2
#
# This software is copyright (c) 2013 by celogeek <me@celogeek.com>.
#
# This is free software; you can redistribute it and/or modify it under
# the same terms as the Perl 5 programming language system itself.
#
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',