Catmandu-BagIt

 view release on metacpan or  search on metacpan

README  view on Meta::CPAN

        $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
        }

CATMANDU MODULES

      * Catmandu::Importer::BagIt

      * Catmandu::Exporter::BagIt

README  view on Meta::CPAN

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

 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);

 locked

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

 path()

    Return the path to the BagIt.

 version()

    Return the version of the BagIt.

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

# 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) {

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

    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) = @_;

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

    $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>

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

  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()

script/bagit.pl  view on Meta::CPAN

        print STDERR "$directory is not a bag\n";
        exit(2);
    }

    if ($replace) {
        $bagit->remove_info($tag);
    }

    $bagit->add_info($tag,$value);

    unless ($bagit->locked) {
        $bagit->write($directory, overwrite => 1);
    }

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

sub cmd_removeinfo {

script/bagit.pl  view on Meta::CPAN

    my $bagit = Catmandu::BagIt->read($directory);

    unless ($bagit) {
        print STDERR "$directory is not a bag\n";
        exit(2);
    }

    $bagit->remove_info($tag);

    unless ($bagit->locked) {
        $bagit->write($directory, overwrite => 1);
    }

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

sub cmd_create {

script/bagit.pl  view on Meta::CPAN

        my $cpath = substr(File::Spec->canonpath($path),length($cdirectory) + 1);
        $bagit->add_file($cpath, IO::File->new($path));
        print "$cpath <-- $path\n";
    }

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

    unless ($bagit->locked) {
        $bagit->write($directory, overwrite => 1);
    }
}

sub cmd_read {
    my ($directory) = shift;

    croak "No such directory: $directory" unless -d $directory;

    my $bagit = Catmandu::BagIt->read($directory);

t/Catmandu-BagIt.t  view on Meta::CPAN

    is $size , 65 , 'got the correct size';

    remove_path($bag_dir);
}

note("lock");
{
    my $bagit = Catmandu::BagIt->read("bags/demo03");

    ok ! $bagit->locked , '!locked';

    $bagit = Catmandu::BagIt->new;

    ok $bagit->write($bag_dir);

    $bagit->touch("$bag_dir/.lock");

    ok $bagit->locked , 'locked';

    remove_path($bag_dir);
}

note("pipe");
{
  SKIP: {
      skip "ENV{PIPETEST} not set", 4 unless $ENV{PIPETEST};

      my $pipe = new IO::Pipe;