Browse Source

- refactored, using Archive::BagIt instead Archive::BagIt::Base

master
Andreas Romeyke 1 month ago
parent
commit
ef518a167a
9 changed files with 40 additions and 40 deletions
  1. +5
    -5
      lib/Archive/BagIt.pm
  2. +1
    -1
      lib/Archive/BagIt/Role/Plugin.pm
  3. +1
    -1
      t/access_bag.t
  4. +1
    -1
      t/base.t
  5. +1
    -1
      t/fast.t
  6. +2
    -2
      t/internal.t
  7. +2
    -2
      t/pod-coverage.t
  8. +8
    -8
      t/store_bag.t
  9. +19
    -19
      t/verify_bag.t

+ 5
- 5
lib/Archive/BagIt.pm View File

@ -15,11 +15,11 @@ with "Archive::BagIt::Role::Portability";
# VERSION
# ABSTRACT: The common base for Archive::BagIt. This is the module for experts. ;)
# ABSTRACT: The main module to handle bags.
=head1 NAME
Achive::BagIt::Base - The common base for both Bagit and dotBagIt
Achive::BagIt - The main module to handle Bags
=head1 SYNOPSIS
@ -317,7 +317,7 @@ has 'bag_version' => (
Getter for bag encoding.
HINT: the current version of Archive::BagIt::Base only supports UTF-8, but the method could return other values depending on given Bags.
HINT: the current version of Archive::BagIt only supports UTF-8, but the method could return other values depending on given Bags.
=cut
@ -1260,7 +1260,7 @@ If there a data directory exists, assume it is already a bag (no checking for in
sub make_bag {
my ($class, $bag_path, $options) = @_;
my $isa = ref $class;
if ($isa eq "Archive::BagIt::Base") { # not a class, but an object!
if ($isa eq "Archive::BagIt") { # not a class, but an object!
croak "make_bag() only a class subroutine, not useable with objects. Try store() instead!\n";
}
my $self = $class->init_metadata($bag_path, $options);
@ -1295,7 +1295,7 @@ On network filesystem (CIFS, 1Gb) with same Bag:
Fast 2.20/s -- -11%
Base 2.48/s 13% --
But you should measure which variant is best for you. In general the default C<Archive::BagIt::Base> is fast enough.
But you should measure which variant is best for you. In general the default C<Archive::BagIt> is fast enough.
=head2 How to update an old bag of version v0.97 to v1.0?


+ 1
- 1
lib/Archive/BagIt/Role/Plugin.pm View File

@ -13,7 +13,7 @@ has plugin_name => (
has bagit => (
is => 'ro',
#isa => 'Archive::BagIt::Base',
#isa => 'Archive::BagIt',
required => 1,
weak_ref => 1,
);


+ 1
- 1
t/access_bag.t View File

@ -16,7 +16,7 @@ use Data::Printer;
use File::Path;
use File::Copy;
my $Class = 'Archive::BagIt::Base';
my $Class = 'Archive::BagIt';
use_ok($Class);
my @ROOT = grep {length} 'src';


+ 1
- 1
t/base.t View File

@ -16,7 +16,7 @@ use Data::Printer;
use File::Path;
use File::Copy;
my $Class = 'Archive::BagIt::Base';
my $Class = 'Archive::BagIt';
use_ok($Class);
my @ROOT = grep {length} 'src';


+ 1
- 1
t/fast.t View File

@ -17,7 +17,7 @@ plan skip_all => "IO::AIO required for testing Archive::BagIt::Fast"
my $Class = 'Archive::BagIt::Fast';
my $ClassBase = 'Archive::BagIt::Base';
my $ClassBase = 'Archive::BagIt';
use_ok($Class);
use_ok($ClassBase);


+ 2
- 2
t/internal.t View File

@ -66,8 +66,8 @@ is(Archive::BagIt::Role::Portability::chomp_portable("foo\r"), "foo", "chomp_por
is(Archive::BagIt::Role::Portability::chomp_portable("foo\r\n"), "foo", "chomp_portable(), \\r\\n");
use_ok('Archive::BagIt::Base');
my $obj = new_ok('Archive::BagIt::Base');
use_ok('Archive::BagIt');
my $obj = new_ok('Archive::BagIt');
is($obj->__file_find(qw(../bagit_conformance_suite/v0.97/valid/bag-in-a-bag)), 13, '__file_find');
is($obj->__file_find(qw(../bagit_conformance_suite/v0.97/valid/bag-in-a-bag/data)), 9, '__file_find');
is($obj->__file_find(qw(../bagit_conformance_suite/v0.97/valid/bag-in-a-bag), qw(../bagit_conformance_suite/v0.97/valid/bag-in-a-bag/data)), 4, '__file_find');


+ 2
- 2
t/pod-coverage.t View File

@ -15,6 +15,6 @@ eval "use Pod::Coverage $min_pc";
plan skip_all => "Pod::Coverage $min_pc required for testing POD coverage"
if $@;
plan tests => 3;
pod_coverage_ok("Archive::BagIt");
pod_coverage_ok("Archive::BagIt::Base", { also_private =>[ qw( BUILD BUILDARGS) ]});
pod_coverage_ok("Archive::BagIt", { also_private =>[ qw( BUILD BUILDARGS) ]});
pod_coverage_ok("Archive::BagIt::Base");
pod_coverage_ok("Archive::BagIt::Fast");

+ 8
- 8
t/store_bag.t View File

@ -22,14 +22,14 @@ use File::Slurp qw( read_file write_file);
my $special = '#--Ä--ä--Ö--ö--Ü--ü--ß--.[{!}].--$';
my $special_re = qr|#--Ä--ä--Ö--ö--Ü--ü--ß--\.\[\{!\}\]\.--\$|;
use_ok('Archive::BagIt::Base');
use_ok('Archive::BagIt');
{
note("simple bag");
my $dir = tempdir(CLEANUP => 1);
mkdir(File::Spec->catdir($dir, "data"));
write_file(File::Spec->catfile($dir, "data", "1.txt"), "1");
ok(Archive::BagIt::Base->make_bag($dir), "make_bag()");
ok(Archive::BagIt->make_bag($dir), "make_bag()");
file_exists_ok(File::Spec->catfile($dir, "bag-info.txt"));
file_exists_ok(File::Spec->catfile($dir, "bagit.txt"));
file_exists_ok(File::Spec->catfile($dir, "data", "1.txt"));
@ -57,7 +57,7 @@ use_ok('Archive::BagIt::Base');
mkdir(File::Spec->catdir($dir, "meta"));
write_file(File::Spec->catfile($dir, "meta", "rights.xml"));
my $bag;
my $warning = Test::Warnings::warning { $bag = Archive::BagIt::Base->make_bag($dir) };
my $warning = Test::Warnings::warning { $bag = Archive::BagIt->make_bag($dir) };
like (
$warning->[0] ,
qr/possible non portable pathname detected/s,
@ -69,7 +69,7 @@ use_ok('Archive::BagIt::Base');
'Got expexted warning from make_bag()',
) or diag 'got unexpected warnings:' , explain($warning);
isnt($bag->force_utf8(), 1, "force_utf8 set");
isa_ok($bag, 'Archive::BagIt::Base', "make_bag(), force_utf8");
isa_ok($bag, 'Archive::BagIt', "make_bag(), force_utf8");
file_exists_ok(File::Spec->catfile($dir, "bag-info.txt"));
file_exists_ok(File::Spec->catfile($dir, "bagit.txt"));
file_exists_ok(File::Spec->catfile($subdir, "1.txt"));
@ -98,8 +98,8 @@ use_ok('Archive::BagIt::Base');
write_file($datafile2, "1");
mkdir(File::Spec->catdir($dir, "meta"));
write_file(File::Spec->catfile($dir, "meta", "rights.xml"));
my $bag = Archive::BagIt::Base->make_bag($dir, {force_utf8 => 1});
isa_ok($bag, 'Archive::BagIt::Base', "make_bag(), force_utf8");
my $bag = Archive::BagIt->make_bag($dir, {force_utf8 => 1});
isa_ok($bag, 'Archive::BagIt', "make_bag(), force_utf8");
is($bag->force_utf8(), 1, "force_utf8 set");
file_exists_ok(File::Spec->catfile($dir, "bag-info.txt"));
file_exists_ok(File::Spec->catfile($dir, "bagit.txt"));
@ -125,7 +125,7 @@ use_ok('Archive::BagIt::Base');
mkdir(File::Spec->catdir($dir, "data"));
write_file(File::Spec->catfile($dir, "data", "1.txt"), '');
my $bag;
my $warning = Test::Warnings::warning { $bag = Archive::BagIt::Base->make_bag($dir) };
my $warning = Test::Warnings::warning { $bag = Archive::BagIt->make_bag($dir) };
like (
$warning->[0] ,
qr/empty file .* detected/,
@ -137,7 +137,7 @@ use_ok('Archive::BagIt::Base');
'Got expected warning from make_bag()',
) or diag 'got unexpected warnings:' , explain($warning);
ok ($bag, "Object created");
isa_ok ($bag, 'Archive::BagIt::Base');
isa_ok ($bag, 'Archive::BagIt');
file_exists_ok(File::Spec->catfile($dir, "bag-info.txt"));
file_exists_ok(File::Spec->catfile($dir, "bagit.txt"));
file_exists_ok(File::Spec->catfile($dir, "data", "1.txt"));


+ 19
- 19
t/verify_bag.t View File

@ -18,7 +18,7 @@ use File::Copy;
use File::Temp qw(tempdir);
use File::Slurp qw( read_file write_file);
my $Class1 = 'Archive::BagIt::Base';
my $Class1 = 'Archive::BagIt';
use_ok($Class1);
my $Class2 = 'Archive::BagIt::Fast';
use_ok($Class2);
@ -64,14 +64,14 @@ foreach my $prefix (@prefix_manifestfiles) {
_prepare_bag($bag_dir);
SKIP: {
skip "skipped because testbag could not created", 1 unless -d $bag_dir;
my $bag_ok = Archive::BagIt::Base->make_bag($bag_dir);
isa_ok($bag_ok, 'Archive::BagIt::Base', "create new valid IE bagit");
my $bag_ok = Archive::BagIt->make_bag($bag_dir);
isa_ok($bag_ok, 'Archive::BagIt', "create new valid IE bagit");
ok($bag_ok->verify_bag(), "check if bag is verified correctly");
my $bag_ok2 = Archive::BagIt::Base->make_bag("$bag_dir/"); #add slash at end of $bag_dir
isa_ok($bag_ok2, 'Archive::BagIt::Base', "create new valid IE bagit (with slash)");
my $bag_ok2 = Archive::BagIt->make_bag("$bag_dir/"); #add slash at end of $bag_dir
isa_ok($bag_ok2, 'Archive::BagIt', "create new valid IE bagit (with slash)");
ok($bag_ok2->verify_bag(), "check if bag is verified correctly (with slash)");
_modify_bag("$bag_dir/$prefix-$alg.txt");
my $bag_invalid1 = new_ok("Archive::BagIt::Base" => [ bag_path => $bag_dir ]);
my $bag_invalid1 = new_ok("Archive::BagIt" => [ bag_path => $bag_dir ]);
my $bag_invalid2 = new_ok("Archive::BagIt::Fast" => [ bag_path => $bag_dir ]);
throws_ok(
@ -88,7 +88,7 @@ foreach my $prefix (@prefix_manifestfiles) {
}, qr{bag verify for bagit version '1.0' failed with invalid files}, "check if bag fails verification of broken $prefix-$alg.txt (all errors)");
my $bag_invalid3 = new_ok("Archive::BagIt::Base" => [ bag_path => $bag_dir ]);
my $bag_invalid3 = new_ok("Archive::BagIt" => [ bag_path => $bag_dir ]);
throws_ok(
sub {
$bag_invalid3->verify_bag()
@ -108,15 +108,15 @@ foreach my $prefix (@prefix_manifestfiles) {
_prepare_bag($bag_dir);
SKIP: {
skip "skipped because testbag could not created", 1 unless -d $bag_dir;
my $bag_ok = Archive::BagIt::Base->make_bag($bag_dir);
isa_ok($bag_ok, 'Archive::BagIt::Base', "create new valid IE bagit");
my $bag_ok = Archive::BagIt->make_bag($bag_dir);
isa_ok($bag_ok, 'Archive::BagIt', "create new valid IE bagit");
ok($bag_ok->verify_bag(), "check if bag is verified correctly");
write_file("$bag_dir/data/payload1.txt", "PAYLOAD_MODIFIED1");
# write_file("$bag_dir/data/payload2.txt", "PAYLOAD2" );
write_file("$bag_dir/data/payload3.txt", "PAYLOAD3_MODIFIED3");
_modify_bag("$bag_dir/tagmanifest-sha512.txt");
_modify_bag("$bag_dir/tagmanifest-md5.txt");
my $bag_invalid1 = new_ok("Archive::BagIt::Base" => [ bag_path => $bag_dir ]);
my $bag_invalid1 = new_ok("Archive::BagIt" => [ bag_path => $bag_dir ]);
throws_ok(
sub {
$bag_invalid1->verify_bag()
@ -124,7 +124,7 @@ foreach my $prefix (@prefix_manifestfiles) {
qr{file.*'data/payload1.txt'.* invalid, digest.*'}s,
"check if bag fails verification of broken fixity for payload (all errors)"
);
my $bag_invalid2 = new_ok("Archive::BagIt::Base" => [ bag_path => $bag_dir ]);
my $bag_invalid2 = new_ok("Archive::BagIt" => [ bag_path => $bag_dir ]);
throws_ok(
sub {
$bag_invalid2->verify_bag(
@ -199,14 +199,14 @@ foreach my $prefix (@prefix_manifestfiles) {
my $bagdir = $entry->[0];
my $descr = $bagdir; $descr =~ s|../bagit_conformance_suite/||;
my $expected = $entry->[1];
my $bag = new_ok ("Archive::BagIt::Base" => [ bag_path => $bagdir ]);
my $bag = new_ok ("Archive::BagIt" => [ bag_path => $bagdir ]);
throws_ok(sub{ $bag->verify_bag();}, $expected, "conformance v0.97, fail: $descr");
}
foreach my $entry ( @should_pass_bags_097) {
my $bagdir = $entry->[0];
my $descr = $bagdir; $descr =~ s|../bagit_conformance_suite/||;
my $expected = $entry->[1];
my $bag = new_ok ("Archive::BagIt::Base" => [ bag_path => $bagdir ]);
my $bag = new_ok ("Archive::BagIt" => [ bag_path => $bagdir ]);
ok(sub{ $bag->verify_bag();}, "conformance v0.97, pass: $descr");
}
@ -215,7 +215,7 @@ foreach my $prefix (@prefix_manifestfiles) {
my $bagdir = $entry->[0];
my $descr = $bagdir; $descr =~ s|../bagit_conformance_suite/||;
my $expected = $entry->[1];
my $bag = new_ok ("Archive::BagIt::Base" => [ bag_path => $bagdir ]);
my $bag = new_ok ("Archive::BagIt" => [ bag_path => $bagdir ]);
throws_ok(sub{ $bag->verify_bag();}, $expected, "conformance v1.0, fail: $descr");
}
foreach my $entry ( @should_pass_bags_100) {
@ -223,15 +223,15 @@ foreach my $prefix (@prefix_manifestfiles) {
my $descr = $bagdir; $descr =~ s|../bagit_conformance_suite/||;
my $expected = $entry->[1];
my $bag = new_ok ("Archive::BagIt::Base" => [ bag_path => $bagdir ]);
my $bag = new_ok ("Archive::BagIt" => [ bag_path => $bagdir ]);
ok(sub{ $bag->verify_bag();}, "conformance v1.0, pass: $descr");
}
{ # check if payload oxum is verified correctly
my $bag_dir = File::Temp::tempdir(CLEANUP => 1);
_prepare_bag($bag_dir);
my $bag_ok = Archive::BagIt::Base->make_bag($bag_dir);
isa_ok($bag_ok, 'Archive::BagIt::Base', "create new valid IE bagit");
my $bag_ok = Archive::BagIt->make_bag($bag_dir);
isa_ok($bag_ok, 'Archive::BagIt', "create new valid IE bagit");
ok($bag_ok->verify_bag(), "check if bag is verified correctly");
# modify payload oxum
my $bif = File::Spec->catfile($bag_dir, "bag-info.txt");
@ -239,11 +239,11 @@ foreach my $prefix (@prefix_manifestfiles) {
$bi =~ s/Payload-Oxum: .*/Payload-Oxum: 0.0/;
write_file($bif, $bi);
# also modify tagmanifest files to be valid
my $bag = Archive::BagIt::Base->new( $bag_dir);
my $bag = Archive::BagIt->new( $bag_dir);
foreach my $algorithm ( keys %{ $bag->manifests }) {
ok($bag->manifests->{$algorithm}->create_tagmanifest(), "rewrite tagmanifests for $algorithm");
}
my $bag_invalid = Archive::BagIt::Base->new( $bag_dir);
my $bag_invalid = Archive::BagIt->new( $bag_dir);
throws_ok(
sub {
$bag_invalid->verify_bag(


Loading…
Cancel
Save