diff --git a/lib/SLUB/LZA/SIPBuilderBagIt.pm b/lib/SLUB/LZA/SIPBuilderBagIt.pm index 5fbb929c5db9511893baa4cbbffdb4680745118d..aa6f5ea014a029e7ad0782c897350969ea4f9912 100644 --- a/lib/SLUB/LZA/SIPBuilderBagIt.pm +++ b/lib/SLUB/LZA/SIPBuilderBagIt.pm @@ -3,6 +3,8 @@ use strict; use warnings; use utf8; use feature 'say'; +no warnings "experimental::signatures"; +use feature 'signatures'; use Archive::BagIt; use Carp; use Encode; @@ -38,14 +40,7 @@ my $marc21_to_baginfo_mappings = [ { tag => "246", code => "b", key => "Title" }, ]; -sub add_metadata($$$$) { - if(ref($_[0]) ne 'ARRAY') { croak "array of hashes not defined for bag-info.txt!"; } - - my $refAddBagInfo = $_[0]; # ref to array of hashes - my $ppn = $_[1]; - my $noppn = $_[2]; - my $marc21 = $_[3]; - +sub add_metadata($refAddBagInfo, $ppn, $noppn, $marc21) { # adding entries to bag-info key list push @{$refAddBagInfo}, {'External-Identifier' => "PPN:$ppn"} unless (! $ppn); push @{$refAddBagInfo}, {'External-Identifier' => "$noppn"} unless (! $noppn); @@ -58,13 +53,8 @@ sub add_metadata($$$$) { return 1; } -sub get_marc21_text_node($$) { - if(! $_[0]) { croak "empty marc21!"; } - if(ref($_[1]) ne 'HASH') { croak "not a mapping hash!"; } - - my $marc21 = $_[0]; - my $mapping = $_[1]; - +sub get_marc21_text_node($marc21, $mapping) { + if(ref($mapping) ne 'HASH') { croak "not a mapping hash!"; } # retrieve value based on mapping using a xpath my $xpath = "//*[\@tag='" . $mapping->{tag} . "']/"; $xpath .= "*[local-name()='subfield' and \@code='" . $mapping->{code} . "']/" unless (! exists $mapping->{code}); @@ -75,10 +65,8 @@ sub get_marc21_text_node($$) { return $text; } -sub get_marc21_from_catalogue($){ +sub get_marc21_from_catalogue($ppn){ if(! $_[0]){ croak "ppn not defined!"; } - - my $ppn = $_[0]; my $marc21; my $use_fallback; @@ -116,20 +104,9 @@ sub get_marc21_from_catalogue($){ return $marc21; } -sub get_marc21_from($$$$){ +sub get_marc21_from($url, $ppn,$key,$schema){ + # example: ppn="457035137" for "Der Fichtelberg" # specification SRU/SRW BSZ: https://wiki.k10plus.de/pages/viewpage.action?pageId=132874251 - if(! defined $_[0]) { croak "url not defined!"; } - if(! defined $_[1]) { croak "ppn not defined!"; } - if(! defined $_[2]) { croak "key not defined!"; } - if(! defined $_[3]) { croak "schema not defined!"; } - if($_[0] eq "" || $_[1] eq "" || $_[2] eq "" || $_[3] eq ""){ - die "invalid parameters."; - } - my $url = shift; - my $ppn = shift; # example: "457035137" for "Der Fichtelberg" - my $key = shift; - my $schema = shift; - my $ua = LWP::UserAgent->new; $ua->agent("MyApp/0.1 "); $ua->timeout(3600); #1h @@ -169,24 +146,16 @@ sub get_marc21_from($$$$){ return; } -sub add_marc21_schema_location($) { - if(ref($_[0]) ne 'XML::LibXML::Document') { croak "marc xml document required!"; } - my $marc_doc = $_[0]; +sub add_marc21_schema_location($marc_doc) { + if(ref($marc_doc) ne 'XML::LibXML::Document') { croak "marc xml document required!"; } my $root = $marc_doc->findnodes('/*[local-name()="record"]')->[0]; # get root element (XML::LibXML::Element) $root->setAttribute('xmlns:xsi', 'http://www.w3.org/2001/XMLSchema-instance'); # add xsi namespace (simple) $root->setAttribute('xsi:schemaLocation', 'http://www.loc.gov/MARC21/slim https://www.loc.gov/standards/marcxml/schema/MARC21slim.xsd'); # add MARCXML schema location # HINT: method sets or replaces the node's attribute - 1; + return 1; } -sub write_file($$){ - if(! defined $_[0]) { croak "filename not defined!"; } - if(! defined $_[1]) { croak "value not defined!"; } - if($_[0] eq "" || $_[1] eq ""){ die "invalid parameters."; } - - my $filename = $_[0]; - my $value = $_[1]; - +sub write_file($filename, $value){ # write data to file (UTF-8) open(my $fh, '>:encoding(UTF-8)', $filename) || (croak "Can't open '$filename', $!"); print $fh $value; @@ -194,20 +163,13 @@ sub write_file($$){ return 1; } - -sub generateBagName($$$){ - my $file_date = $_[0]; - my $ppn = $_[1]; - my $noppn = $_[2]; - +sub generateBagName($file_date, $ppn, $noppn){ $file_date =~ s/T/_/g; # replace 'T' with '_' $file_date =~ s/:/-/g; # replace ':' with '-' return (defined $ppn)? "PPN-${ppn}_${file_date}" : "ID-${noppn}_${file_date}"; } -sub createDir($){ - my $path = $_[0]; - +sub createDir($path){ if(! -d $path && ! -f $path){ eval { path($path)->mkpath; }; if ($@) { # error @@ -218,12 +180,7 @@ sub createDir($){ return 1; } -sub copyFilesToMeta($$$$$){ - my $ppn = $_[0]; - my $metaPath = $_[1]; - my $rightsFilePath = $_[2]; - my $aRefAddMetaFile = $_[3]; - my $marc21 = $_[4]; +sub copyFilesToMeta($ppn, $metaPath,$rightsFilePath,$aRefAddMetaFile,$marc21){ my @addMetaFile = @{ $aRefAddMetaFile }; @@ -270,20 +227,16 @@ sub copyFilesToMeta($$$$$){ return 1; } -sub validateRightsXML($$){ - if(! $_[0]) { croak "rightsFilePath not defined!"; } - if(! defined $_[1]) { croak "xsd name not defined!"; } - - my $rightsFilePath = $_[0]; - my $xsdName = $_[1]; - - my $rightsName = basename($rightsFilePath); +sub validateRightsXML($rightsFilePathString,$xsdName){ + my $rightsFilePath = path($rightsFilePathString); + if (!$rightsFilePath->is_file) { + die "rightsFilePath '$rightsFilePath' is not readable/does not exist"; + } + my $rightsName = $rightsFilePath->basename(); my $xsd_file = path(__FILE__)->parent->realpath->parent->child("xsd")->child($xsdName); # absolute path if (! $xsd_file->is_file) { - use Data::Printer; p($xsd_file); # retry, because assembled path for lib/ $xsd_file = path(__FILE__)->parent->parent->parent->realpath->parent->child("xsd")->child($xsdName); - use Data::Printer; p($xsd_file); } my $schema = XML::LibXML::Schema->new(location => $xsd_file); @@ -299,13 +252,8 @@ sub validateRightsXML($$){ return 1; } -sub print_scalar_data($$$$){ +sub print_scalar_data($header,$p,$arrRef,$pColor){ my $priority = 0; - my $header = $_[0]; - my $p = $_[1]; - my $arrRef = $_[2]; - my $pColor = $_[3]; - # header if($header ne ""){ print "----------------------------------------------------------------------------------\n" if $priority >= $VERBOSE; @@ -334,34 +282,19 @@ sub print_scalar_data($$$$){ return 1; } -sub create_slub_bagit($$){ - if(! defined $_[0]) { croak "bagPath is not defined!"; } - if(! defined $_[1]) { croak "array of hashes not defined for bag-info.txt!"; } - if(! -d $_[0]) { croak "path is not directory!" } - - my $bagPath = $_[0]; - my $refAddBagInfo = $_[1]; # ref to array of hashes - +sub create_slub_bagit($bagPath,$refAddBagInfo){ # construct bag + if(! defined $bagPath) { croak "bagPath is not defined!"; } + if(! -d $bagPath) { croak "path '$bagPath' is not directory!" } + if(! defined $refAddBagInfo ) { croak "array of hashes not defined for bag-info.txt!"; } my $oArchiveBagIt = Archive::BagIt->make_bag($bagPath); $oArchiveBagIt->bag_info($refAddBagInfo); $oArchiveBagIt->store(); print_scalar_data("", "SUCCESS: SLUB SIP at $bagPath build successfully!", "", "green"); - return 1; } -sub buildBagWithCopyOption($$$$$$$$$){ - my $ppn = $_[0]; - my $noppn = $_[1]; - my $ieDirectory = $_[2]; - my $rightsFilePath = $_[3]; - my $aRefAddMetaFile = $_[4]; - my $refAddBagInfo = $_[5]; # ref to array of hashes - my $bagPath = $_[6]; - my $dataPath = $_[7]; - my $metaPath = $_[8]; - +sub buildBagWithCopyOption($ppn,$noppn,$ieDirectory,$rightsFilePath,$aRefAddMetaFile,$refAddBagInfo,$bagPath,$dataPath,$metaPath){ my @addMetaFile = @{ $aRefAddMetaFile }; my @addBagInfo = @{ $refAddBagInfo }; my $marc21; @@ -392,17 +325,7 @@ sub buildBagWithCopyOption($$$$$$$$$){ return 1; } -sub buildBagWithMoveOption($$$$$$$$$){ - my $ppn = $_[0]; - my $noppn = $_[1]; - my $ieDirectory = $_[2]; - my $rightsFilePath = $_[3]; - my $aRefAddMetaFile = $_[4]; - my $refAddBagInfo = $_[5]; # ref to array of hashes - my $bagPath = $_[6]; - my $dataPath = $_[7]; - my $metaPath = $_[8]; - +sub buildBagWithMoveOption($ppn,$noppn,$ieDirectory,$rightsFilePath,$aRefAddMetaFile,$refAddBagInfo,$bagPath,$dataPath,$metaPath){ my @addMetaFile = @{ $aRefAddMetaFile }; my @addBagInfo = @{ $refAddBagInfo }; my $marc21; @@ -431,17 +354,7 @@ sub buildBagWithMoveOption($$$$$$$$$){ return 1; } -sub buildBagWithReplaceOption($$$$$$$$$){ - my $ppn = $_[0]; - my $noppn = $_[1]; - my $ieDirectory = $_[2]; - my $rightsFilePath = $_[3]; - my $aRefAddMetaFile = $_[4]; - my $refAddBagInfo = $_[5]; # ref to array of hashes - my $bagPath = $_[6]; - my $dataPath = $_[7]; - my $metaPath = $_[8]; - +sub buildBagWithReplaceOption($ppn,$noppn,$ieDirectory,$rightsFilePath,$aRefAddMetaFile,$refAddBagInfo,$bagPath,$dataPath,$metaPath){ my @addMetaFile = @{ $aRefAddMetaFile }; my @addBagInfo = @{ $refAddBagInfo }; my $marc21; @@ -470,11 +383,7 @@ sub buildBagWithReplaceOption($$$$$$$$$){ return 1; } -sub checkForTitle($){ - if(ref($_[0]) ne 'ARRAY') { croak "no array of hashes with bag-info.txt key values given!"; } - - my $key_hash_list_aref = $_[0]; - +sub checkForTitle($key_hash_list_aref){ # collect all bag-info keys for easy check my @keys; for my $hash (@{$key_hash_list_aref}) {