diff --git a/perl/exit_strategy.pl b/perl/exit_strategy.pl index 49886a5feca6493f559aa89a74426ae88f60075b..e621e920de0ecb6541e59dc1403440e28ecf441a 100644 --- a/perl/exit_strategy.pl +++ b/perl/exit_strategy.pl @@ -56,6 +56,7 @@ use Time::Progress; use XML::LibXML::XPathContext; use XML::LibXML; + STDOUT->autoflush(1); # guarantee, that output will be UTF8 binmode(STDOUT, ":encoding(UTF-8)"); @@ -247,20 +248,20 @@ sub write_addsql ($dbh, $plans, $refhash) { } # start SQL insert - $plans->{aip}->execute($ieid, $ieversion) or die "sql problem detected", $dbh->errstr; + eval {$plans->{aip}->execute($ieid, $ieversion)} or die "sql problem detected with $ieid ($ieversion), plz check if there is a dublette dir, ", $dbh->errstr; # FIXME if multiple locations exists - $plans->{ie}->execute( $ieid, $ieversion, $iefile, $sourcetype) or die "sql problem detected", $dbh->errstr; + eval{$plans->{ie}->execute( $ieid, $ieversion, $iefile, $sourcetype)} or die "sql problem detected with $ieid ($ieversion, $iefile, $sourcetype), ", $dbh->errstr; foreach my $location (@{$refhash->{"files"}}) { my $file = basename($location); # FIXME if multiple locations - $plans->{file}->execute($ieid, $ieversion, $file) or die "sql problem detected", $dbh->errstr; - $plans->{locat}->execute($ieid, $ieversion, $file, $location, $sourcetype) or die "sql problem detected", $dbh->errstr; + eval {$plans->{file}->execute($ieid, $ieversion, $file)} or die "sql problem detected with $ieid ($ieversion, $file), ", $dbh->errstr; + eval {$plans->{locat}->execute($ieid, $ieversion, $file, $location, $sourcetype)} or die "sql problem detected with $ieid ($ieversion, $file, $location, $sourcetype), ", $dbh->errstr; } foreach my $dcpair (@{$refhash->{"dcrecords"}}) { my ($dckey,$dcvalue) = @{$dcpair}; # quote ' in dcvalue $dcvalue=~tr/'/"/; - $plans->{dc}->execute($ieid, $ieversion, $dckey, $dcvalue) or die "sql problem detected", $dbh->errstr; + eval {$plans->{dc}->execute($ieid, $ieversion, $dckey, $dcvalue)} or die "sql problem detected with $ieid ($ieversion, $dckey, $dcvalue), ", $dbh->errstr; } if ($refhash->{'purged'}) { my @purged = @{$refhash->{'purged'}}; @@ -270,7 +271,7 @@ sub write_addsql ($dbh, $plans, $refhash) { my $reason = $purge->{'reason'}; my $date = $purge->{'date'}; my $authorized_by = $purge->{'authorized_by'}; - $plans->{deleted}->execute($ieid, $ieversion, $state, $reason, $date, $authorized_by) or die "sql problem detected", $dbh->errstr; + eval {$plans->{deleted}->execute($ieid, $ieversion, $state, $reason, $date, $authorized_by)} or die "sql problem detected with $ieid ($ieversion, $state, $reason, $date, $authorized_by), ", $dbh->errstr; } } return 1; @@ -341,9 +342,6 @@ sub check_if_db_conform ($string, $filename) { } } - - - ############################################################################### # # /mets:mets/mets:dmdSec[1]/mets:mdWrap[1]/mets:xmlData[1]/dc:record[1]/dc:title[1] @@ -579,6 +577,7 @@ my $flag_recovery = undef; my $flag_sqldump = undef; my $flag_continue = undef; my $db_filename = $db_name . ".db"; +my $debug_to_file = undef; my @ARGV_tail; GetOptions( "help|?" => sub { @@ -589,6 +588,7 @@ call $0 with following options --continue ........... tries to add IEs to existing database, ignores IEs which already exists in DB (dangerous!) --sqlitedb-file=FILE . set database to file FILE --enable-sqldump ..... dumps a given database as SQL to STDOUT + --debug_to_file=FILE . dumps internal structure as YAML to FILE create an exit-DB: $0 [--recovery] [--sqlitedb-file=FILE] DIR [DIR…] @@ -602,6 +602,7 @@ HELP "recovery" => \$flag_recovery, "sqlitedb-file=s" => \$db_filename, "enable-sqldump" => \$flag_sqldump, + "debug_to_file=s" => \$debug_to_file, '<>' => sub {push @ARGV_tail, @_;} ) or pod2usage(2); @@ -661,6 +662,10 @@ while (<$fh_unsorted_IEs>) { print $progressbar->report("parse IE files: %40b ETA: %E \r", $count++); s/V0*(\d+-IE)/V$1/; # revert fake version my $ret = parse_iexml($_, $flag_recovery); + if (defined $debug_to_file and length($debug_to_file)>2) { + require YAML::XS; + YAML::XS::DumpFile($debug_to_file, $ret) or warn "could not dump to file $debug_to_file"; + } $dbh->begin_work; eval { write_addsql($dbh, $plans, $ret);