diff --git a/Makefile b/Makefile index 75fe830f7..af9270793 100644 --- a/Makefile +++ b/Makefile @@ -1,5 +1,16 @@ -.PHONY: cover test update +usage: + @echo "usage: make TARGET" + @echo + @echo "targets:" + @echo " generate" + @echo " update" + @echo " test" + @echo " cover" +generate: + carton exec bin/librecat generate forms + carton exec bin/librecat generate departments + update: git pull --tags origin master carton install diff --git a/config/files.yml b/config/files.yml index e979e2c40..699383eaf 100644 --- a/config/files.yml +++ b/config/files.yml @@ -8,7 +8,7 @@ default: &filestore_settings package: Simple options: root: data/file_uploads - + api: buffer_size: 8192 access: @@ -34,21 +34,19 @@ access_thumbnailer: files: *filestore_settings access: *accessstore_settings -# Demo -fedora: +# Install Catmandu::BagIt for this demo +bagit_demo: + package: BagIt + options: + root: data/bag_uploads + +# Install Catmandu::FedoraCommons for this demo +fedora_demo: package: FedoraCommons options: - url: http://localhost:8080/fedora - user: fedoraAdmin + baseurl: http://localhost:8080/fedora + username: fedoraAdmin password: fedoraAdmin namespace: demo - dsnamespace: DS - md5enabled: 1 - versionable: 0 + model: DC purge: 1 - -# Demo -bagit: - package: BagIt - options: - root: data/bag_uploads diff --git a/cpanfile b/cpanfile index d90406d6c..50c899406 100644 --- a/cpanfile +++ b/cpanfile @@ -20,7 +20,7 @@ requires 'Business::ISBN', 0; requires 'Module::Install', '1.16'; # Catmandu -requires 'Catmandu', '>=1.06'; +requires 'Catmandu', '>=1.0603'; requires 'Catmandu::Exporter::Table'; requires 'Search::Elasticsearch', '>=5.02'; requires 'Search::Elasticsearch::Client::1_0','>=5.02'; diff --git a/data/bag_uploads/.gitignore b/data/bag_uploads/.gitignore deleted file mode 100644 index e69de29bb..000000000 diff --git a/lib/LibreCat/Cmd/file_store.pm b/lib/LibreCat/Cmd/file_store.pm index 32f172d90..15bd36ee3 100644 --- a/lib/LibreCat/Cmd/file_store.pm +++ b/lib/LibreCat/Cmd/file_store.pm @@ -6,11 +6,10 @@ use LibreCat::App::Helper; use LibreCat::Validator::Publication; use Carp; use IO::File; +use IO::Pipe; use File::Basename; use File::Path; use File::Spec; -use Data::Dumper; -use REST::Client; use URI::Escape; use POSIX qw(strftime); use parent qw(LibreCat::Cmd); @@ -32,8 +31,8 @@ librecat file_store [options] thumbnail options: --store=... - Store name - --file_store=... - LibreCat::FileStore class - --file_opt=... - LibreCat::FileStore option + --file_store=... - Catmandu::Store::File class + --file_opt=... - Catmandu::Store::File option --tmp_dir=... - Temporary directory --zip=... - Zip program --unzip=... - Unzip program @@ -73,7 +72,7 @@ sub file_opt { sub load { my ($self, $file_store, $file_opt) = @_; my $pkg - = Catmandu::Util::require_package($file_store, 'LibreCat::FileStore'); + = Catmandu::Util::require_package($file_store, 'Catmandu::Store::File'); $pkg->new(%$file_opt); } @@ -167,52 +166,56 @@ sub command { sub _list { my ($self, @args) = @_; my $store = $self->app->global_options->{store}; - my $gen = $store->list; + my $index = $store->index; if ($self->app->global_options->{csv}) { printf join("\t", qw(id file_name access_level relation embargo)) . "\n"; } - while (my $key = $gen->()) { - my $container = $store->get($key); + $index->each(sub { + my $key = $_[0]->{_id}; + my $files = $index->files($key); - croak "failed to create a container for key `$key`" - unless defined($container); + croak "failed to find the files for key `$key`" + unless defined($files); - my $created = $container->created; - my $modified = $container->modified; - - my @files = $container->list; + my $file_array = $files->to_array; + my $modified; + my $created; my $size = 0; - for (@files) { - $size += $_->size; + for (@$file_array) { + $modified = $_->{modified} if (!defined($modified) || $_->{modified} > $modified); + $created = $_->{created} if (!defined($created) || $_->{created} > $created); + $size += $_->{size}; } if ($self->app->global_options->{csv}) { - for (@files) { - next if $_->key eq 'thumbnail.png'; - printf join("\t", $key, $_->key, '', '', '') . "\n"; + for (@$file_array) { + next if $_->{_id} eq 'thumbnail.png'; + printf join("\t", $key, $_->{_id}, '', '', '') . "\n"; } } else { if ($args[0] && $args[0] eq 'recursive') { - for (@files) { - printf "%s %s %s %s %s\n", $key, $_->key, + for (@$file_array) { + printf "%s %s %s %s %s\n", $key, $_->{key}, strftime("%Y-%m-%dT%H:%M:%S", - localtime($_->modified)), $_->size, $_->md5; + localtime($_->{modified})), $_->{size}, $_->{md5}; } } else { - printf "%-40.40s %4d %9d %-20.20s %-20.20s\n", $key, - int(@files), $size, + printf "%-40.40s %4d %9d %-20.20s %-20.20s\n", + $key, + int(@$file_array), + $size, strftime("%Y-%m-%dT%H:%M:%S", localtime($modified)), strftime("%Y-%m-%dT%H:%M:%S", localtime($created)); } } - } + }); return 0; } @@ -223,7 +226,7 @@ sub _exists { croak "exists - need a key" unless defined($key); my $store = $self->app->global_options->{store}; - my $ans = $store->exists($key); + my $ans = $store->index->exists($key); printf "$key %s\n", $ans ? "EXISTS" : "NOT_FOUND"; @@ -235,34 +238,32 @@ sub _get { croak "get - need a key" unless defined($key); - my $store = $self->app->global_options->{store}; - my $container = $store->get($key); + my $store = $self->app->global_options->{store}; - croak "get - failed to load $key" unless $container; + croak "get - failed to load $key" unless $store->index->exists($key); - my @files = $container->list; + my $files = $store->index->files($key); + my $file_array = $files->to_array; if ($self->app->global_options->{csv}) { printf join("\t", qw(id file_name access_level relation embargo)) . "\n"; - for my $file (@files) { - next if $file->key eq 'thumbnail.png'; - printf join("\t", $key, $file->key, '', '', '') . "\n"; + for my $file (@$file_array) { + next if $file->{_id} eq 'thumbnail.png'; + printf join("\t", $key, $file->{_id}, '', '', '') . "\n"; } } else { - printf "key: %s\n", $container->key; - printf "created: %s\n", scalar localtime($container->created); - printf "modified: %s\n", scalar localtime($container->modified); - printf "#files: %d\n", int(@files); - - for my $file (@files) { - my $key = $file->key; - my $size = $file->size; - my $md5 = $file->md5; - my $modified = $file->modified; - my $content_type = $file->content_type // '???'; + printf "key: %s\n", $key; + printf "#files: %d\n", int(@$file_array); + + for my $file (@$file_array) { + my $key = $file->{_id}; + my $size = $file->{size}; + my $md5 = $file->{md5}; + my $modified = $file->{modified}; + my $content_type = $file->{content_type} // '???'; printf "%-40.40s %9d $md5 %s %s\n", $content_type, $size, strftime("%Y-%m-%dT%H:%M:%S", localtime($modified)), $key; @@ -278,29 +279,20 @@ sub _fetch { croak "get - need a key" unless defined($key); croak "get - need a file" unless defined($filename); - my $store = $self->app->global_options->{store}; - my $container = $store->get($key); + my $store = $self->app->global_options->{store}; + + croak "get - failed to load $key" unless $store->index->exists($key); - croak "get - failed to load $key" unless $container; + my $files = $store->index->files($key); + my $file = $files->get($filename); - my $file = $container->get($filename); + croak "get - failed to open $filename" unless $file; binmode(STDOUT, ':raw'); - # Avoid forking processes and check for callbacks - if ($file->is_callback) { - $file->data->(*STDOUT); - } - else { - my $io = $file->fh; - while (defined($io) && !$io->eof) { - my $buffer; - my $len = $io->read($buffer, 1024); - syswrite(STDOUT, $buffer, $len); - } - } + my $bytes = $files->stream(IO::File->new('>&STDOUT'), $file); - return 0; + $bytes > 0; } sub _add { @@ -309,22 +301,25 @@ sub _add { croak "add - need a key and a file" unless defined($key) && defined($file) && -r $file; - my $store = $self->app->global_options->{store}; - my $container = $store->get($key); + my $store = $self->app->global_options->{store}; + + my $files; - unless ($container) { - $container = $store->add($key); + if ($store->index->exists($key)) { + $files = $store->index->files($key); + } + else { + $store->index->add({ _id => $key }) || croak "add - failed to add $key"; + $files = $store->index->files($key); } - croak "add - failed to find or create $key" unless $container; + croak "add - failed to find or create $key" unless $files; my ($name, $path, $suffix) = fileparse($file); - $container->add($name, IO::File->new("$path/$name")); - - $container->commit; + $files->upload(IO::File->new("<$path/$name"),$name); - return $self->_get($container->key); + return $self->_get($key); } sub _delete { @@ -333,14 +328,13 @@ sub _delete { croak "delete - need a key and a file" unless defined($key) && defined($name); - my $store = $self->app->global_options->{store}; - my $container = $store->get($key); + my $store = $self->app->global_options->{store}; - croak "delete - failed to find $key" unless $container; + croak "delete - failed to find $key" unless $store->index->exists($key); - $container->delete($name); + my $files = $store->index->files($key); - $container->commit; + $files->delete($name); return $self->_get($key); } @@ -348,14 +342,13 @@ sub _delete { sub _purge { my ($self, $key) = @_; - croak "delete - need a key" unless defined($key); + croak "purge - need a key" unless defined($key); - my $store = $self->app->global_options->{store}; - my $container = $store->get($key); + my $store = $self->app->global_options->{store}; - croak "delete - failed to find $key" unless $container; + croak "purge - failed to find $key" unless $store->index->exists($key); - $store->delete($key); + $store->index->delete($key); return 0; } @@ -390,11 +383,11 @@ sub _move { my $key_opt = $self->file_opt($key); my $key_store = $self->load($key_store, $key_opt); - my $gen = $key_store->list; - - while (my $key = $gen->()) { + $key_store->index->each(sub { + my $file = shift; + my $key = $file->{_id}; $self->_move_files($key_store, $target_store, $key); - } + }); } else { $self->_move_files($source_store, $target_store, $key); @@ -426,39 +419,51 @@ sub _move_files { printf STDERR "%s [%-3.3f] $key ", $curr_time->(), $self->_mb_sec(); - my $source_container = $source_store->get($key); - - unless ($source_container) { - print STDERR "ERROR\n"; + unless ($source_store->index->exists($key)) { + print STDERR "ERROR (no $key in source)\n"; return; } - my $target_container = $target_store->get($key); + my $source_files = $source_store->index->files($key); - unless ($target_container) { - $target_container = $target_store->add($key); - } + my $target_files; - unless ($target_container) { - print STDERR "ERROR\n"; - return; + if ($target_store->index->exists($key)) { + $target_files = $target_store->index->files($key); + } + else { + $target_store->index->add({ _id => $key }) + || croak "failed to add $key to target"; + $target_files = $target_store->index->files($key); } print "OK\n"; - my @source_files = $source_container->list; + $source_files->each(sub { + my $file = shift; + my $name = $file->{_id}; + my $size = $file->{size}; + + my $pipe = new IO::Pipe; + + if (my $pid = fork()) { # Parent + $pipe->reader(); + + $target_files->upload($pipe,$name) + || croak "failed to upload $name : $!"; - for my $file (@source_files) { - my $name = $file->key; - my $size = $file->size; - my $io = $file->fh; + waitpid($pid,0); + } + else { # Child + $pipe->writer(); + $source_files->stream($pipe,$file) + || croak "faied to stream $name : $!"; + exit(0); + } - printf STDERR "%s [%-3.3f] $key/$name ", $curr_time->(), + printf STDERR "%s [%-3.3f] $key/$name\n", $curr_time->(), $self->_mb_sec($size); - my $res = $target_container->add($name, $io); - $target_container->commit; - printf STDERR " %s\n", $res ? 'OK' : 'ERROR'; - } + }); } sub _export { @@ -469,38 +474,27 @@ sub _export { croak "export - need a key" unless defined($key); croak "export - need a zip file name" unless defined($zip_file); - my $store = $self->app->global_options->{store}; - my $container = $store->get($key); + $zip_file = File::Spec->rel2abs($zip_file); + + my $store = $self->app->global_options->{store}; + + croak "export - failed to find $key" unless $store->index->exists($key); - croak "export - failed to find $key" unless $container; + my $files = $store->index->files($key); - my $export_name = $container->key; - my $export_dir = sprintf "%s/%s", $workdir, $export_name; + my $export_dir = sprintf "%s/%s", $workdir, $key; unless (mkpath($export_dir)) { croak "export - failed to create $export_dir"; } - my @files = $container->list; - - local (*OUT); - - for my $file (@files) { - my $key = $file->key; - - my $obj = $container->get($key); - my $io = $obj->fh; + my $file_array = $files->to_array; - open(OUT, "> $export_dir/$key"); - binmode(OUT, ':raw'); + for my $file (@$file_array) { + my $key = $file->{_id}; - while (!$io->eof) { - my $buffer; - my $len = $io->read($buffer, 1024); - syswrite(OUT, $buffer, 1024); - } - - close(OUT); + $files->stream(IO::File->new("> $export_dir/$key"),$file) || + croak "failed to stream key to $export_dir/$key"; } my $zipper = $self->app->global_options->{zipper}; @@ -509,8 +503,7 @@ sub _export { croak "Failed to remove existing $zip_file"; } - $SIG{CHLD} = 'DEFAULT'; # required to avoid 'no child errors'; - system("cd $workdir && $zipper -r $zip_file $export_name/*"); + system("cd $workdir && $zipper -r $zip_file $key/*"); if ($? == -1) { croak "Failed to execute $zipper"; @@ -542,10 +535,6 @@ sub _import { croak "import - need a key" unless defined($key); croak "import - need a zip file name" unless defined($zip_file); - my $container = $store->get($key); - - croak "import - container $key already exists" if $container; - unless (mkpath($workdir)) { croak "export - failed to create $workdir"; } @@ -643,8 +632,8 @@ LibreCat::Cmd::file_store - manage librecat file stores options: --store=... - Store name - --file_store=... - LibreCat::FileStore class - --file_opt=... - LibreCat::FileStore option + --file_store=... - Catmandu::Store::File class + --file_opt=... - Catmandu::Store::File option --tmp_dir=... - Temporary directory --zip=... - Zip program --unzip=... - Unzip program diff --git a/lib/LibreCat/FileStore.pm b/lib/LibreCat/FileStore.pm deleted file mode 100644 index c3f6fb6f1..000000000 --- a/lib/LibreCat/FileStore.pm +++ /dev/null @@ -1,87 +0,0 @@ -package LibreCat::FileStore; - -use Catmandu::Sane; -use Moo::Role; -use Carp; -use namespace::clean; - -with 'Catmandu::Logger'; - -requires 'list'; -requires 'exists'; -requires 'add'; -requires 'get'; -requires 'delete'; - -1; - -__END__ - -=pod - -=head1 NAME - -LibreCat::FileStore - Abstract definition of a file storage implementation - -=head1 SYNOPSIS - - use LibreCat::FileStore::XYZ; - - my $filestore => LibreCat::FileStore::XYZ->new(%options); - - my $generator = $filestore->list; - - while (my $key = $generator->()) { - my $container = $filestore->get($key); - - for my $file ($container->list) { - my $filename = $file->key; - my $size = $file->size; - my $checksum = $file->md5; - my $created = $file->created; - my $modified = $file->modified; - my $io = $file->data; - } - } - - my $container = $filestore->get('1234'); - - if ($filestore->exists('1234')) { - ... - } - - my $container = $filestore->add('1235'); - - $filestore->delete('1234'); - -=head1 DESCRIPTION - -LibreCat::FileStore is an abstract definition of a file storage. File content is -stored in a container given by an identifier. Each container can contain zero -or more files. - -=head1 METHODS - -=head2 new(%options) - -Create a new LibreCat::FileStore. - -=head2 list() - -Provide a listing of all available container keys. Returns an iterator with keys. - -=head2 get($key) - -Return a LibreCat::FileStore::Container given a $key. - -=head2 add($key) - -Creates a new container and returns a LibreCat::FileStore::Container. - -=head2 delete($key) - -Removed a container from the system. - -=head1 SEE ALSO - -L , L diff --git a/lib/LibreCat/FileStore/BagIt.pm b/lib/LibreCat/FileStore/BagIt.pm deleted file mode 100644 index 6d39d40b0..000000000 --- a/lib/LibreCat/FileStore/BagIt.pm +++ /dev/null @@ -1,200 +0,0 @@ -package LibreCat::FileStore::BagIt; - -use Catmandu::Sane; -use Moo; -use Carp; -use LibreCat::FileStore::Container::BagIt; -use Data::UUID; -use POSIX qw(ceil); -use namespace::clean; - -with 'LibreCat::FileStore'; - -has root => (is => 'ro', required => '1'); -has uuid => (is => 'ro', trigger => 1); -has keysize => (is => 'ro', default => 9, trigger => 1); - -sub _trigger_keysize { - my $self = shift; - - croak "keysize needs to be a multiple of 3" - unless $self->keysize % 3 == 0; -} - -sub _trigger_uuid { - my $self = shift; - - $self->{keysize} = 36; -} - -sub list { - my ($self, $callback) = @_; - - my $root = $self->root; - my $keysize = $self->keysize; - - my $mindepth = ceil($keysize / 3); - my $maxdepth = $mindepth + 1; - - $self->log->debug("creating generator for root: $root"); - return sub { - state $io; - - unless (defined($io)) { - open($io, - "find -L $root -mindepth $mindepth -maxdepth $maxdepth -type d |" - ); - } - - my $line = <$io>; - - unless (defined($line)) { - close($io); - return undef; - } - - chop($line); - $line =~ s/\/data$//; - $line =~ s/$root//; - $line =~ s/\///g; - - $line; - }; -} - -sub exists { - my ($self, $key) = @_; - - croak "Need a key" unless defined $key; - - $self->log->debug("Checking exists $key"); - - my $path = $self->path_string($key); - - -d $path; -} - -sub add { - my ($self, $key) = @_; - - croak "Need a key" unless defined $key; - - my $path = $self->path_string($key); - - unless ($path) { - $self->log->error("Failed to create path from $key"); - return undef; - } - - $self->log->debug("Generating path $path for key $key"); - - LibreCat::FileStore::Container::BagIt->create_container($path, $key); -} - -sub get { - my ($self, $key) = @_; - - croak "Need a key" unless defined $key; - - my $path = $self->path_string($key); - - unless ($path) { - $self->log->error("Failed to create path from $key"); - return undef; - } - - $self->log->debug("Loading path $path for key $key"); - - LibreCat::FileStore::Container::BagIt->read_container($path); -} - -sub delete { - my ($self, $key) = @_; - - croak "Need a key" unless defined $key; - - my $path = $self->path_string($key); - - unless ($path) { - $self->log->error("Failed to create path from $key"); - return undef; - } - - $self->log->debug("Destoying path $path for key $key"); - - LibreCat::FileStore::Container::BagIt->delete_container($path); -} - -sub path_string { - my ($self, $key) = @_; - - my $keysize = $self->keysize; - - # Allow all hexidecimal numbers - $key =~ s{[^A-F0-9-]}{}g; - - # If the key is a UUID then the matches need to be exact - if ($self->uuid) { - try { - Data::UUID->new->from_string($key); - } - catch { - return undef; - }; - } - else { - return undef unless length($key) && length($key) <= $keysize; - $key =~ s/^0+//; - $key = sprintf "%-${keysize}.${keysize}d", $key; - } - - my $path = $self->root . "/" . join("/", unpack('(A3)*', $key)); - - $path; -} - -1; - -__END__ - - -=pod - -=head1 NAME - -LibreCat::FileStore::BagIt - A BagIt implementation of a file storage - -=head1 SYNOPSIS - - use LibreCat::FileStore::BagIt; - - my $filestore =>LibreCat::FileStore::BagIt->new(root => '/data2/librecat/bag_uploads'); - - my $generator = $filestore->list; - - while (my $key = $generator->()) { - my $container = $filestore->get($key); - - for my $file ($container->list) { - my $filename = $file->key; - my $size = $file->size; - my $checksum = $file->md5; - my $created = $file->created; - my $modified = $file->modified; - my $io = $file->data; - } - } - - my $container = $filestore->get('1234'); - - if ($filestore->exists('1234')) { - ... - } - - my $container = $filestore->add('1235'); - - $filestore->delete('1234'); - -=head1 SEE ALSO - -L diff --git a/lib/LibreCat/FileStore/Container.pm b/lib/LibreCat/FileStore/Container.pm deleted file mode 100644 index 5e2bbe54f..000000000 --- a/lib/LibreCat/FileStore/Container.pm +++ /dev/null @@ -1,86 +0,0 @@ -package LibreCat::FileStore::Container; - -use Catmandu::Sane; -use Moo::Role; -use namespace::clean; - -with 'Catmandu::Logger'; - -has key => (is => 'ro', required => 1); -has created => (is => 'ro'); -has modified => (is => 'ro'); - -requires 'list'; -requires 'exists'; -requires 'add'; -requires 'get'; -requires 'delete'; -requires 'commit'; - -1; - -__END__ - -=pod - -=head1 NAME - -LibreCat::FileStore::Container - Abstract definition of a file storage container - -=head1 SYNOPSIS - - use LibreCat::FileStore::Simple; - - my $filestore => LibreCat::FileStore::Simple->new(%options); - - my $container = $filestore->get('1234'); - - my @list_files = $container->list; - - if ($container->exists($filename)) { - .... - } - - $container->add($filename, IO::File->new('/path/to/file')); - - my $file = $container->get($filename); - - $container->delete($filename); - - # write all changes to disk (network , database , ...) - $container->commit; - -=head1 DESCRIPTION - -LibreCat::FileStore::Container is an abstract definition of a storage container. -These container are used to store zero or more LibreCat::FileStore::Files. - -=head1 METHODS - -=head2 get($key) - -Retrieve a LibreCat::FileStore::File based on a $key. Returns a LibreCat::FileStore::File on -success or undef on failure. - -=head2 add($filename, IO::File->new(...)) - -Add a new LibreCat::FileStore::File file to the container. Return 1 on success or undef on failure. - -Based on the implementation of LibreCat::FileStore, the files might only be available when changes -have been committed. - -=head2 commit() - -Commit all changes to the container (write to disk). - -=head2 delete($filename) - -Delete a $filename from the container. - -=head2 exists($filename) - -Check if a $filename exists in the container. - -=head1 SEE ALSO - -L , L diff --git a/lib/LibreCat/FileStore/Container/BagIt.pm b/lib/LibreCat/FileStore/Container/BagIt.pm deleted file mode 100644 index b05e06f88..000000000 --- a/lib/LibreCat/FileStore/Container/BagIt.pm +++ /dev/null @@ -1,197 +0,0 @@ -package LibreCat::FileStore::Container::BagIt; - -use Catmandu::Sane; -use Moo; -use Carp; -use File::Path; -use Catmandu::BagIt; -use URI::Escape; -use LibreCat::MimeType; -use LibreCat::FileStore::File::BagIt; -use namespace::clean; - -with 'LibreCat::FileStore::Container'; - -has _bagit => (is => 'ro'); -has _mimeType => (is => 'lazy'); - -sub _build__mimeType { - LibreCat::MimeType->new; -} - -sub list { - my ($self) = @_; - my $bagit = $self->_bagit; - my $path = $bagit->path; - - my @result = (); - - for my $file ($bagit->list_files) { - my $unpacked_key = $self->unpack_key($file->filename); - push @result, $self->get($unpacked_key); - } - - return @result; -} - -sub exists { - my ($self, $key) = @_; - my $bagit = $self->_bagit; - - defined $bagit->get_file($key); -} - -sub get { - my ($self, $key) = @_; - - my $bagit = $self->_bagit; - - my $packed_key = $self->pack_key($key); - - my $file = $bagit->get_file($packed_key); - - return undef unless $file; - - my $data = $file->open(); - my $md5 = $bagit->get_checksum($key); - my $stat = [$data->stat()]; - - my $size = $stat->[7]; - my $modified = $stat->[9]; - my $created = $stat->[10]; # no real creation time exists on Unix - my $content_type = $self->_mimeType->content_type($key); - - LibreCat::FileStore::File::BagIt->new( - key => $key, - size => $size, - md5 => $md5, - content_type => $content_type, - created => $created, - modified => $modified, - data => $data - ); -} - -sub add { - my ($self, $key, $data) = @_; - my $bagit = $self->_bagit; - - my $packed_key = $self->pack_key($key); - - $bagit->add_file($packed_key, $data); -} - -sub delete { - my ($self, $key) = @_; - my $bagit = $self->_bagit; - - my $packed_key = $self->pack_key($key); - - $bagit->remove_file($packed_key); -} - -sub commit { - my ($self) = @_; - my $bagit = $self->_bagit; - my $path = $bagit->path; - - $bagit->write($path, overwrite => 1); - - $self->{_bagit} = Catmandu::BagIt->read($path); -} - -sub read_container { - my ($class, $path) = @_; - croak "Need a path" unless $path; - - my $bagit = Catmandu::BagIt->read($path); - - return undef unless $bagit; - - my $key = $bagit->get_info('Archive-Id'); - - return undef unless $key; - - my $inst = $class->new(key => $key); - - $inst->{created} = $bagit->get_info('Unix-Creation-Time'); - $inst->{modified} = $bagit->get_info('Unix-Modification-Time'); - $inst->{_bagit} = $bagit; - - $inst; -} - -sub create_container { - my ($class, $path, $key) = @_; - - croak "Need a path and a key" unless $path && $key; - - my $bagit = Catmandu::BagIt->new(); - - $bagit->add_info('Archive-Id' => $key); - $bagit->add_info('Unix-Creation-Time' => time); - $bagit->add_info('Unix-Modification-Time' => time); - - $bagit->write($path, overwrite => 1); - - $class->read_container($path); -} - -sub delete_container { - my ($class, $path) = @_; - - croak "Need a path" unless $path; - - return undef unless -d $path; - - File::Path::remove_tree($path); -} - -sub pack_key { - my $self = shift; - my $key = shift; - uri_escape($key); -} - -sub unpack_key { - my $self = shift; - my $key = shift; - uri_unescape($key); -} - -1; - -__END__; - -=pod - -=head1 NAME - -LibreCat::FileStore::Container::BagIt - A BagIt implementation of a file storage container - -=head1 SYNOPSIS - - use LibreCat::FileStore::BagIt; - - my $filestore => LibreCat::FileStore::BagIt->new(%options); - - my $container = $filestore->get('1234'); - - my @list_files = $container->list; - - if ($container->exists($filename)) { - .... - } - - $container->add($filename, IO::File->new('/path/to/file')); - - my $file = $container->get($filename); - - $container->delete($filename); - - # write all changes to disk (network , database , ...) - $container->commit; - -=head1 SEE ALSO - -L diff --git a/lib/LibreCat/FileStore/Container/FedoraCommons.pm b/lib/LibreCat/FileStore/Container/FedoraCommons.pm deleted file mode 100644 index 846e0915e..000000000 --- a/lib/LibreCat/FileStore/Container/FedoraCommons.pm +++ /dev/null @@ -1,556 +0,0 @@ -package LibreCat::FileStore::Container::FedoraCommons; - -use Catmandu::Sane; -use Moo; -use Carp; -use File::Temp; -use File::Copy; -use Date::Parse; -use Digest::MD5; -use LibreCat::MimeType; -use Catmandu::Util; -use Catmandu::Store::FedoraCommons::FOXML; -use LibreCat::FileStore::File::FedoraCommons; -use namespace::clean; - -with 'LibreCat::FileStore::Container'; - -has _fedora => (is => 'ro'); -has _mimeType => (is => 'lazy'); - -sub _build__mimeType { - LibreCat::MimeType->new; -} - -sub list { - my ($self) = @_; - my $fedora = $self->_fedora; - my $ns_prefix = $fedora->{namespace}; - my $pid = "$ns_prefix:" . $self->key; - my $dsnamespace = $fedora->{dsnamespace}; - - $self->log->debug("Listing datastreams for $pid"); - - my $response = $fedora->listDatastreams(pid => $pid); - - unless ($response->is_ok) { - $self->log->error("Failed to list datastreams for $pid"); - $self->log->error($response->error); - return (); - } - - my $obj = $response->parse_content; - - my @result = (); - - for my $ds (@{$obj->{datastream}}) { - my $dsid = $ds->{dsid}; - unless ($dsid =~ /^$dsnamespace\./) { - $self->log->debug("skipping $dsid (not in $dsnamespace)"); - next; - } - - $self->log->debug("adding $dsid"); - my $file = $self->_get($dsid); - push @result, $self->_get($dsid) if $file; - } - - return @result; -} - -sub _list_dsid { - my ($self) = @_; - my $fedora = $self->_fedora; - my $ns_prefix = $fedora->{namespace}; - my $pid = "$ns_prefix:" . $self->key; - my $dsnamespace = $fedora->{dsnamespace}; - - $self->log->debug("Listing datastreams for $pid"); - - my $response = $fedora->listDatastreams(pid => $pid); - - unless ($response->is_ok) { - $self->log->error("Failed to list datastreams for $pid"); - $self->log->error($response->error); - return (); - } - - my $obj = $response->parse_content; - - my @result = (); - - for my $ds (@{$obj->{datastream}}) { - my $dsid = $ds->{dsid}; - my $label = $ds->{label}; - - unless ($dsid =~ /^$dsnamespace\./) { - $self->log->debug("skipping $dsid (not in $dsnamespace)"); - next; - } - - $self->log->debug("adding $dsid"); - my $cnt = $dsid; - $cnt =~ s/^$dsnamespace\.//; - push @result, {n => $cnt, dsid => $dsid, label => $label}; - } - - return sort {$a->{n} <=> $b->{n}} @result; -} - -sub _dsid_by_label { - my ($self, $key) = @_; - my $fedora = $self->_fedora; - my $ns_prefix = $fedora->{namespace}; - my $pid = "$ns_prefix:" . $self->key; - - $self->log->debug("Listing datastreams for $pid"); - my $response = $fedora->listDatastreams(pid => $pid); - - unless ($response->is_ok) { - $self->log->error("Failed to list datastreams for $pid"); - $self->log->error($response->error); - return (); - } - - my $obj = $response->parse_content; - - for my $ds (@{$obj->{datastream}}) { - my $dsid = $ds->{dsid}; - my $label = $ds->{label}; - return $dsid if $label eq $key; - } - - return undef; -} - -sub exists { - my ($self, $key) = @_; - defined($self->_dsid_by_label($key)) ? 1 : undef; -} - -sub get { - my ($self, $key) = @_; - - my $dsid = $self->_dsid_by_label($key); - - return undef unless $dsid; - - return $self->_get($dsid); -} - -sub _get { - my ($self, $dsid) = @_; - my $fedora = $self->_fedora; - my $ns_prefix = $fedora->{namespace}; - my $pid = "$ns_prefix:" . $self->key; - - $self->log->debug("Get datastream history for $pid:$dsid"); - my $response = $fedora->getDatastreamHistory(pid => $pid, dsID => $dsid); - - unless ($response->is_ok) { - $self->log->error("Failed to get datastream history for $pid:$dsid"); - $self->log->error($response->error); - return undef; - } - - my $object = $response->parse_content; - - my $first = $object->{profile}->[0]; - my $last = $object->{profile}->[-1]; - - return undef unless $first->{dsState} eq 'A'; - - my $key = $first->{dsLabel}; - my $size = $first->{dsSize}; - my $md5 = $first->{dsChecksum}; - my $content_type = $first->{dsMIME}; - my $created = str2time($last->{dsCreateDate}); - my $modified = str2time($first->{dsCreateDate}); - - my $data = sub { - my $io = shift; - my $res = $fedora->getDatastreamDissemination( - pid => $pid, - dsID => $dsid, - callback => sub { - my ($data, $response, $protocol) = @_; - - # Support the Dancer send_file "write" callback - if ($io->can('syswrite')) { - $io->syswrite($data); - } - else { - $io->write($data); - } - } - ); - $io->close; - }; - - LibreCat::FileStore::File::FedoraCommons->new( - key => $key, - size => $size, - md5 => $md5 eq 'none' ? '' : $md5, - created => $created, - modified => $modified, - content_type => $content_type, - data => $data - ); -} - -sub add { - my ($self, $key, $data) = @_; - my $filename = $self->_io_filename($data); - - if ($filename) { - return $self->_add_filename($key, $data, $filename); - } - else { - return $self->_add_stream($key, $data); - } -} - -sub _add_filename { - my ($self, $key, $data, $filename) = @_; - my $fedora = $self->_fedora; - my $ns_prefix = $fedora->{namespace}; - my $pid = "$ns_prefix:" . $self->key; - my $dsnamespace = $fedora->{dsnamespace}; - my $versionable = $fedora->{versionable} ? 'true' : 'false'; - - my %options = ('versionable' => $versionable); - - if ($fedora->{md5enabled}) { - my $ctx = Digest::MD5->new; - my $checksum = $ctx->addfile($data)->hexdigest; - $options{checksum} = $checksum; - $options{checksumType} = 'MD5'; - } - - my $mimeType = $self->_mimeType->content_type($key); - - my ($operation, $dsid) = $self->_next_dsid($key); - - my $response; - - if ($operation eq 'ADD') { - $self->log->debug( - "Add datastream $pid:$dsid $filename $key $mimeType"); - $response = $fedora->addDatastream( - pid => $pid, - dsID => $dsid, - file => $filename, - dsLabel => $key, - mimeType => $mimeType, - %options - ); - } - else { - $self->log->debug( - "Modify datastream $pid:$dsid $filename $key $mimeType"); - $response = $fedora->modifyDatastream( - pid => $pid, - dsID => $dsid, - file => $filename, - dsLabel => $key, - mimeType => $mimeType, - %options - ); - } - - unless ($response->is_ok) { - $self->log->error( - "Failed to add/modify datastream history for $pid:$dsid"); - $self->log->error($response->error); - return undef; - } - - 1; -} - -sub _add_stream { - my ($self, $key, $io) = @_; - my $fedora = $self->_fedora; - my $ns_prefix = $fedora->{namespace}; - my $pid = "$ns_prefix:" . $self->key; - my $dsnamespace = $fedora->{dsnamespace}; - my $versionable = $fedora->{versionable} ? 'true' : 'false'; - - my ($fh, $filename) - = File::Temp::tempfile( - "librecat-filestore-container-fedoracommons-XXXX", - UNLINK => 1); - - if (Catmandu::Util::is_invocant($io)) { - - # We got a IO::Handle - File::Copy::cp($io, $filename); - $io->close; - } - else { - # We got a string - Catmandu::Util::write_file($filename, $io); - } - - $fh->close; - - my %options = ('versionable' => $versionable); - - if ($fedora->{md5enabled}) { - my $ctx = Digest::MD5->new; - my $data = IO::File->new($filename); - my $checksum = $ctx->addfile($data)->hexdigest; - $options{checksum} = $checksum; - $options{checksumType} = 'MD5'; - $data->close(); - } - - my $mimeType = $self->_mimeType->content_type($key); - - my ($operation, $dsid) = $self->_next_dsid($key); - - my $response; - - if ($operation eq 'ADD') { - $self->log->debug( - "Add datastream $pid:$dsid $filename $key $mimeType"); - $response = $fedora->addDatastream( - pid => $pid, - dsID => $dsid, - file => $filename, - dsLabel => $key, - mimeType => $mimeType, - %options - ); - } - else { - $self->log->debug( - "Modify datastream $pid:$dsid $filename $key $mimeType"); - $response = $fedora->modifyDatastream( - pid => $pid, - dsID => $dsid, - file => $filename, - dsLabel => $key, - mimeType => $mimeType, - %options - ); - } - - unlink $filename; - - unless ($response->is_ok) { - $self->log->error( - "Failed to add/modify datastream history for $pid:$dsid"); - $self->log->error($response->error); - return undef; - } - - 1; -} - -sub _next_dsid { - my ($self, $key) = @_; - my $fedora = $self->_fedora; - my $dsnamespace = $fedora->{dsnamespace}; - - my $cnt = -1; - - for ($self->_list_dsid) { - if ($key eq $_->{label}) { - return ('MODIFIY', $_->{dsid}); - } - $cnt = $_->{n}; - } - - return ('ADD', "$dsnamespace." . ($cnt + 1)); -} - -sub _io_filename { - my ($self, $data) = @_; - - return undef unless Catmandu::Util::is_invocant($data); - - my $inode = [$data->stat]->[1]; - my $ls = `ls -i | grep $inode`; - if ($ls =~ /^\d+\s+(\S.*)/) { - return $1; - } - else { - return undef; - } -} - -sub delete { - my ($self, $key) = @_; - my $fedora = $self->_fedora; - my $ns_prefix = $fedora->{namespace}; - my $pid = "$ns_prefix:" . $self->key; - - my $dsid = $self->_dsid_by_label($key); - - return undef unless $dsid; - - my $response; - - if ($fedora->{purge}) { - $self->log->debug("Purge datastream $pid:$dsid"); - $response = $fedora->purgeDatastream(pid => $pid, dsID => $dsid); - } - else { - $self->log->debug("Set datastream state D $pid:$dsid"); - $response = $fedora->setDatastreamState( - pid => $pid, - dsID => $dsid, - dsState => 'D' - ); - } - - unless ($response->is_ok) { - $self->log->error("Failed to purge/set datastream for $pid:$dsid"); - $self->log->error($response->error); - return undef; - } - - 1; -} - -sub commit { - my ($self) = @_; -} - -sub read_container { - my ($class, $fedora, $key) = @_; - croak "Need a fedora connection" - unless $fedora && ref($fedora) eq 'Catmandu::FedoraCommons'; - croak "Need a key" unless $key; - - my $ns_prefix = $fedora->{namespace}; - - my $inst = $class->new(key => $key); - - $inst->log->debug("Get object profile $ns_prefix:$key"); - my $response = $fedora->getObjectProfile(pid => "$ns_prefix:$key"); - - unless ($response->is_ok) { - $inst->log->error("Failed get object profile $ns_prefix:$key"); - $inst->log->error($response->error); - return undef; - } - - my $object = $response->parse_content; - - $inst->{created} = str2time($object->{objCreateDate}); - $inst->{modified} = str2time($object->{objLastModDate}); - $inst->{_fedora} = $fedora; - - $inst; -} - -sub create_container { - my ($class, $fedora, $key) = @_; - croak "Need a fedora connection" - unless $fedora && ref($fedora) eq 'Catmandu::FedoraCommons'; - croak "Need a pid" unless $key; - - my $ns_prefix = $fedora->{namespace}; - - my $xml = Catmandu::Store::FedoraCommons::FOXML->new->serialize(); - - my $inst = $class->new(key => $key); - - $inst->log->debug("Ingest object $ns_prefix:$key"); - - my $response = $fedora->ingest( - pid => "$ns_prefix:$key", - xml => $xml, - format => 'info:fedora/fedora-system:FOXML-1.1' - ); - - unless ($response->is_ok) { - $inst->log->error("Failed ingest object $ns_prefix:$key"); - $inst->log->error($response->error); - return undef; - } - - my $obj = $response->parse_content; - - $class->read_container($fedora, $key); -} - -sub delete_container { - my ($class, $fedora, $key) = @_; - croak "Need a fedora connection" - unless $fedora && ref($fedora) eq 'Catmandu::FedoraCommons'; - croak "Need a key" unless $key; - - my $ns_prefix = $fedora->{namespace}; - - my $inst = $class->new(key => $key); - - my $response; - - if ($fedora->{purge}) { - $class->log->debug("Purge object $ns_prefix:$key"); - $response = $fedora->purgeObject(pid => "$ns_prefix:$key"); - } - else { - $class->log->debug("Modify object state D $ns_prefix:$key"); - $response - = $fedora->modifyObject(pid => "$ns_prefix:$key", state => 'D'); - } - - unless ($response->is_ok) { - $inst->log->error("Failed purge/modify object $ns_prefix:$key"); - $inst->log->error($response->error); - return undef; - } - - 1; -} - -1; - -__END__; - -=pod - -=head1 NAME - -LibreCat::FileStore::Container::FedoraCommons - A FedoraCommons implementation of a file storage container - -=head1 SYNOPSIS - - use LibreCat::FileStore::FedoraCommons; - - my %options = ( - url => '...', - user => '...', - password => '...' , - namespace => 'demo' , - dsnamespace => 'DS' , - md5enabled => 1 , - versionable => 0 , - ); - - my $filestore => LibreCat::FileStore::FedoraCommons->new(%options); - - my $container = $filestore->get('demo:1234'); - - my @list_files = $container->list; - - if ($container->exists($filename)) { - .... - } - - $container->add($filename, IO::File->new('/path/to/file')); - - my $file = $container->get($filename); - - $container->delete($filename); - - # write all changes to disk (network , database , ...) - $container->commit; - -=head1 SEE ALSO - -L diff --git a/lib/LibreCat/FileStore/Container/Simple.pm b/lib/LibreCat/FileStore/Container/Simple.pm deleted file mode 100644 index de93236f6..000000000 --- a/lib/LibreCat/FileStore/Container/Simple.pm +++ /dev/null @@ -1,193 +0,0 @@ -package LibreCat::FileStore::Container::Simple; - -use Catmandu::Sane; -use Moo; -use Carp; -use IO::File; -use File::Path; -use File::Copy; -use LibreCat::FileStore::File::Simple; -use Catmandu::Util; -use URI::Escape; -use LibreCat::MimeType; -use namespace::clean; -use utf8; - -with 'LibreCat::FileStore::Container'; - -has _path => (is => 'ro'); -has _mimeType => (is => 'lazy'); - -sub _build__mimeType { - LibreCat::MimeType->new; -} - -sub list { - my ($self) = @_; - my $path = $self->_path; - - my @result = (); - - for my $file (glob("$path/*")) { - $file =~ s/^.*\///; - next if index($file, ".") == 0; - - my $unpacked_key = $self->unpack_key($file); - - push @result, $self->get($unpacked_key); - } - - return @result; -} - -sub exists { - my ($self, $key) = @_; - my $path = $self->_path; - - -f "$path/$key"; -} - -sub get { - my ($self, $key) = @_; - my $path = $self->_path; - - my $packed_key = $self->pack_key($key); - - my $file = "$path/$packed_key"; - - return undef unless -f $file; - - my $data = IO::File->new($file, "r"); - my $stat = [$data->stat]; - - my $size = $stat->[7]; - my $modified = $stat->[9]; - my $created = $stat->[10]; # no real creation time exists on Unix - - my $content_type = $self->_mimeType->content_type($key); - - LibreCat::FileStore::File::Simple->new( - key => $key, - size => $size, - md5 => '', - content_type => $content_type, - created => $created, - modified => $modified, - data => $data - ); -} - -sub add { - my ($self, $key, $data) = @_; - my $path = $self->_path; - - my $packed_key = $self->pack_key($key); - - if (Catmandu::Util::is_invocant($data)) { - return copy($data, "$path/$packed_key"); - } - else { - return Catmandu::Util::write_file("$path/$packed_key", $data); - } -} - -sub delete { - my ($self, $key) = @_; - my $path = $self->_path; - - my $packed_key = $self->pack_key($key); - - return undef unless -f "$path/$packed_key"; - unlink "$path/$packed_key"; -} - -sub commit { - return 1; -} - -sub read_container { - my ($class, $path, $key) = @_; - croak "Need a path and a key" unless $path && $key; - - return undef unless -d $path; - - my @stat = stat $path; - - my $inst = $class->new(key => $key); - $inst->{created} = $stat[10]; - $inst->{modified} = $stat[9]; - $inst->{_path} = $path; - $inst; -} - -sub create_container { - my ($class, $path, $key) = @_; - - croak "Need a path and a key" unless $path && $key; - - File::Path::make_path($path); - - $class->read_container($path, $key); -} - -sub delete_container { - my ($class, $path) = @_; - - croak "Need a path" unless $path; - - return undef unless -d $path; - - File::Path::remove_tree($path); -} - -sub pack_key { - my $self = shift; - my $key = shift; - utf8::encode($key); - uri_escape($key); -} - -sub unpack_key { - my $self = shift; - my $key = shift; - my $str = uri_unescape($key); - utf8::decode($str); - $str; -} - -1; - -__END__; - -=pod - -=head1 NAME - -LibreCat::FileStore::Container::Simple - A default implementation of a file storage container - -=head1 SYNOPSIS - - use LibreCat::FileStore::Simple; - - my $filestore = LibreCat::FileStore::Simple->new(%options); - - my $container = $filestore->get('1234'); - - my @list_files = $container->list; - - if ($container->exists($filename)) { - .... - } - - $container->add($filename, IO::File->new('/path/to/file')); - - my $file = $container->get($filename); - - $container->delete($filename); - - # write all changes to disk (network , database , ...) - $container->commit; - -=head1 SEE ALSO - -L diff --git a/lib/LibreCat/FileStore/FedoraCommons.pm b/lib/LibreCat/FileStore/FedoraCommons.pm deleted file mode 100644 index dad2cf660..000000000 --- a/lib/LibreCat/FileStore/FedoraCommons.pm +++ /dev/null @@ -1,213 +0,0 @@ -package LibreCat::FileStore::FedoraCommons; - -use Catmandu::Sane; -use Moo; -use Carp; -use Catmandu::FedoraCommons; -use LibreCat::FileStore::Container::FedoraCommons; -use Data::UUID; -use namespace::clean; - -with 'LibreCat::FileStore'; - -has url => (is => 'ro', default => sub {'http://localhost:8080/fedora'}); -has user => (is => 'ro', default => sub {'fedoraAdmin'}); -has password => (is => 'ro', default => sub {'fedoraAdmin'}); -has namespace => (is => 'ro', default => sub {'demo'}); -has dsnamespace => (is => 'ro', default => sub {'DS'}); -has md5enabled => (is => 'ro', default => sub {'1'}); -has versionable => (is => 'ro', default => sub {'0'}); -has purge => (is => 'ro', default => sub {'0'}); -has fedora => (is => 'lazy'); - -sub _build_fedora { - my ($self) = @_; - my $fedora = Catmandu::FedoraCommons->new($self->url, $self->user, - $self->password); - $fedora->{namespace} = $self->namespace; - $fedora->{dsnamespace} = $self->dsnamespace; - $fedora->{md5enabled} = $self->md5enabled; - $fedora->{versionable} = $self->versionable; - $fedora->{purge} = $self->purge; - $fedora; -} - -sub list { - my ($self, $callback) = @_; - my $fedora = $self->fedora; - - $self->log->debug("creating generator for Fedora @ " . $self->url); - - return sub { - state $hits; - state $row; - state $ns_prefix = $self->namespace; - - if (!defined $hits) { - my $res - = $fedora->findObjects(query => "pid~${ns_prefix}* state=A"); - unless ($res->is_ok) { - $self->log->error($res->error); - return undef; - } - $row = 0; - $hits = $res->parse_content; - } - if ($row + 1 == @{$hits->{results}} && defined $hits->{token}) { - my $result = $hits->{results}->[$row]; - - my $res = $fedora->findObjects(sessionToken => $hits->{token}); - - unless ($res->is_ok) { - warn $res->error; - return undef; - } - - $row = 0; - $hits = $res->parse_content; - - my $pid = $result->{pid}; - $pid =~ s{^$ns_prefix:}{} if $pid; - - return $pid; - } - else { - my $result = $hits->{results}->[$row++]; - - my $pid = $result->{pid}; - $pid =~ s{^$ns_prefix:}{} if $pid; - - return $pid; - } - }; -} - -sub exists { - my ($self, $key) = @_; - my $ns_prefix = $self->namespace; - - croak "Need a key" unless defined $key; - - $self->log->debug("Checking exists $key"); - - my $long_key = $self->_long_key($key); - - my $obj = $self->fedora->getObjectProfile(pid => "$ns_prefix:$long_key"); - - $obj->is_ok; -} - -sub add { - my ($self, $key) = @_; - - croak "Need a key" unless defined $key; - - if ($key =~ /^new$/i) { - $self->log->debug("Generating new key..."); - $key = $self->_generate_key; - $self->log->debug("key = $key"); - } - - $self->log->debug("Generating path container for key $key"); - - my $long_key = $self->_long_key($key); - - LibreCat::FileStore::Container::FedoraCommons->create_container( - $self->fedora, $long_key); -} - -sub get { - my ($self, $key) = @_; - - croak "Need a key" unless defined $key; - - $self->log->debug("Loading container for $key"); - - my $long_key = $self->_long_key($key); - - LibreCat::FileStore::Container::FedoraCommons->read_container( - $self->fedora, $long_key); -} - -sub delete { - my ($self, $key) = @_; - - croak "Need a key" unless defined $key; - - my $long_key = $self->_long_key($key); - - LibreCat::FileStore::Container::FedoraCommons->delete_container( - $self->fedora, $long_key); -} - -sub _generate_key { - my $ug = Data::UUID->new; - my $uuid = $ug->create(); - return $ug->to_string($uuid); -} - -sub _long_key { - my ($selk, $key) = @_; - if ($key =~ /^\d+$/) { - return sprintf "%-9.9d", $key; - } - else { - return $key; - } -} -1; - -__END__ - - -=pod - -=head1 NAME - -LibreCat::FileStore::FedoraCommons - A FedoraCommons 3.X implementation of a file storage - -=head1 SYNOPSIS - - use LibreCat::FileStore::FedoraCommons; - - my %options = ( - url => '...', - user => '...', - password => '...' , - namespace => 'demo' , - dsnamespace => 'DS' , - md5enabled => 1 , - versionable => 0 , - purge => 1 , - ); - - my $filestore =>LibreCat::FileStore::FedoraCommons->new(%options); - - my $generator = $filestore->list; - - while (my $key = $generator->()) { - my $container = $filestore->get($key); - - for my $file ($container->list) { - my $filename = $file->key; - my $size = $file->size; - my $checksum = $file->md5; - my $created = $file->created; - my $modified = $file->modified; - my $io = $file->data; - } - } - - my $container = $filestore->get('1234'); - - if ($filestore->exists('1234')) { - ... - } - - my $container = $filestore->add('1235'); - - $filestore->delete('1234'); - -=head1 SEE ALSO - -L diff --git a/lib/LibreCat/FileStore/File.pm b/lib/LibreCat/FileStore/File.pm deleted file mode 100644 index 3727ee215..000000000 --- a/lib/LibreCat/FileStore/File.pm +++ /dev/null @@ -1,126 +0,0 @@ -package LibreCat::FileStore::File; - -use Catmandu::Sane; -use Moo::Role; -use IO::String; -use IO::Pipe; -use namespace::clean; - -$SIG{CHLD} = 'IGNORE'; - -has key => (is => 'ro', required => 1); -has content_type => (is => 'ro'); -has size => (is => 'ro'); -has md5 => (is => 'ro'); -has created => (is => 'ro'); -has modified => (is => 'ro'); -has data => (is => 'ro'); - -sub fh { - my $self = shift; - - if (ref($self->data) =~ /^IO/) { - $self->data; - } - elsif ($self->is_callback) { - $self->io_from_callback($self->data); - } - elsif ($self->is_url) { - $self->io_from_url($self->data); - } - else { - IO::String->new($self->data); - } -} - -sub is_url { - my $self = shift; - $self->data =~ /^http/i; -} - -sub is_callback { - my $self = shift; - ref($self->data) eq 'CODE'; -} - -sub io_from_url { - my $self = shift; - my $url = shift; - - IO::Pipe->reader("curl -s \"$url\""); -} - -sub io_from_callback { - my $self = shift; - my $callback = shift; - - my $pid; - my $pipe = new IO::Pipe; - - if ($pid = fork()) { # parent - $pipe->reader(); - return $pipe; - } - elsif (defined($pid)) { # child - $pipe->writer; - $callback->($pipe); - $pipe->close; - exit; - } -} - -1; - -__END__ - -=pod - -=head1 NAME - -LibreCat::FileStore::File - Abstract definition of a stored file - -=head1 SYNOPSIS - - use LibreCat::FileStore::Simple; - - my $filestore => LibreCat::FileStore::Simple->new(%options); - - my $file = $filestore->get('1234')->get('myfile.txt'); - - my $filename = $file->key; - my $content_type = $file->content_type; - my $size = $file->size; - my $created = $file->created; - my $modified = $file->modified; - - my $fh = $file->fh; - -=head1 METHODS - -=head2 key() - -Return the filename. - -=head2 content_type() - -Return the content type of the file. - -=head2 size - -Return the byte size of the file. - -=head2 created - -Return the UNIX creation date of the file. - -=head2 modified - -Return the UNIX modification date of the file. - -=head2 data - -Return a IO::Handle for the file. - -=head1 SEE ALSO - -L , L diff --git a/lib/LibreCat/FileStore/File/BagIt.pm b/lib/LibreCat/FileStore/File/BagIt.pm deleted file mode 100644 index 68d9566ae..000000000 --- a/lib/LibreCat/FileStore/File/BagIt.pm +++ /dev/null @@ -1,38 +0,0 @@ -package LibreCat::FileStore::File::BagIt; - -use Catmandu::Sane; -use Moo; -use namespace::clean; - -with 'LibreCat::FileStore::File'; - -1; - -__END__ - -=pod - -=head1 NAME - -LibreCat::FileStore::File::BagIt - A BagIt implementation of a stored file - -=head1 SYNOPSIS - - use LibreCat::FileStore::BagIt; - - my $filestore => LibreCat::FileStore::BagIt->new(%options); - - my $file = $filestore->get('1234')->get('myfile.txt'); - - my $filename = $file->key; - my $content_type = $file->content_type; - my $size = $file->size; - my $created = $file->created; - my $modified = $file->modified; - my $data = $file->data; - - my $fh = $file->data->fh; - -=head1 SEE ALSO - -L diff --git a/lib/LibreCat/FileStore/File/FedoraCommons.pm b/lib/LibreCat/FileStore/File/FedoraCommons.pm deleted file mode 100644 index aa59951f8..000000000 --- a/lib/LibreCat/FileStore/File/FedoraCommons.pm +++ /dev/null @@ -1,38 +0,0 @@ -package LibreCat::FileStore::File::FedoraCommons; - -use Catmandu::Sane; -use Moo; -use namespace::clean; - -with 'LibreCat::FileStore::File'; - -1; - -__END__ - -=pod - -=head1 NAME - -LibreCat::FileStore::File::FedoraCommons - A FedoraCommons implementation of a stored file - -=head1 SYNOPSIS - - use LibreCat::FileStore::BagIt; - - my $filestore => LibreCat::FileStore::FedoraCommons->new(%options); - - my $file = $filestore->get('1234')->get('myfile.txt'); - - my $filename = $file->key; - my $content_type = $file->content_type; - my $size = $file->size; - my $created = $file->created; - my $modified = $file->modified; - my $data = $file->data; - - my $fh = $file->data->fh; - -=head1 SEE ALSO - -L diff --git a/lib/LibreCat/FileStore/File/Simple.pm b/lib/LibreCat/FileStore/File/Simple.pm deleted file mode 100644 index 7263ad4e0..000000000 --- a/lib/LibreCat/FileStore/File/Simple.pm +++ /dev/null @@ -1,38 +0,0 @@ -package LibreCat::FileStore::File::Simple; - -use Catmandu::Sane; -use Moo; -use namespace::clean; - -with 'LibreCat::FileStore::File'; - -1; - -__END__ - -=pod - -=head1 NAME - -LibreCat::FileStore::File::Simple - A default implementation of a stored file - -=head1 SYNOPSIS - - use LibreCat::FileStore::Simple; - - my $filestore => LibreCat::FileStore::Simple->new(%options); - - my $file = $filestore->get('1234')->get('myfile.txt'); - - my $filename = $file->key; - my $content_type = $file->content_type; - my $size = $file->size; - my $created = $file->created; - my $modified = $file->modified; - my $data = $file->data; - - my $fh = $file->data->fh; - -=head1 SEE ALSO - -L diff --git a/lib/LibreCat/FileStore/Simple.pm b/lib/LibreCat/FileStore/Simple.pm deleted file mode 100644 index 2694b928a..000000000 --- a/lib/LibreCat/FileStore/Simple.pm +++ /dev/null @@ -1,217 +0,0 @@ -package LibreCat::FileStore::Simple; - -use Catmandu::Sane; -use Moo; -use Carp; -use LibreCat::FileStore::Container::Simple; -use Data::UUID; -use POSIX qw(ceil); -use namespace::clean; - -with 'LibreCat::FileStore'; - -has root => (is => 'ro', required => '1'); -has uuid => (is => 'ro', trigger => 1); -has keysize => (is => 'ro', default => 9, trigger => 1); - -sub _trigger_keysize { - my $self = shift; - - croak "keysize needs to be a multiple of 3" - unless $self->keysize % 3 == 0; -} - -sub _trigger_uuid { - my $self = shift; - - $self->{keysize} = 36; -} - -sub list { - my ($self, $callback) = @_; - - my $root = $self->root; - my $keysize = $self->keysize; - - my $mindepth = ceil($keysize / 3); - my $maxdepth = $mindepth + 1; - - unless (-d $root) { - $self->log->error("no root $root found"); - return sub {undef}; - } - - $self->log->debug("creating generator for root: $root"); - return sub { - state $io; - - unless (defined($io)) { - open($io, - "find -L $root -mindepth $mindepth -maxdepth $maxdepth -type d |" - ); - } - - my $line = <$io>; - - unless (defined($line)) { - close($io); - return undef; - } - - chop($line); - $line =~ s/$root//; - $line =~ s/\///g; - $line; - }; -} - -sub exists { - my ($self, $key) = @_; - - croak "Need a key" unless defined $key; - - $self->log->debug("Checking exists $key"); - - my $path = $self->path_string($key); - - -d $path; -} - -sub add { - my ($self, $key) = @_; - - croak "Need a key" unless defined $key; - - my $path = $self->path_string($key); - - unless ($path) { - $self->log->error("Failed to create path from $key"); - return undef; - } - - $self->log->debug("Generating path $path for key $key"); - - LibreCat::FileStore::Container::Simple->create_container($path, $key); -} - -sub get { - my ($self, $key) = @_; - - croak "Need a key" unless defined $key; - - my $path = $self->path_string($key); - - unless ($path) { - $self->log->error("Failed to create path from $key"); - return undef; - } - - $self->log->debug("Loading path $path for key $key"); - - LibreCat::FileStore::Container::Simple->read_container($path, $key); -} - -sub delete { - my ($self, $key) = @_; - - croak "Need a key" unless defined $key; - - my $path = $self->path_string($key); - - unless ($path) { - $self->log->error("Failed to create path from $key"); - return undef; - } - - $self->log->debug("Destoying path $path for key $key"); - - LibreCat::FileStore::Container::Simple->delete_container($path); -} - -sub path_string { - my ($self, $key) = @_; - - my $keysize = $self->keysize; - - # Allow all hexidecimal numbers - $key =~ s{[^A-F0-9-]}{}g; - - # If the key is a UUID then the matches need to be exact - if ($self->uuid) { - try { - Data::UUID->new->from_string($key); - } - catch { - return undef; - }; - } - else { - return undef unless length($key) && length($key) <= $keysize; - $key =~ s/^0+//; - $key = sprintf "%-${keysize}.${keysize}d", $key; - } - - my $path = $self->root . "/" . join("/", unpack('(A3)*', $key)); - - $path; -} - -1; - -__END__ - - -=pod - -=head1 NAME - -LibreCat::FileStore::Simple - The default implementation of a file storage - -=head1 SYNOPSIS - - use LibreCat::FileStore::Simple; - - my $filestore =>LibreCat::FileStore::Simple->new(root => '/data2/librecat/file_uploads'); - - my $generator = $filestore->list; - - while (my $key = $generator->()) { - my $container = $filestore->get($key); - - for my $file ($container->list) { - my $filename = $file->key; - my $size = $file->size; - my $checksum = $file->md5; - my $created = $file->created; - my $modified = $file->modified; - my $io = $file->data; - } - } - - my $container = $filestore->get('1234'); - - if ($filestore->exists('1234')) { - ... - } - - my $container = $filestore->add('1235'); - - $filestore->delete('1234'); - -=head1 CONFIGURATION - -=head2 root($path) - -The path to the root of the Simple file store storage. - -=head2 uuid(0|1) - -Optional. Support UUID-s as identifiers. Default 0 - -=head2 keysize($num) - -Option. Support a FileStore with larger integer keys. Default 9 - -=head1 SEE ALSO - -L diff --git a/t/LibreCat/Cmd/file_store.t b/t/LibreCat/Cmd/file_store.t index 439ae0f07..dc49b0d7f 100644 --- a/t/LibreCat/Cmd/file_store.t +++ b/t/LibreCat/Cmd/file_store.t @@ -53,7 +53,7 @@ require_ok $pkg; my $output = $result->stdout; ok $output , 'got an output'; - like $output , qr/^000001234/, 'listing of 1234'; + like $output , qr/^1234/, 'listing of 1234'; } { @@ -67,18 +67,6 @@ require_ok $pkg; like $output , qr/^key: 1234/, 'added 1234'; } -{ - my $result = test_app( - qq|LibreCat::CLI| => ['file_store', 'move', '1234', 'test']); - - ok !$result->error, 'get threw no exception'; - - my $output = $result->stderr; - ok $output , 'got an output'; - - ok -r 't/data2/000/001/234/cpanfile', 'got a file'; -} - { my $result = test_app( qq|LibreCat::CLI| => ['file_store', 'delete', '1234', 'cpanfile']); @@ -106,17 +94,4 @@ require_ok $pkg; ok !-d 't/data/000/001/234', 'container is gone'; } -{ - my $result = test_app( - qq|LibreCat::CLI| => ['file_store', '--store=test', 'purge', '1234']); - - ok !$result->error, 'purge threw no exception'; - - my $output = $result->stdout; - - is $output , "", 'got no output'; - - ok !-d 't/data/000/001/234', 'container is gone'; -} - done_testing; diff --git a/t/LibreCat/FileStore.t b/t/LibreCat/FileStore.t deleted file mode 100644 index 59f8e2c0b..000000000 --- a/t/LibreCat/FileStore.t +++ /dev/null @@ -1,24 +0,0 @@ -use strict; -use warnings FATAL => 'all'; -use Test::More; -use File::Slurp; - -my $pkg; -my @fs_pkg; - -BEGIN { - $pkg = 'LibreCat::FileStore'; - use_ok $pkg; - @fs_pkg = map { - $_ =~ s/\.pm$//; - 'LibreCat::FileStore::' . $_; - } read_dir('lib/LibreCat/FileStore/'); - - use_ok $_ for @fs_pkg; -} - -require_ok $pkg; - -require_ok $_ for @fs_pkg; - -done_testing; diff --git a/t/LibreCat/FileStore/BagIt.t b/t/LibreCat/FileStore/BagIt.t deleted file mode 100644 index e1b213f7d..000000000 --- a/t/LibreCat/FileStore/BagIt.t +++ /dev/null @@ -1,160 +0,0 @@ -use Catmandu::Sane; -use Test::More; -use Test::Exception; -use File::Slurp; -use IO::File; -use File::Path qw(remove_tree); - -my $pkg; - -BEGIN { - $pkg = 'LibreCat::FileStore::BagIt'; - use_ok $pkg; -} -require_ok $pkg; - -my $store = $pkg->new(root => 't/tmp/file_store'); - -ok $store , 'filestore->new'; - -note("add container"); -{ - my $container = $store->add('1235'); - - ok $container , 'filestore->add'; - - ok -r 't/tmp/file_store/000/001/235', 'found a new bag'; -} - -note("get container"); -{ - my $container = $store->get('1235'); - - ok $container , 'retrieve the bag'; - - is $container->key, '1235', 'container->key'; - ok $container->modified, 'container->modified'; - ok $container->created, 'container->created'; -} - -note("exists container"); -{ - ok $store->exists('1235'), 'filestore->exists'; -} - -note("update container with files"); -{ - my $container = $store->get('1235'); - - is_deeply [$container->list], [], 'container->list'; - - ok $container->add("poem.txt", poem()), 'container->add'; - - $container->commit; - - my @list = $container->list; - - ok @list == 1, 'got one item in the container'; - - my $file = $list[0]; - - is ref($file), 'LibreCat::FileStore::File::BagIt', - 'item is a FileStore::File'; - - is $file->key, 'poem.txt', 'file->key'; - is $file->size, length(poem()), 'file->size'; - - ok $container->commit, 'container->commit'; - - ok -r 't/tmp/file_store/000/001/235/data/poem.txt', - 'found a poem.txt on disk'; - - $file = $container->get("poem.txt"); - - ok $file , 'container->get'; - - is $file->key, 'poem.txt', 'file->key'; - is $file->size, length(poem()), 'file->size'; - - # Now we have something on disk - ok $file->created, 'file->created'; - ok $file->modified, 'file->modified'; - - ok $container->add("poem2.txt", IO::File->new("t/poem.txt")), - 'adding a new file'; - - @list = $container->list; - - ok @list == 2, 'now we have 2 things in the list'; - - ok $container->commit, 'container->commit'; - - ok -r 't/tmp/file_store/000/001/235/data/poem.txt', - 'found a poem.txt on disk'; - ok -r 't/tmp/file_store/000/001/235/data/poem2.txt', - 'found a poem2.txt on disk'; - - $file = $container->get("poem2.txt"); - - ok $file , 'container->get (poem2)'; - - is $file->key, 'poem2.txt', 'file->key'; - is $file->size, length(poem()), 'file->size'; - - is $file->fh->getline, "Roses are red,\n", 'file->fh->getline'; -} - -note("delete container"); -{ - ok $store->delete('1235'), 'filestore->delete'; - - ok !-r 't/tmp/file_store/000/001/235', 'deleted the bag'; -} - -note("open existing container"); -{ - my $store = $pkg->new(root => 't/file_store/bagit'); - - ok $store , 'new'; - - my $container = $store->get('1'); - - ok $container , 'retrieve the bag'; - - my @list = $container->list; - - ok @list == 1, 'got one item in the container'; - - my $file = $list[0]; - - is ref($file), 'LibreCat::FileStore::File::BagIt', - 'item is a FileStore::File'; - - is $file->key, 'poem.txt', 'file->key'; - is $file->size, length(poem()), 'file->size'; -} - -done_testing; - -remove_path("t/tmp/file_store"); - -sub remove_path { - my $path = shift; - - # Stupid chdir trick to make remove_tree work - chdir("lib"); - if (-d "../$path") { - remove_tree("../$path"); - } - chdir(".."); -} - -sub poem { - my $str = <load('.'); - -my $pkg; - -BEGIN { - $pkg = 'LibreCat::FileStore::FedoraCommons'; - use_ok $pkg; -} -require_ok $pkg; - -SKIP: { - my $conf = Catmandu->config->{filestore}->{fedora}; - - unless ($ENV{FEDORA_NETWORK_TEST}) { - skip("No network. Set FEDORA_NETWORK_TEST to run these tests.", 5); - } - - my $store = $pkg->new(%{$conf->{options}}); - - ok $store , 'filestore->new'; - - note("add container"); - { - my $container = $store->add('999000999'); - - ok $container , 'filestore->add'; - } - - note("get container"); - { - my $container = $store->get('999000999'); - - ok $container , 'retrieve the bag'; - - is $container->key, '999000999', 'container->key'; - ok $container->modified, 'container->modified'; - ok $container->created, 'container->created'; - } - - note("exists container"); - { - ok $store->exists('999000999'), 'filestore->exists'; - } - - note("update container with files"); - { - my $container = $store->get('999000999'); - - is_deeply [$container->list], [], 'container->list'; - - ok $container->add("poem.txt", poem()), 'container->add'; - - my @list = $container->list; - - ok @list == 1, 'got one item in the container'; - - my $file = $list[0]; - - is ref($file), 'LibreCat::FileStore::File::FedoraCommons', - 'item is a FileStore::File'; - - is $file->key, 'poem.txt', 'file->key'; - is $file->size, length(poem()), 'file->size'; - - ok $container->commit, 'container->commit'; - - $file = $container->get("poem.txt"); - - ok $file , 'container->get'; - - is $file->key, 'poem.txt', 'file->key'; - is $file->size, length(poem()), 'file->size'; - - # Now we have something on disk - ok $file->created, 'file->created'; - ok $file->modified, 'file->modified'; - - ok $container->add("poem2.txt", IO::File->new("t/poem.txt")), - 'adding a new file'; - - @list = $container->list; - - ok @list == 2, 'now we have 2 things in the list'; - - ok $container->commit, 'container->commit'; - - $file = $container->get("poem2.txt"); - - ok $file , 'container->get (poem2)'; - - is $file->key, 'poem2.txt', 'file->key'; - is $file->size, length(poem()), 'file->size'; - - is $file->fh->getline, "Roses are red,\n", 'file->fh->getline'; - } - - note("delete container"); - { - ok $store->delete('999000999'), 'filestore->delete'; - } - - $store->delete('999000999'); -} - -done_testing; - -sub poem { - my $str = <new(root => 't/tmp/file_store'); - -ok $store , 'filestore->new'; - -note("add container"); -{ - my $container = $store->add('1235'); - - ok $container , 'filestore->add'; - - ok -r 't/tmp/file_store/000/001/235', 'found a new container'; -} - -note("get container"); -{ - my $container = $store->get('1235'); - - ok $container , 'retrieve the bag'; - - is $container->key, '1235', 'container->key'; - ok $container->modified, 'container->modified'; - ok $container->created, 'container->created'; -} - -note("exists container"); -{ - ok $store->exists('1235'), 'filestore->exists'; -} - -note("update container with files"); -{ - my $container = $store->get('1235'); - - is_deeply [$container->list], [], 'container->list'; - - ok $container->add("poem.txt", poem()), 'container->add'; - - my @list = $container->list; - - ok @list == 1, 'got one item in the container'; - - my $file = $list[0]; - - is ref($file), 'LibreCat::FileStore::File::Simple', - 'item is a FileStore::File'; - - is $file->key, 'poem.txt', 'file->key'; - is $file->size, length(poem()), 'file->size'; - - ok $container->commit, 'container->commit'; - - ok -r 't/tmp/file_store/000/001/235/poem.txt', 'found a poem.txt on disk'; - - $file = $container->get("poem.txt"); - - ok $file , 'container->get'; - - is $file->key, 'poem.txt', 'file->key'; - is $file->size, length(poem()), 'file->size'; - - # Now we have something on disk - ok $file->created, 'file->created'; - ok $file->modified, 'file->modified'; - - ok $container->add("poem2.txt", IO::File->new("t/poem.txt")), - 'adding a new file'; - - @list = $container->list; - - ok @list == 2, 'now we have 2 things in the list'; - - ok $container->commit, 'container->commit'; - - ok -r 't/tmp/file_store/000/001/235/poem.txt', 'found a poem.txt on disk'; - ok -r 't/tmp/file_store/000/001/235/poem2.txt', - 'found a poem2.txt on disk'; - - $file = $container->get("poem2.txt"); - - ok $file , 'container->get (poem2)'; - - is $file->key, 'poem2.txt', 'file->key'; - is $file->size, length(poem()), 'file->size'; - - is $file->fh->getline, "Roses are red,\n", 'file->fh->getline'; -} - -note("delete container"); -{ - ok $store->delete('1235'), 'filestore->delete'; - - ok !-r 't/tmp/file_store/000/000/001/235', 'deleted the bag'; -} - -note("open existing container"); -{ - my $store = $pkg->new(root => 't/file_store/simple'); - - ok $store , 'new'; - - my $container = $store->get('1'); - - ok $container , 'retrieve the bag'; - - my @list = $container->list; - - ok @list == 1, 'got one item in the container'; - - my $file = $list[0]; - - is ref($file), 'LibreCat::FileStore::File::Simple', - 'item is a FileStore::File'; - - is $file->key, 'poem.txt', 'file->key'; - is $file->size, length(poem()), 'file->size'; -} - -done_testing; - -remove_path("t/tmp/file_store"); - -sub remove_path { - my $path = shift; - - # Stupid chdir trick to make remove_tree work - chdir("lib"); - if (-d "../$path") { - remove_tree("../$path"); - } - chdir(".."); -} - -sub poem { - my $str = <