Catmandu-BagIt

 view release on metacpan or  search on metacpan

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

    my ($self) = @_;
    keys %{$self->_sums};
}

# Return the checksum of of a file name
sub get_checksum {
    my ($self,$file) = @_;

    die "usage: get_checksum(file)" unless $file;

    $self->_sums->{$file};
}

# Read the content of a bag
sub read {
    my ($class,$path) = @_;

    die "usage: read(path)" unless $path;

    my $self = $class->new;

    if (! -d $path ) {
        $self->log->error("$path doesn't exist");
        $self->_push_error("$path doesn't exist");
        return;
    }

    $self->log->info("reading: $path");

    $self->_path($path);

    my $ok = 0;

    $ok += $self->_read_version($path);
    $ok += $self->_read_info($path);
    $ok += $self->_read_manifest($path);
    $ok += $self->_read_tag_manifest($path);
    $ok += $self->_read_tags($path);
    $ok += $self->_read_files($path);
    $ok += $self->_read_fetch($path);

    $self->_dirty(0);

    if ( wantarray ) {
        return $ok == 7 ? ($self) : (undef, $self->errors);
    }
    else {
        return $ok == 7 ? $self : undef;
    }
}

# Write the content of a bag back to disk
sub write {
    my ($self,$path,%opts) = @_;

    $self->_error([]);

    die "usage: write(path[, overwrite => 1])" unless $path;

    # Check if other processes are writing or previous processes died
    if ($self->locked($path)) {
        $self->log->error("$path is locked");
        $self->_push_error("$path is locked");
        return undef;
    }

    if (defined($self->path) && $path ne $self->path) {
        # If the bag is copied from to a new location than all the tag files and
        # files should be flagged as dirty and need to be overwritten
        $self->log->info("copying from old path: " . $self->path);
        $self->_dirty($self->dirty | FLAG_BAGIT | FLAG_BAG_INFO | FLAG_TAG_MANIFEST | FLAG_MANIFEST | FLAG_DATA);

        foreach my $item ($self->list_files) {
            $item->flag($item->flag ^ FLAG_DIRTY);
        }
    }
    elsif (defined($self->path) && $path eq $self->path) {
        # we are ok the path exists and don't need to remove anything
        # updates are possible when overwrite => 1
    }
    elsif ($opts{overwrite} && -d $path) {
        # Remove existing bags
        $self->log->info("removing: $path");
        path($path)->remove_tree;
    }

    if (-f $self->_bagit_file($path)) {
        if ($opts{overwrite}) {
            $self->log->info("overwriting: $path");
        }
        else {
            $self->log->error("$path already exists");
            $self->_push_error("$path already exists");
            return undef;
        }
    }
    else {
        $self->log->info("creating: $path");
        path($path)->mkpath;
        $self->_dirty($self->dirty | FLAG_BAGIT);
    }

    unless ($self->touch($self->_lock_file($path))) {
        $self->log->error("failed to lock in $path");
        return undef;
    }

    $self->_path($path);

    my $ok = 0;

    $ok += $self->_write_bagit($path);
    $ok += $self->_write_info($path);
    $ok += $self->_write_data($path);
    $ok += $self->_write_fetch($path);
    $ok += $self->_write_manifest($path);
    $ok += $self->_write_tag_manifest($path);

    return undef unless $ok == 6;

    $self->_dirty(0);

    unlink($self->_lock_file($path));

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

}

sub _bag_info_file {
    my ($self,$path) = @_;

    File::Spec->catfile($path,'bag-info.txt');
}

sub _package_info_file {
    my ($self,$path) = @_;

    File::Spec->catfile($path,'package-info.txt');
}

sub _manifest_file {
    my ($self,$path) = @_;

    for my $alg (qw(md5 sha512 sha256 sha1)) {
      my $p = File::Spec->catfile($path,"manifest-$alg.txt");
      return ($p,$alg) if -f $p;
    }

    return (undef,undef);
}

sub _tagmanifest_file {
    my ($self,$path) = @_;

    for my $alg (qw(md5 sha512 sha256 sha1)) {
      my $p = File::Spec->catfile($path,"tagmanifest-$alg.txt");
      return ($p,$alg) if -f $p;
    }

    return (undef,undef);
}

sub _fetch_file {
    my ($self,$path) = @_;

    File::Spec->catfile($path,'fetch.txt');
}

sub _tag_file {
    my ($self,$path,$file) = @_;

    File::Spec->catfile($path,$file);
}

sub _payload_file {
    my ($self,$path,$file) = @_;

    File::Spec->catfile($path,'data',$file);
}

sub _lock_file {
    my ($self,$path) = @_;

    File::Spec->catfile($path,'.lock');
}

sub locked {
    my ($self,$path) = @_;
    $path //= $self->path;

    return undef unless defined($path);

    -f $self->_lock_file($path);
}

sub touch {
    my ($self,$path) = @_;

    die "usage: touch(path)"
            unless defined($path);

    path("$path")->spew("");

    1;
}

