view release on metacpan or  search on metacpan

lib/Catmandu/Store/File/Simple/Bag.pm  view on Meta::CPAN

use Path::Tiny;
use File::Spec;
use File::Copy;
use Catmandu::Util qw(content_type);
use URI::Escape;
use namespace::clean;

with 'Catmandu::Bag';
with 'Catmandu::FileBag';
with 'Catmandu::Droppable';

has _path => (is => 'lazy');

sub _build__path {
    my $self = shift;
    $self->store->directory_index->add($self->name)->{_path};
}

sub generator {
    my ($self) = @_;
    my $path = $self->_path;

    sub {
        state $children = [path($path)->children];

        my $child = shift @$children;

        return undef unless $child;

        my ($volume, $directories, $file) = File::Spec->splitpath($child);

        next if index($file, ".") == 0;

        my $unpacked_key = $self->unpack_key($file);

        return $self->get($unpacked_key);
    };
}

sub exists {
    my ($self, $id) = @_;
    my $path = $self->_path;

    my $packed_key = $self->pack_key($id);

    my $file = File::Spec->catfile($path, $packed_key);

    -f $file;
}

sub get {
    my ($self, $id) = @_;
    my $path = $self->_path;

    my $packed_key = $self->pack_key($id);

    my $file = File::Spec->catfile($path, $packed_key);

    return undef unless -f $file;

    my $stat = [stat($file)];

    my $size     = $stat->[7];
    my $modified = $stat->[9];
    my $created  = $stat->[10];    # no real creation time exists on Unix

    my $content_type = content_type($id);

    return {
        _id          => $id,
        size         => $size,
        md5          => '',
        content_type => $content_type,
        created      => $created,
        modified     => $modified,
        _stream      => sub {
            my $out   = $_[0];
            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');

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

                my $n = $out->syswrite($buffer);

                if ($!{EAGAIN}) {
                    # no data read, try later
                    next;
                }
                elsif ($!) {
                    $self->log->error("filesystem error for $file : $!");
                    Catmandu::Error->throw("filesystem error for $file : $!");
                }
                elsif (!defined($n)) {
        		    $n = 0;
        		}
        		elsif ($n != length $buffer) {
        		    $self->log->error("incomplete write to $file");
                    Catmandu::Error->throw("incomplete write to $file");
        		}
        		else {
        		    # all is ok
        		}

                $bytes += $n;
            }

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

            $bytes;
        }
    };