File Coverage

blib/lib/IO/Any.pm

Criterion	Covered	Total	%
statement	28	30	93.3
branch			n/a
condition			n/a
subroutine	10	10	100.0
pod			n/a
total	38	40	95.0

package IO::Any;

use warnings;
use strict;

our $VERSION = '0.07';

use Carp 'confess';
use Scalar::Util 'blessed';
use IO::String;
use IO::File;
use IO::AtomicFile;
use File::Spec;
use Fcntl qw(:flock);
use List::MoreUtils qw(none any);

sub new {
    my $class = shift;
    my $what  = shift;
    my $how   = shift || '<';
    my $opt   = shift || {};
    confess 'too many arguments'
        if @_;

    confess '$what is missing'
        if not defined $what;

    confess 'expecting hash ref'
        if ref $opt ne 'HASH';
    foreach my $key (keys %$opt) {
        confess 'unknown option '.$key
            if (none { $key eq $_ } qw(atomic LOCK_SH LOCK_EX LOCK_NB));
    }

    my ($type, $proper_what) = $class->_guess_what($what);


    if ($type eq 'string') { return IO::String->new($proper_what) }
    if ($type eq 'file')   {
            my $fh = $opt->{'atomic'} ? IO::AtomicFile->new() : IO::File->new();
            $fh->open($proper_what, $how)
                or confess 'error opening file "'.$proper_what.'" - '.$!;

            # locking if requested
            if ($opt->{'LOCK_SH'} or $opt->{'LOCK_EX'}) {
                flock($fh,
                    ($opt->{'LOCK_SH'} ? LOCK_SH : 0)
                    | ($opt->{'LOCK_EX'} ? LOCK_EX : 0)
                    | ($opt->{'LOCK_NB'} ? LOCK_NB : 0)
                ) or confess 'flock failed - '.$!;
            }

            return $fh;
        }
    if ($type eq 'iofile')   { return $proper_what }
    if ($type eq 'iostring') { return $proper_what }
    if ($type eq 'http')     { die 'no http support yet :-|' }
}

sub _guess_what {
    my $class = shift;
    my $what  = shift;

    if (!blessed($what)) { }            # not blessed, do nothing
    elsif ($what->isa('Path::Class::File')) { $what = $what->stringify }
    elsif (any { $what->isa($_) } qw(IO::File IO::AtomicFile IO::Uncompress::Bunzip2)) {
            confess 'passed unopened IO::File'
                if not $what->opened;
            return ('iofile', $what);
        }
    elsif ($what->isa('IO::String')) { return ('iostring', $what) }
    else { confess 'no support for '.blessed($what) };

    my $ref_what = ref($what);
    if ($ref_what eq 'ARRAY')     { return ('file', File::Spec->catfile(@{$what})) }
    elsif ($ref_what eq 'SCALAR') { return ('string', $what) }
    elsif ($ref_what eq '')       {} # do nothing here if not reference
    else { confess 'no support for ref '.(ref $what) }

    # check for typeglobs
    if ((ref \$what eq 'GLOB') and (my $fh = *{$what}{IO})) {
        return ('iofile', $fh);
    }

    if ($what =~ m{^file://(.+)$}) { return ('file', $1) }              # local file
    if ($what =~ m{^https?://})    { return ('http', $what) }           # http link
    if ($what =~ m{^<})            { return ('string', $what) }         # xml string
    if ($what =~ m(^{))            { return ('string', $what) }         # json string
    if ($what =~ m{^\[})           { return ('string', $what) }         # json string
    if ($what =~ m{\n[\s\w]})      { return ('string', $what) }         # multi-line string
    if ($what eq '')               { return ('string', '') }            # empty string
                                   { return ('file', $what) }           # default is filename
}

sub read {
    my $class = shift;
    my $what  = shift;
    my $opt   = shift;
    confess 'too many arguments'
        if @_;

    return $class->new($what, '<', $opt);
}

sub write {
    my $class = shift;
    my $what  = shift;
    my $opt   = shift;
    confess 'too many arguments'
        if @_;

    return $class->new($what, '>', $opt);
}

sub slurp {
    my $class = shift;
    my $what  = shift;
    my $opt   = shift;
    confess 'too many arguments'
        if @_;

    my $fh = $class->read($what, $opt);

    # use event loop when AnyEvent is loaded (skip IO::String, doesn't work and makes no sense)
    # not supported under MSWin32
    if ($INC{'AnyEvent.pm'} and not $fh->isa('IO::String') and ($^O ne 'MSWin32')) {
        eval 'use AnyEvent::Handle'
            if not $INC{'AnyEvent/Handle.pm'};
        my $eof = AnyEvent->condvar;
        my $content = '';
        my $hdl = AnyEvent::Handle->new(
            fh      => $fh,
            on_read => sub {
                $content .= delete $_[0]->{'rbuf'};
            },
            on_eof  => sub {
                $eof->send;
            },
            on_error => sub {
                my ($hdl, $fatal, $msg) = @_;
                $hdl->destroy;
                $eof->croak($msg);
            }
        );

        $eof->recv;
        $hdl->destroy;
        close $fh;
        return $content;
    }

    my $content = do { local $/; <$fh> };
    close $fh;
    return $content;
}

sub spew {
    my $class = shift;
    my $what  = shift;
    my $data  = shift;
    my $opt   = shift;
    confess 'too many arguments'
        if @_;

    # "parade" to allow safe locking
    my $fh = $class->new($what, '+>>', $opt);
    $fh->seek(0,0);
    $fh->truncate(0);

    # use event loop when AnyEvent is loaded (skip IO::String, doesn't work and makes no sense)
    if ($INC{'AnyEvent.pm'} and not $fh->isa('IO::String')) {
        eval 'use AnyEvent::Handle'
            if not $INC{'AnyEvent/Handle.pm'};

        my $eof = AnyEvent->condvar;
        my $hdl = AnyEvent::Handle->new(
            fh       => $fh,
            on_drain => sub {
                $eof->send;
            },
            on_error => sub {
                my ($hdl, $fatal, $msg) = @_;
                $hdl->destroy;
                $eof->croak($msg);
            }
        );

        $hdl->push_write($data);

        $eof->recv;
        $hdl->destroy;
        close $fh;
        return;
    }

    print $fh $data;
    $fh->close || confess 'failed to close file - '.$!;
    return;
}

1;


__END__