File Coverage

blib/lib/YAML/Syck.pm

Criterion	Covered	Total	%
statement	66	91	72.5
branch	24	32	75.0
condition	2	6	33.3
subroutine	13	13	100.0
pod	0	5	0.0
total	105	147	71.4

package YAML::Syck;

# See documentation after the __END__ mark.

use strict;
use vars qw(
  @ISA @EXPORT @EXPORT_OK $VERSION
  $Headless $SortKeys $SingleQuote
  $ImplicitBinary $ImplicitTyping $ImplicitUnicode
  $UseCode $LoadCode $DumpCode
  $DeparseObject $LoadBlessed
);
use 5.006;
use Exporter;

BEGIN {
    $VERSION   = '1.30_01';
    @EXPORT    = qw( Dump Load DumpFile LoadFile );
    @EXPORT_OK = qw( DumpInto );
    @ISA       = qw( Exporter );

    $SortKeys    = 1;
    $LoadBlessed = 1;

    local $@;
    eval {
        require XSLoader;
        XSLoader::load( __PACKAGE__, $VERSION );
        1;
    } or do {
        require DynaLoader;
        push @ISA, 'DynaLoader';
        __PACKAGE__->bootstrap($VERSION);
    };

}

use constant QR_MAP => {
    ''   => sub { qr{$_[0]} },
    x    => sub { qr{$_[0]}x },
    i    => sub { qr{$_[0]}i },
    s    => sub { qr{$_[0]}s },
    m    => sub { qr{$_[0]}m },
    ix   => sub { qr{$_[0]}ix },
    sx   => sub { qr{$_[0]}sx },
    mx   => sub { qr{$_[0]}mx },
    si   => sub { qr{$_[0]}si },
    mi   => sub { qr{$_[0]}mi },
    ms   => sub { qr{$_[0]}sm },
    six  => sub { qr{$_[0]}six },
    mix  => sub { qr{$_[0]}mix },
    msx  => sub { qr{$_[0]}msx },
    msi  => sub { qr{$_[0]}msi },
    msix => sub { qr{$_[0]}msix },
};

sub __qr_helper {
    if ( $_[0] =~ /\A  \(\?  ([ixsm]*)  (?:-  (?:[ixsm]*))?  : (.*) \)  \z/x ) {
        my $sub = QR_MAP()->{$1} || QR_MAP()->{''};
        &$sub($2);
    }
    else {
        qr/$_[0]/;
    }
}

sub Dump {
    $#_
      ? join( '', map { YAML::Syck::DumpYAML($_) } @_ )
      : YAML::Syck::DumpYAML( $_[0] );
}

sub Load {
    if (wantarray) {
        my ($rv) = YAML::Syck::LoadYAML( $_[0] );
        @{$rv};
    }
    else {
        @_ = $_[0];
        goto &YAML::Syck::LoadYAML;
    }
}

sub _is_glob {
    my $h = shift;

    return 1 if ( ref($h) eq 'GLOB' );
    return 1 if ( ref( \$h ) eq 'GLOB' );
    return 1 if ( ref($h) =~ m/^IO::/ );

    return;
}

sub DumpFile {
    my $file = shift;
    if ( _is_glob($file) ) {
        for (@_) {
            my $err = YAML::Syck::DumpYAMLFile( $_, $file );
            if ($err) {
                $! = 0 + $err;
                die "Error writing to filehandle $file: $!\n";
            }
        }
    }
    else {
        open( my $fh, '>', $file ) or die "Cannot write to $file: $!";
        for (@_) {
            my $err = YAML::Syck::DumpYAMLFile( $_, $fh );
            if ($err) {
                $! = 0 + $err;
                die "Error writing to file $file: $!\n";
            }
        }
        close $fh
          or die "Error writing to file $file: $!\n";
    }
    return 1;
}

sub LoadFile {
    my $file = shift;
    if ( _is_glob($file) ) {
        Load(
            do { local $/; <$file> }
        );
    }
    else {
        if ( !-e $file || -z $file ) {
            die("'$file' is empty or non-existent");
        }
        open( my $fh, '<', $file ) or die "Cannot read from $file: $!";
        Load(
            do { local $/; <$fh> }
        );
    }
}

sub DumpInto {
    my $bufref = shift;
    ( ref $bufref ) or die "DumpInto not given reference to output buffer\n";
    YAML::Syck::DumpYAMLInto( $_, $bufref ) for @_;
    1;
}

1;

__END__