From e46393caad4427eea708c0986222e4846dc07249 Mon Sep 17 00:00:00 2001
From: Andreas Romeyke <andreas.romeyke@slub-dresden.de>
Date: Tue, 3 Jan 2023 11:32:12 +0100
Subject: [PATCH] - added get_ie_pid_by_sip() - improved output
---
lib/SLUB/LZA/Rosetta/TA.pm | 58 +++++++++++++++++++++++++++++++++++++-
1 file changed, 57 insertions(+), 1 deletion(-)
diff --git a/lib/SLUB/LZA/Rosetta/TA.pm b/lib/SLUB/LZA/Rosetta/TA.pm
index 842997b..b5b6ff2 100644
--- a/lib/SLUB/LZA/Rosetta/TA.pm
+++ b/lib/SLUB/LZA/Rosetta/TA.pm
@@ -5,6 +5,7 @@ use App::Cmd::Setup -app;
use Path::Tiny qw( path );
use YAML qw(LoadFile);
use LWP::UserAgent;
+use SOAP::Lite;
use Carp qw( croak );
use feature qw(say);
use Regexp::Optimizer;
@@ -76,6 +77,45 @@ sub sru_search {
}
}
+sub get_ie_pid_by_sip {
+ my $sip = shift;
+ my $protocol = "https";
+ my $host = $config{host};
+ my $port = 8443;
+ my $wsdl_url="${protocol}://${host}:${port}/dpsws/repository/SipWebServices?wsdl";
+ #print "DEBUG: $wsdl_url";
+ my $soap = SOAP::Lite->new;
+ $soap->proxy(
+ $wsdl_url,
+ timeout => 3000,
+ keep_alive => 1,
+ ssl_opts => {
+ verify_hostname=>1,
+ # SSL_ca_path => '/etc/ssl/',
+ }
+ );
+ $soap->ns('http://dps.exlibris.com/');
+ $soap->on_action(sub {return ''}); # remove SOAP action if used with Rosetta 6.xx or higher
+ my $som = $soap->call(
+ 'getSipIEs',
+ SOAP::Data->name('arg0')->value($sip)->type('string')
+ );
+ if ($som->fault) {
+ confess ("ERROR: server '$host' says: ".$som->faultstring."\n");
+ }
+ #my $res = log_empty_result( $som, $logger, $host);
+ my $res = $som->result;
+ if ($res eq '') { # defined but empty result without SOAP fault
+ # HINT: 2 possibilities
+ # * SIP-ID doesn't exist
+ # * SIP-ID existed before but Rosetta clean up job removed all status infos
+ return; # let caller decide how to act on an empty result (no SOAP error)
+ }
+ my $ie = $res;
+ $ie=~s/^IE(\d*).*/$1/;
+ return $ie;
+}
+
{
my $bred = "\e[1;31m";
my $red = "\e[31m";
@@ -206,12 +246,16 @@ sub trace_log {
my $line_rx3 = Regexp::Optimizer->new->optimize(qr{^$pre_rx.*Loaded \d+ files for: .*$searchid});
my $line_rx4 = Regexp::Optimizer->new->optimize(qr{^$pre_rx.*((Representation $searchid IE \d+)|(Representation \d+ IE $searchid)) Copy ID: \d+});
if ($with_trace =~ m/^SIP/) { # search specific sip
+ $sip_id=$searchid;
+ $ie_pid=get_ie_pid_by_sip($sip_id);
$line_rx1 = Regexp::Optimizer->new->optimize(qr{^$pre_rx.*($sip_rx)$searchid});
$line_rx2 = $line_rx1;
} elsif ($with_trace =~ m/^IE/) { # search specific IE
+ $ie_pid=$searchid;
$line_rx3 = Regexp::Optimizer->new->optimize(qr{^$pre_rx.*Loaded \d+ files for: REP\d+ \(IE$searchid\)});
$line_rx4 = Regexp::Optimizer->new->optimize(qr{^$pre_rx.*Representation \d+ IE $searchid Copy ID: \d+});
} elsif ($with_trace =~ m/^REP/) {
+ $rep_id=$searchid;
$line_rx3 = Regexp::Optimizer->new->optimize(qr{^$pre_rx.*Loaded \d+ files for: REP$searchid \(IE\d+\)});
$line_rx4 = Regexp::Optimizer->new->optimize(qr{^$pre_rx.*Representation $searchid IE \d+ Copy ID: \d+});
}
@@ -251,6 +295,9 @@ sub trace_log {
if ( m/$line_rx1/ ) {
if (!defined $sip_id and m/$sip_rx(\d{6}),/) {
$sip_id = $2;
+ if (!defined $ie_pid) {
+ $ie_pid=get_ie_pid_by_sip($sip_id);
+ }
$cache{$file_md5}->{sip_id}->{$sip_id}=1; # mark as match
}
if (!defined $deposit_dir and m/originalDirName=([^,]*),/) {
@@ -265,6 +312,9 @@ sub trace_log {
} elsif (m/$line_rx2/) {
if (!defined $sip_id and m/SIP (\d{6})/) {
$sip_id = $1;
+ if (!defined $ie_pid) {
+ $ie_pid=get_ie_pid_by_sip($sip_id);
+ }
$cache{$file_md5}->{sip_id}->{$sip_id}=1; # mark as match
}
if (!defined $deposit_id and m/Deposit Activity ID=(\d+)/) {
@@ -296,7 +346,13 @@ sub trace_log {
};
helper_scan_log($directory, $fh_processing_stage1);
no warnings;
- my $match= "found: DIR=$deposit_dir, DEPOSITID=$deposit_id, SIPID=$sip_id, IEPID=$ie_pid, REPID=$rep_id";
+ my $match= sprintf("found: DIR=%s, DEPOSITID=%d, SIPID=%s, IEPID=%s, REPID=%s",
+ $deposit_dir ? $deposit_dir : "----",
+ $deposit_id ? $deposit_id : "----",
+ $sip_id ? $sip_id : "----",
+ $ie_pid ? "IE".$ie_pid : "----",
+ $rep_id ? "REP".$rep_id: "----"
+ );
use warnings;
say "$match";
say "-"x(length($match));
--
GitLab