sub add_file {
    my ($self, $filename, $data, %opts) = @_;

    die "usage: add_file(filename, data [, overwrite => 1])"
            unless defined($filename) && defined($data);

    $self->_error([]);

    unless ($self->_is_legal_file_name($filename)) {
        $self->log->error("illegal file name $filename");
        $self->_push_error("illegal file name $filename");
        return;
    }

    $self->log->info("adding file $filename");

    if ($opts{overwrite}) {
        $self->remove_file($filename);
    }

    if ($self->get_checksum("$filename")) {
        $self->log->error("$filename already exists in bag");
        $self->_push_error("$filename already exists in bag");
        return;
    }

    my $payload = Catmandu::BagIt::Payload->from_any($filename,$data);
    $payload->flag(FLAG_DIRTY);

    my $sum;

    if ( is_string($opts{md5}) ) {
        if ($self->algorithm ne 'md5') {
            $self->log->error("need a " . $self->algorithm . " checksum not an md5");
            $self->_push_error("need a " . $self->algorithm . " checksum not an md5");
            return;
        }
        elsif ($opts{md5} =~ /^[0-9a-f]{32}$/) {
            $sum = $opts{md5};
        }
        else {

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

    for my $file ($bagit->list_files) {
        my $stat = [stat($file->path)];
        printf " name: %s\n", $file->filename;
        printf " size: %s\n", $stat->[7];
        printf " last-mod: %s\n", scalar(localtime($stat->[9]));
    }

    my $file = $bagit->get_file("mydata.txt");
    my $fh   = $file->open;

    while (<$fh>) {
       ....
    }

    close($fh);

    print "dirty?\n" if $bagit->is_dirty;

    if ($bagit->complete) {
        print "bag is complete\n";
    }
    else {
        print "bag is not complete!\n";
    }

    if ($bagit->valid) {
        print "bag is valid\n";
    }
    else {
        print "bag is not valid!\n";
    }

    if ($bagit->is_holey) {
        print "bag is holey\n";
    }
    else {
        print "bag isn't holey\n";
    }

    if ($bagit->errors) {
        print join("\n",$bagit->errors);
    }

    # Write operations
    $bagit->add_info('My-Tag','fsdfsdfsdf');
    $bagit->add_info('My-Tag',['dfdsf','dfsfsf','dfdsf']);
    $bagit->remove_info('My-Tag');

    $bagit->add_file("test.txt","my text");
    $bagit->add_file("data.pdf", IO::File->new("/tmp/data.pdf"));
    $bagit->remove_file("test.txt");

    $bagit->add_fetch("http://www.gutenberg.org/cache/epub/1980/pg1980.txt","290000","shortstories.txt");
    $bagit->remove_fetch("shortstories.txt");

    if ($bagit->errors) {
        print join("\n",$bagit->errors);
        exit;
    }

    unless ($bagit->locked) {
        $bagit->write("bags/demo04"); # fails when the bag already exists
        $bagit->write("bags/demo04", new => 1); # recreate the bag when it already existed
        $bagit->write("bags/demo04", overwrite => 1); # overwrites an exiting bag
    }

=head1 CATMANDU MODULES

=over

=item * L<Catmandu::Importer::BagIt>

=item * L<Catmandu::Exporter::BagIt>

=item * L<Catmandu::Store::File::BagIt>

=back

=head1 LARGE FILE SUPPORT

Streaming large files into a BagIt requires a large /tmp directory. The location
of the temp directory can be set with the TMPDIR environmental variable.

=head1 METHODS

=head2 new()

=head2 new(version => ... , algorithm => 'md5|sha1|sha256|sha512')

Create a new BagIt object

=head2 read($directory)

Open an exiting BagIt object and return an instance of BagIt or undef on failure.
In array context the read method also returns all errors as an array:

  my $bagit = Catmandu::BagIt->read("/data/my-bag");

  my ($bagit,@errors) = Catmandu::BagIt->read("/data/my-bag");

=head2 write($directory, [%options])

Write a BagIt to disk. Options: new => 1 recreate the bag when it already existed, overwrite => 1 overwrite
and existing bag (updating the changed tags/files);

=head2 locked

Check if a process has locked the BagIt. Or, a previous process didn't complete the write operations.

=head2 path()

Return the path to the BagIt.

=head2 version()

Return the version of the BagIt.

=head2 encoding()

Return the encoding of the BagIt.

=head2 size()

Return a human readble string of the expected size of the BagIt (adding the actual sizes found on disk plus
the files that need to be fetched from the network).

=head2 payload_oxum()

Return the actual payload oxum of files found in the package.

=head2 is_dirty()

Return true when the BagIt contains changes not yet written to disk.

=head2 is_holey()

Return true when the BagIt contains a non emtpy fetch configuration.

=head2 is_error()

Return an ARRAY of errors when checking complete, valid and write.

=head2 complete()

Return true when the BagIt is complete (all files and manifest files are consistent).

=head2 valid()

Returns true when the BagIt is complete and all checkums match the files on disk.

=head2 list_info_tags()

Return an ARRAY of tag names found in bagit-info.txt.

=head2 add_info($tag,$value)

=head2 add_info($tag,[$values])

Add an info $tag with a $value.

=head2 remove_info($tag)

Remove an info $tag.

=head2 get_info($tag, [$delim])

Return an ARRAY of values found for the $tag name. Or, in scalar context, return a string of
all values optionally delimeted by $delim.