File Coverage

blib/lib/Catmandu/FileBag.pm

Criterion	Covered	Total	%
statement	57	77	74.0
branch	11	22	50.0
condition	4	12	33.3
subroutine	10	11	90.9
pod	4	5	80.0
total	86	127	67.7

package Catmandu::FileBag;

our $VERSION = '1.16';

use Catmandu::Sane;
use IO::String;
use Catmandu::Util qw(:is :check);
use Moo::Role;
use namespace::clean;

sub stream {
    my ($self, $io, $data) = @_;
    check_hash_ref($data);
    check_invocant($io);
    $data->{_stream}->($io);
}

sub as_string {
    my ($self, $data) = @_;
    check_hash_ref($data);
    my $str;
    my $io = IO::String->new($str);
    $data->{_stream}->($io);
    $str;
}

sub as_string_utf8 {
    my ($self, $data) = @_;
    check_hash_ref($data);
    my $str;
    my $io = IO::String->new($str);
    $data->{_stream}->($io);
    utf8::decode($str);
    $str;
}

sub upload {
    my ($self, $io, $id) = @_;
    check_string($id);
    check_invocant($io);

    my $file = {_id => $id, _stream => $io};

    $self->add($file);

    # The add() method of FileBags should inline data the passed $file with
    # file metadata. Use a get($id) when this inline update wasn't implemented
    # by the Bag.
    if (exists $file->{size}) {

        # all ok
    }
    else {
        $self->log->warn(
            "$self doesn't inline update \$data in add(\$data) method");
        $file = $self->get($id);
    }

    if (!defined($file)) {
        return 0;
    }
    elsif (is_hash_ref($file)) {
        return $file->{size};
    }
    else {
        $self->log->error("expecting a HASH but got `$file'");
        return 0;
    }
}

# Helper method to implement file streaming in Dancer contexts
sub file_streamer {
    my ($self,$file,$out)  = @_;
    my $bytes = 0;
    my $data  = IO::File->new($file, "r")
        || Catmandu::Error->throw("$file not readable");

    Catmandu::Error->throw("no io defined or not writable")
        unless defined($out);

    Catmandu::Error->throw("$out doesn't support syswrite!")
        unless $out->can('syswrite');

    OUTER: while (!$data->eof) {
        my $buffer;
        my $n_read = $data->read($buffer, 1024);

        if (!defined($n_read)) {
            $self->log->error("read error for $file : $!");
            Catmandu::Error->throw("read error for $file : $!");
        }
        elsif ($n_read == 0) {
            # end-of-file
            last;
        }
        else {
            # all is ok
        }

        my $bytes_to_write = $n_read;
        my $bytes_written  = 0;

        while ($bytes_to_write) {
            my $n_write = $out->syswrite($buffer,$bytes_to_write);

            if ($!{EINTR} || $!{EWOULDBLOCK} || $!{EAGAIN}) {
                # no data read, try again
                next;
            }
            elsif ($!) {
                $self->log->error("write failed : $!");
                last OUTER;
            }
            elsif (!defined($n_write) || $n_write == 0) {
                $self->log->error("write failed : no bytes written");
                last OUTER;
            }
            elsif ($n_read < $n_write) {
                # incomplete write
                $buffer = substr($buffer,$n_write);
            }
            else {
                # all is ok
            }

            $bytes_to_write -= $n_write;
            $bytes_written   = $n_write;
        }

        $bytes += $bytes_written;
    }

    $out->close();
    $data->close();

    $bytes;
}

1;

__END__

=pod

=head1 NAME

Catmandu::FileBag - A Catmandu::FileStore compartment to persist binary data

=head1 SYNOPSIS

    use Catmandu;

    my $store = Catmandu->store('Simple' , root => 't/data');

    # List all containers
    $store->bag->each(sub {
        my $container = shift;

        print "%s\n" , $container->{_id};
    });

    # Add a new folder
    $store->bag->add({ _id => '1234' });

    # Get the files
    my $files = $store->bag->files('1234');

    # Add a file to the files
    $files->upload(IO::File->new('<foobar.txt'), 'foobar.txt');

    # Stream the contents of a file
    my $file = $files->get('foobar.txt');
    $files->stream(IO::File->new('>foobar.txt'), $file);

    # Delete a file
    $files->delete('foobar.txt');

    # Delete a folder
    $store->index->delete('1234');


=head1 DESCRIPTION

Each L<Catmandu::FileBag> is a L<Catmandu::Bag> and inherits all its methods.

=head1 METHODS

=head2 upload($io, $file_name)

An helper application to add an IO::Handle $io to the L<Catmandu::FileBag>. Returns
the number of bytes written.

=head2 stream($io, $file)

A helper application to stream the contents of a L<Catmandu::FileBag> item
to an IO::Handle. Returns the number of bytes written.

=head2 as_string($file)

Return the contents of the L<Catmandu::FileBag> item as a string.

=head2 as_string_utf8($file)

Return the contents of the L<Catmandu::FileBag> item as an UTF-8 string.

=head1 SEE ALSO

L<Catmandu::FileStore> ,
L<Catmandu::FileBag::Index>

=cut