view release on metacpan or  search on metacpan

lib/Catmandu/Exporter/BagIt.pm  view on Meta::CPAN

           ],
    };

=head1 METHODS

This module inherits all methods of L<Catmandu::Exporter>.

=head1 CONFIGURATION

In addition to the configuration provided by L<Catmandu::Exporter> the exporter can
be configured with the following parameters:

=over

=item ignore_existing

Optional. Skip an item when the BagIt for it already exists.

=item overwrite

Optional. Throws an Catmandu::Error when the exporter tries to overwrite an existing directory.

=back

=head1 SEE ALSO

L<Catmandu>,
L<Catmandu::Exporter>,
L<Archive::BagIt>

=head1 AUTHOR

Patrick Hochstenbach <Patrick.Hochstenbach@UGent.be>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2014 by Patrick Hochstenbach.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut

use namespace::clean;
use Catmandu::Sane;
use Catmandu::BagIt;
use Path::Tiny;
use File::Spec;
use IO::File;
use LWP::Simple;
use Moo;

with 'Catmandu::Exporter';

has user_agent      => (is => 'ro');
has ignore_existing => (is => 'ro' , default => sub { 0 });
has overwrite       => (is => 'ro' , default => sub { 0 });

sub _mtime {
    my $file = $_[0];
    my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks) = stat($file);
    return $mtime;
}

sub add {
    my ($self, $data) = @_;
    my $directory = $data->{_id};
    $directory =~ s{\/$}{};

    return 1 if -d $directory && $self->ignore_existing;

    Catmandu::Error->throw("$directory exists") if -d $directory && ! $self->overwrite;

    my $bagit = defined($self->user_agent) ?
                    Catmandu::BagIt->new(user_agent => $self->user_agent) :
                    Catmandu::BagIt->new();

    if (exists $data->{tags}) {
        for my $tag (keys %{$data->{tags}}) {
            $bagit->add_info($tag,$data->{tags}->{$tag});
        }
    }

    if (exists $data->{fetch}) {
        for my $fetch (@{$data->{fetch}}) {
            my ($url) = keys %$fetch;
            my $file  = $fetch->{$url};

            my $data_dir = File::Spec->catfile($directory,'data');

            path($data_dir)->mkpath unless -d $data_dir;

            my $tmp = Path::Tiny->tempfile
                    or Catmandu::Error->throw("Could not create temp file");

            # For now using a simplistic mirror operation
            my $fname    = $tmp->stringify;
            my $response = $bagit->user_agent->mirror($url,$fname);

            unless ($response->is_success) {
                undef($tmp);
                Catmandu::Error->throw("failed to mirror $url to $fname : " . $response->status_line);
            }

            $file =~ s{^data/}{};
            $bagit->add_file($file,IO::File->new($fname));
            # close the bag to keep the number of open file handles to a minimum
            # only the files that are flagged 'dirty' will be written
            $bagit->write($directory, overwrite => 1);

            undef($tmp);
        }
    }
    if ( exists $data->{files} ) {

        for my $file ( @{ $data->{files} } ) {

            my($source)     = keys %$file;
            my $destination = $file->{$source};

            -f $source or Catmandu::Error->throw("source file $source does not exist");