From 1cae5a1cbd1b0b4f9833e272c4146d8b60f17937 Mon Sep 17 00:00:00 2001 From: Leo Stoyanov Date: Wed, 22 Jan 2025 16:29:34 +0000 Subject: [PATCH] Bug 37020: [alternate] Changed script to use XML:Twig to reduce memory usage. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit In the original script, MARC::Batch->new('XML', ...) was holding onto large chunks of parsed data for MARCXML files, resulting in excessive memory usage even after the script tried to free references. A hacky approach was to manually clear the batch’s internal structures, but Data::Dumper showed that MARC::Batch wasn’t storing data in those specific fields. Hence, the hack offered no solution to the underlying caching. By contrast, XML::Twig can stream XML elements one by one, calling a handler and then discarding the parsed chunk. Note, there is no guarantee this implementation works for non-XML files as it stands (although, in theory it should). The focus is on the XML:Twig implementation for reference as a solution. Overall, batching seems to be eating up memory. To test: 1. Run perl misc/migration_tools/bulkmarcimport.pl -m=MARCXML -b -d -v --commit=1000 --file=file_path_here on a large MARCXML/XML file (for example, 2 GB or greater). 2. On whatever machine or container it is ran, the script will likely cause an out-of-memory error and crash the environment. 3. Apply the patch, run "restart_all", and redo step 1. The script should utilize much less memory to import records from MARCXML/XML files. --- misc/migration_tools/bulkmarcimport.pl | 915 ++++++++++++++----------- 1 file changed, 525 insertions(+), 390 deletions(-) diff --git a/misc/migration_tools/bulkmarcimport.pl b/misc/migration_tools/bulkmarcimport.pl index 70721f0529..03359ff717 100755 --- a/misc/migration_tools/bulkmarcimport.pl +++ b/misc/migration_tools/bulkmarcimport.pl @@ -1,11 +1,10 @@ #!/usr/bin/perl -# Import an iso2709 file into Koha 3 +# Import an iso2709 or MARCXML file into Koha use Modern::Perl; -#use diagnostics; - # Koha modules used +use MARC::Record; use MARC::File::USMARC; use MARC::File::XML; use MARC::Batch; @@ -29,7 +28,13 @@ use C4::MarcModificationTemplates qw( GetModificationTemplates ModifyRecordWithTemplate ); -use C4::AuthoritiesMarc qw( GuessAuthTypeCode GuessAuthId GetAuthority ModAuthority AddAuthority ); +use C4::AuthoritiesMarc qw( + GuessAuthTypeCode + GuessAuthId + GetAuthority + ModAuthority + AddAuthority +); use YAML::XS; use Time::HiRes qw( gettimeofday ); @@ -45,6 +50,10 @@ use Koha::SearchEngine::Search; use open qw( :std :encoding(UTF-8) ); binmode( STDOUT, ":encoding(UTF-8)" ); + +### CHANGED: We add XML::Twig for streaming MARCXML +use XML::Twig; + my ( $input_marc_file, $number, $offset, $cleanisbn ) = ( '', 0, 0, 1 ); my $version; my $delete; @@ -66,7 +75,6 @@ my $filters; my $update; my $all; my $yamlfile; -my $authtypes; my $append; my $sourcetag; my $sourcesubfield; @@ -78,6 +86,7 @@ my $marc_mod_template = ''; my $marc_mod_template_id = -1; my $skip_indexing = 0; my $skip_bad_records; + $| = 1; GetOptions( @@ -120,10 +129,12 @@ GetOptions( $biblios ||= !$authorities; $insert ||= !$update; -my $writemode = ($append) ? "a" : "w"; +my $writemode = ( $append ) ? "a" : "w"; -pod2usage( -msg => "\nYou must specify either --biblios or --authorities, not both.\n", -exitval ) - if $biblios && $authorities; +pod2usage( + -msg => "\nYou must specify either --biblios or --authorities, not both.\n", + -exitval => 1 +) if $biblios && $authorities; if ($all) { $insert = 1; @@ -134,14 +145,18 @@ my $using_elastic_search = ( C4::Context->preference('SearchEngine') eq 'Elastic my $mod_biblio_options = { disable_autolink => $using_elastic_search, skip_record_index => $using_elastic_search || $skip_indexing, - overlay_context => { source => 'bulkmarcimport' } + overlay_context => { source => 'bulkmarcimport' }, }; my $add_biblio_options = { disable_autolink => $using_elastic_search, + skip_record_index => $using_elastic_search || $skip_indexing, +}; +my $mod_authority_options = { + skip_record_index => $using_elastic_search || $skip_indexing +}; +my $add_authority_options = { skip_record_index => $using_elastic_search || $skip_indexing }; -my $mod_authority_options = { skip_record_index => $using_elastic_search || $skip_indexing }; -my $add_authority_options = { skip_record_index => $using_elastic_search || $skip_indexing }; my @search_engine_record_ids; my @search_engine_records; @@ -151,26 +166,26 @@ if ($using_elastic_search) { $indexer = Koha::SearchEngine::Elasticsearch::Indexer->new( { index => $authorities - ? $Koha::SearchEngine::Elasticsearch::AUTHORITIES_INDEX - : $Koha::SearchEngine::Elasticsearch::BIBLIOS_INDEX + ? $Koha::SearchEngine::Elasticsearch::AUTHORITIES_INDEX + : $Koha::SearchEngine::Elasticsearch::BIBLIOS_INDEX } ); } -if ( $version || ( $input_marc_file eq '' ) ) { +if ( $version || $input_marc_file eq '' ) { pod2usage( -verbose => 2 ); exit; } if ( $update && !( $match || $isbn_check ) ) { - warn "Using --update without --match or --isbn seems to be useless.\n"; + warn "Using --update without --match or --isbn is likely not useful.\n"; } -if ( defined $localcust ) { #local customize module +if ( defined $localcust ) { if ( !-e $localcust ) { - $localcust = $localcust || 'LocalChanges'; #default name - $localcust =~ s/^.*\/([^\/]+)$/$1/; #extract file name only - $localcust =~ s/\.pm$//; #remove extension - my $fqcust = $FindBin::Bin . "/$localcust.pm"; #try migration_tools dir + $localcust = $localcust || 'LocalChanges'; + $localcust =~ s/^.*\/([^\/]+)$/$1/; + $localcust =~ s/\.pm$//; + my $fqcust = $FindBin::Bin . "/$localcust.pm"; if ( -e $fqcust ) { $localcust = $fqcust; } else { @@ -190,23 +205,21 @@ if ( $marc_mod_template ne '' ) { $marc_mod_template_id = $this_template->{'template_id'}; } else { print "WARNING: MARC modification template name " - . "'$marc_mod_template' matches multiple templates. " - . "Please rename these templates\n"; + . "'$marc_mod_template' matches multiple templates.\n"; exit 1; } } } if ( $marc_mod_template_id < 0 ) { - die "Can't located MARC modification template '$marc_mod_template'\n"; + die "Can't locate MARC modification template '$marc_mod_template'\n"; } else { - print "Records will be modified using MARC modification template: $marc_mod_template\n" if $verbose; + print "MARC modification template: $marc_mod_template\n" if $verbose; } } my $dbh = C4::Context->dbh; -my $heading_fields = get_heading_fields(); +my $heading_fields = get_heading_fields($authtypes); my $idmapfh; - if ( defined $idmapfl ) { open( $idmapfh, '>', $idmapfl ) or die "cannot open $idmapfl \n"; } @@ -219,6 +232,7 @@ if ( ( not defined $sourcesubfield ) && ( not defined $sourcetag ) ) { # Disable logging for the biblios and authorities import operation. It would unnecessarily # slow the import $ENV{OVERRIDE_SYSPREF_CataloguingLog} = 0; +$ENV{OVERRIDE_SYSPREF_CataloguingLog} = 0; $ENV{OVERRIDE_SYSPREF_AuthoritiesLog} = 0; if ($fk_off) { @@ -236,83 +250,32 @@ if ($delete) { $dbh->do("ALTER TABLE items AUTO_INCREMENT = 1"); } else { print "Deleting authorities\n"; - $dbh->do("truncate auth_header"); + $dbh->do("TRUNCATE auth_header"); } - $dbh->do("truncate zebraqueue"); + $dbh->do("TRUNCATE zebraqueue"); } if ($test_parameter) { print "TESTING MODE ONLY\n DOING NOTHING\n===============\n"; } -my $batch; my $marc_flavour = C4::Context->preference('marcflavour') || 'MARC21'; +print "MARC flavour: $marc_flavour\n" if $verbose; # The definition of $searcher must be before MARC::Batch->new my $searcher = Koha::SearchEngine::Search->new( { - index => ( - $authorities + index => $authorities ? $Koha::SearchEngine::AUTHORITIES_INDEX : $Koha::SearchEngine::BIBLIOS_INDEX - ) } ); print "Characteristic MARC flavour: $marc_flavour\n" if $verbose; -my $starttime = gettimeofday; - -# don't let MARC::Batch open the file, as it applies the ':utf8' IO layer -my $fh = IO::File->new($input_marc_file) or die "Could not open $input_marc_file: $!"; - -if ( defined $format && $format =~ /XML/i ) { - - # ugly hack follows -- MARC::File::XML, when used by MARC::Batch, - # appears to try to convert incoming XML records from MARC-8 - # to UTF-8. Setting the BinaryEncoding key turns that off - # TODO: see what happens to ISO-8859-1 XML files. - # TODO: determine if MARC::Batch can be fixed to handle - # XML records properly -- it probably should be - # be using a proper push or pull XML parser to - # extract the records, not using regexes to look - # for .*. - $MARC::File::XML::_load_args{BinaryEncoding} = 'utf-8'; - my $recordformat = ( $marc_flavour eq "MARC21" ? "USMARC" : uc($marc_flavour) ); - - #UNIMARC Authorities have a different way to manage encoding than UNIMARC biblios. - $recordformat = $recordformat . "AUTH" if ( $authorities and $marc_flavour ne "MARC21" ); - $MARC::File::XML::_load_args{RecordFormat} = $recordformat; - $batch = MARC::Batch->new( 'XML', $fh ); -} else { - $batch = MARC::Batch->new( 'USMARC', $fh ); -} - -$batch->warnings_off(); -$batch->strict_off(); -my $commitnum = $commit ? $commit : 50; -my $yamlhash; - -# Skip file offset -if ($offset) { - print "Skipping file offset: $offset records\n"; - $batch->next() while ( $offset-- ); -} - -my ( $tagid, $subfieldid ); -if ($authorities) { - $tagid = '001'; -} else { - ( $tagid, $subfieldid ) = GetMarcFromKohaField("biblio.biblionumber"); - $tagid ||= "001"; -} - -my $sth_isbn; - -# the SQL query to search on isbn -if ($isbn_check) { - $sth_isbn = $dbh->prepare("SELECT biblionumber, biblioitemnumber FROM biblioitems WHERE isbn=?"); -} - +my $starttime = gettimeofday; +my $logger = Koha::Logger->get; +my $schema = Koha::Database->schema; +my $lint = MARC::Lint->new; my $loghandle; if ($logfile) { $loghandle = IO::File->new( $logfile, $writemode ); @@ -320,80 +283,65 @@ if ($logfile) { } my $record_number = 0; -my $logger = Koha::Logger->get; -my $schema = Koha::Database->schema; -my $marc_records = []; -my $lint = MARC::Lint->new; -RECORD: while () { - my $record; - $record_number++; +my $commitnum = $commit ? $commit : 50; +my $yamlhash; - # get record - eval { $record = $batch->next() }; - if ($@) { - print "Bad MARC record $record_number: $@ skipped\n"; - - # FIXME - because MARC::Batch->next() combines grabbing the next - # blob and parsing it into one operation, a correctable condition - # such as a MARC-8 record claiming that it's UTF-8 can't be recovered - # from because we don't have access to the original blob. Note - # that the staging import can deal with this condition (via - # C4::Charset::MarcToUTF8Record) because it doesn't use MARC::Batch. - next; - } - if ($record) { +$schema->txn_begin; - if ($skip_bad_records) { - my $xml = $record->as_xml_record(); - eval { MARC::Record::new_from_xml( $xml, 'UTF-8', "MARC21" ); }; - if ($@) { - print "Record $record_number generated invalid xml:\n"; - $lint->check_record($record); - foreach my $warning ( $lint->warnings ) { - print " " . $warning . "\n"; - } - print " Record skipped!"; - next; +### CHANGED: A new sub to handle "one MARC::Record" import logic. +### We take the logic from the old while RECORD loop, but wrap in a sub. +sub import_single_record { + my ($record) = @_; + return unless $record; + + # increment once per record + $record_number++; + + # skip Bad records if requested + if ($skip_bad_records) { + my $xml = $record->as_xml_record(); + eval { MARC::Record::new_from_xml( $xml, 'UTF-8', "MARC21" ); }; + if ($@) { + print "Record $record_number is invalid, skipping.\n"; + $lint->check_record($record); + foreach my $warning ( $lint->warnings ) { + print " Lint: $warning\n"; } + return; } - # transcode the record to UTF8 if needed & applicable. - if ( $record->encoding() eq 'MARC-8' and not $skip_marc8_conversion ) { - my ( $guessed_charset, $charset_errors ); - ( $record, $guessed_charset, $charset_errors ) = MarcToUTF8Record( - $record, - $marc_flavour . ( ( $authorities and $marc_flavour ne "MARC21" ) ? 'AUTH' : '' ) - ); - if ( $guessed_charset eq 'failed' ) { - warn "ERROR: failed to perform character conversion for record $record_number\n"; - next RECORD; - } + } + + # If record is MARC-8 and not skipping + if ( $record->encoding() eq 'MARC-8' and not $skip_marc8_conversion ) { + my ( $newrec, $charset_guess, $charset_err ) = MarcToUTF8Record( + $record, + $marc_flavour . ( ($authorities && $marc_flavour ne 'MARC21') ? 'AUTH' : '' ) + ); + if ( $charset_guess eq 'failed' ) { + warn "Charset conversion failed for record #$record_number\n"; + return; } - SetUTF8Flag($record); - &$localcust($record) if $localcust; - push @{$marc_records}, $record; - } else { - last; + $record = $newrec; } -} + SetUTF8Flag($record); -$record_number = 0; -my $records_total = @{$marc_records}; -$schema->txn_begin; -RECORD: foreach my $record ( @{$marc_records} ) { - $record_number++; - if ( ( $verbose // 1 ) == 1 ) { #no dot for verbose==2 + # local custom routine + &$localcust($record) if $localcust; + + if ( ( $verbose // 0 ) == 1 ) { print "." . ( $record_number % 100 == 0 ? "\n$record_number" : '' ); + } elsif ( ( $verbose // 0 ) > 1 ) { + print $record->as_formatted(), "\n"; } + # apply MARC mod template if ( $marc_mod_template_id > 0 ) { - print "Modifying MARC\n" if $verbose; ModifyRecordWithTemplate( $marc_mod_template_id, $record ); } + # Possibly handle ISBN cleaning my $isbn; - - # remove trailing - in isbn (only for biblios, of course) - if ( $biblios && ( $cleanisbn || $isbn_check ) ) { + if ($biblios && ( $cleanisbn || $isbn_check )) { my $tag = $marc_flavour eq 'UNIMARC' ? '010' : '020'; my $field = $record->field($tag); $isbn = $field && $field->subfield('a'); @@ -403,28 +351,33 @@ RECORD: foreach my $record ( @{$marc_records} ) { } } - # search for duplicates (based on Local-number) + my ( $tagid, $subfieldid ); + if ($authorities) { + $tagid = '001'; + } else { + ( $tagid, $subfieldid ) = GetMarcFromKohaField("biblio.biblionumber"); + $tagid ||= '001'; + } + my $originalid = GetRecordId( $record, $tagid, $subfieldid ); my $matched_record_id = undef; + + # handle match logic if ($match) { require C4::Search; - my $server = ( $authorities ? 'authorityserver' : 'biblioserver' ); + my $server = $authorities ? 'authorityserver' : 'biblioserver'; my $query = build_query( $match, $record ); $logger->debug("Bulkmarcimport: $query"); my ( $error, $results, $totalhits ) = $searcher->simple_search_compat( $query, 0, 3, [$server] ); - - # changed to warn so able to continue with one broken record if ( defined $error ) { - warn "unable to search the database for duplicates : $error"; - printlog( { id => $originalid, op => "match", status => "ERROR" } ) if ($logfile); - next RECORD; + warn "Duplicate search error: $error\n"; + printlog({ id => $originalid, op => "match", status => "ERROR" }) if $loghandle; + return; } $logger->debug("Bulkmarcimport: $query $server : $totalhits"); - # sub SimpleSearch could return undefined, but only on error, so - # should not really need to safeguard here, but do so anyway $results //= []; - if ( @{$results} == 1 ) { + if (@$results == 1) { my $matched_record = C4::Search::new_record_from_zebra( $server, $results->[0] ); SetUTF8Flag($matched_record); $matched_record_id = GetRecordId( $matched_record, $tagid, $subfieldid ); @@ -443,9 +396,9 @@ RECORD: foreach my $record ( @{$marc_records} ) { next; } } - } elsif ( @{$results} > 1 ) { + } elsif (@$results > 1) { $logger->debug("More than one match for: $query"); - next; + return; } else { $logger->debug("No match for: $query"); } @@ -455,19 +408,22 @@ RECORD: foreach my $record ( @{$marc_records} ) { if ( length($keepids) == 3 ) { $storeidfield = MARC::Field->new( $keepids, $originalid ); } else { - $storeidfield = - MARC::Field->new( substr( $keepids, 0, 3 ), "", "", substr( $keepids, 3, 1 ), $originalid ); + $storeidfield = MARC::Field->new( + substr($keepids, 0, 3), "", + "", substr($keepids, 3, 1), $originalid + ); } $record->insert_fields_ordered($storeidfield); $record->delete_field( $record->field($tagid) ); } } + # possibly remove fields if --filter foreach my $stringfilter (@$filters) { if ( length($stringfilter) == 3 ) { foreach my $field ( $record->field($stringfilter) ) { $record->delete_field($field); - $logger->debug( "Removed: ", $field->as_string ); + $logger->debug("Removed field $stringfilter") if $verbose; } } elsif ( $stringfilter =~ /([0-9]{3})([a-z0-9])(.*)/ ) { my $removetag = $1; @@ -475,282 +431,412 @@ RECORD: foreach my $record ( @{$marc_records} ) { my $removematch = $3; if ( ( $removetag > "010" ) && $removesubfield ) { foreach my $field ( $record->field($removetag) ) { - $field->delete_subfield( code => "$removesubfield", match => $removematch ); - $logger->debug( "Potentially removed: ", $field->subfield($removesubfield) ); + $field->delete_subfield( code => $removesubfield, match => $removematch ); } } } } - unless ($test_parameter) { - if ($authorities) { - my $authtypecode = GuessAuthTypeCode( $record, $heading_fields ); - my $authid; - - if ($matched_record_id) { - if ($update) { - ## Authority has an id and is in database: update - eval { - ($authid) = ModAuthority( - $matched_record_id, $record, $authtypecode, - $mod_authority_options, - ); - }; - if ($@) { - warn "ERROR: Update authority $matched_record_id failed: $@\n"; - printlog( { id => $matched_record_id, op => "update", status => "ERROR" } ) if ($logfile); - next RECORD; - } else { - printlog( { id => $authid, op => "update", status => "ok" } ) if ($logfile); - } - } elsif ($logfile) { - warn "WARNING: Update authority $originalid skipped"; - printlog( - { - id => $matched_record_id, - op => "update", - status => - "warning: authority already in database and option -update not enabled, skipping..." - } + + # if test only, skip DB changes + if ($test_parameter) { + return; + } + + # handle authorities vs biblios + if ($authorities) { + my $authtypecode = GuessAuthTypeCode( $record, $heading_fields ); + my $authid; + + if ($matched_record_id) { + if ($update) { + ## Authority has an id and is in database: update + eval { + ($authid) = ModAuthority( + $matched_record_id, + $record, + $authtypecode, + $mod_authority_options ); - } - } elsif ($insert) { - ## An authid is defined but no authority in database: insert - eval { ($authid) = AddAuthority( $record, undef, $authtypecode, $add_authority_options ); }; + }; if ($@) { - warn "ERROR: Insert authority $originalid failed: $@\n"; - printlog( { id => $originalid, op => "insert", status => "ERROR" } ) if ($logfile); - next RECORD; + warn "Update authority $matched_record_id failed: $@\n"; + printlog({ id => $matched_record_id, op => "update", status => "ERROR" }) if $loghandle; + return; } else { - printlog( { id => $authid, op => "insert", status => "ok" } ) if ($logfile); + printlog({ id => $authid, op => "update", status => "ok" }) if $loghandle; + push @search_engine_record_ids, $authid; + push @search_engine_records, $record; } } else { - warn "WARNING: Insert authority $originalid skipped"; - printlog( - { - id => $originalid, op => "insert", - status => "warning : authority not in database and option -insert not enabled, skipping..." - } - ) if ($logfile); + warn "Authority $originalid matched but update not enabled.\n"; + printlog({ id => $matched_record_id, op => "update", status => "skipped" }) if $loghandle; } - - if ($yamlfile) { - $yamlhash->{$originalid} = YAMLFileEntry( - $record, - $authid, - 1 #@FIXME: Really always updated? - ); + } elsif ($insert) { + ## An authid is defined but no authority in database: insert + eval { + ($authid) = AddAuthority( $record, undef, $authtypecode, $add_authority_options ); + }; + if ($@) { + warn "Insert authority $originalid failed: $@\n"; + printlog({ id => $originalid, op => "insert", status => "ERROR" }) if $loghandle; + return; } + printlog({ id => $authid, op => "insert", status => "ok" }) if $loghandle; push @search_engine_record_ids, $authid; push @search_engine_records, $record; } else { - my ( $biblioitemnumber, $itemnumbers_ref, $errors_ref, $record_id ); - - # check for duplicate, based on ISBN (skip it if we already have found a duplicate with match parameter - if ( !$matched_record_id && $isbn_check && $isbn ) { - $sth_isbn->execute($isbn); - ( $matched_record_id, $biblioitemnumber ) = $sth_isbn->fetchrow; - } + warn "Authority $originalid not in DB and --insert not set; skipping.\n"; + printlog({ id => $originalid, op => "insert", status => "skipped" }) if $loghandle; + } - if ( defined $idmapfl && $matched_record_id ) { - if ( $sourcetag < "010" ) { - if ( $record->field($sourcetag) ) { - my $source = $record->field($sourcetag)->data(); - printf( $idmapfh "%s|%s\n", $source, $matched_record_id ); - } - } else { - my $source = $record->subfield( $sourcetag, $sourcesubfield ); - printf( $idmapfh "%s|%s\n", $source, $matched_record_id ); + if ($yamlfile) { + $yamlhash->{$originalid} = YAMLFileEntry( + $record, + $authid, + 1 #@FIXME: Really always updated? + ); + } + } + else { + # biblios + my ( $biblioitemnumber, $itemnumbers_ref, $errors_ref, $record_id ); + if ( !$matched_record_id && $isbn_check && $isbn ) { + my $sth_isbn = $dbh->prepare("SELECT biblionumber, biblioitemnumber FROM biblioitems WHERE isbn=?"); + $sth_isbn->execute($isbn); + ( $matched_record_id, $biblioitemnumber ) = $sth_isbn->fetchrow; + } + if ( defined $idmapfh && $matched_record_id ) { + my $sourceval; + if ( $sourcetag < "010" ) { + if ( my $f = $record->field($sourcetag) ) { + $sourceval = $f->data(); } + } else { + $sourceval = $record->subfield( $sourcetag, $sourcesubfield ); + } + if ( defined $sourceval ) { + printf( $idmapfh "%s|%s\n", $sourceval, $matched_record_id ); } + } - # Create biblio, unless we already have it (either match or ISBN) - if ($matched_record_id) { - eval { $biblioitemnumber = Koha::Biblios->find($matched_record_id)->biblioitem->biblioitemnumber; }; - if ($update) { - my $success; - eval { - $success = ModBiblio( - $record, $matched_record_id, GetFrameworkCode($matched_record_id), - $mod_biblio_options - ); - }; - if ($@) { - warn "ERROR: Update biblio $matched_record_id failed: $@\n"; - printlog( { id => $matched_record_id, op => "update", status => "ERROR" } ) if ($logfile); - next RECORD; - } elsif ( !$success ) { - warn "ERROR: Update biblio $matched_record_id failed for unknown reason"; - printlog( { id => $matched_record_id, op => "update", status => "ERROR" } ) if ($logfile); - next RECORD; - } else { - $record_id = $matched_record_id; - printlog( { id => $record_id, op => "update", status => "ok" } ) if ($logfile); - } - } else { - warn "WARNING: Update biblio $originalid skipped"; - printlog( - { - id => $matched_record_id, op => "update", - status => "warning : already in database and option -update not enabled, skipping..." - } - ) if ($logfile); - } - } elsif ($insert) { - my $record_clone = $record->clone(); - C4::Biblio::_strip_item_fields($record_clone); - eval { ( $record_id, $biblioitemnumber ) = AddBiblio( $record_clone, $framework, $add_biblio_options ) }; + # Create biblio, unless we already have it (either match or ISBN) + if ($matched_record_id) { + if ($update) { + eval { + $biblioitemnumber = + Koha::Biblios->find($matched_record_id)->biblioitem->biblioitemnumber; + }; + my $success; + eval { + $success = ModBiblio( + $record, + $matched_record_id, + GetFrameworkCode($matched_record_id), + $mod_biblio_options + ); + }; if ($@) { - warn "ERROR: Insert biblio $originalid failed: $@\n"; - printlog( { id => $originalid, op => "insert", status => "ERROR" } ) if ($logfile); - next RECORD; + warn "ERROR updating biblio $matched_record_id: $@\n"; + printlog({ id => $matched_record_id, op => "update", status => "ERROR" }) if $loghandle; + return; + } elsif (!$success) { + warn "Update biblio $matched_record_id returned no success.\n"; + printlog({ id => $matched_record_id, op => "update", status => "ERROR" }) if $loghandle; + return; } else { - printlog( { id => $originalid, op => "insert", status => "ok" } ) if ($logfile); + $record_id = $matched_record_id; + printlog({ id => $record_id, op => "update", status => "ok" }) if $loghandle; } - + } else { + warn "Biblio $originalid matched but --update not set; skipping.\n"; + printlog({ id => $matched_record_id, op => "update", status => "skipped" }) if $loghandle; + return; + } + } + elsif ($insert) { + my $record_clone = $record->clone(); + C4::Biblio::_strip_item_fields($record_clone); + eval { + ( $record_id, $biblioitemnumber ) = AddBiblio( $record_clone, $framework, $add_biblio_options ); + }; + if ($@) { + warn "Insert biblio $originalid failed: $@\n"; + printlog({ id => $originalid, op => "insert", status => "ERROR" }) if $loghandle; + return; + } else { + printlog({ id => $originalid, op => "insert", status => "ok" }) if $loghandle; # If incoming record has bib ids set we need to transfer # new ids from record_clone to incoming record to avoid # working on wrong record (the original record) later on # when adding items for example - C4::Biblio::_koha_marc_update_bib_ids( $record, $framework, $record_id, $biblioitemnumber ); - } else { - warn "WARNING: Insert biblio $originalid skipped"; - printlog( - { - id => $originalid, op => "insert", - status => "warning : biblio not in database and option -insert not enabled, skipping..." - } - ) if ($logfile); - next RECORD; + C4::Biblio::_koha_marc_update_bib_ids( $record, $framework, $record_id, $biblioitemnumber ) + if $record_id; } - my $record_has_added_items = 0; - if ($record_id) { - $yamlhash->{$originalid} = $record_id if $yamlfile; - eval { - ( $itemnumbers_ref, $errors_ref ) = - AddItemBatchFromMarc( $record, $record_id, $biblioitemnumber, $framework ); - }; - my $error_adding = $@; - - if ($error_adding) { - warn "ERROR: Adding items to bib $record_id failed: $error_adding"; - printlog( { id => $record_id, op => "insert items", status => "ERROR" } ) if ($logfile); - - # if we failed because of an exception, assume that - # the MARC columns in biblioitems were not set. - next RECORD; - } - - $record_has_added_items = @{$itemnumbers_ref}; - - if ( $dedup_barcode && grep { exists $_->{error_code} && $_->{error_code} eq 'duplicate_barcode' } - @$errors_ref ) - { - # Find the record called 'barcode' - my ( $tag, $sub ) = C4::Biblio::GetMarcFromKohaField('items.barcode'); - - # Now remove any items that didn't have a duplicate_barcode error, - # erase the barcodes on items that did, and re-add those items. - my %dupes; - foreach my $i ( 0 .. $#{$errors_ref} ) { - my $ref = $errors_ref->[$i]; - if ( $ref && ( $ref->{error_code} eq 'duplicate_barcode' ) ) { - $dupes{ $ref->{item_sequence} } = 1; - - # Delete the error message because we're going to - # retry this one. - delete $errors_ref->[$i]; - } - } - my $seq = 0; - foreach my $field ( $record->field($tag) ) { - $seq++; - if ( $dupes{$seq} ) { - - # Here we remove the barcode - $field->delete_subfield( code => $sub ); - } else { - - # otherwise we delete the field because we don't want - # two of them - $record->delete_fields($field); - } - } + } else { + warn "Biblio $originalid not in DB & --insert not set; skipping.\n"; + printlog({ id => $originalid, op => "insert", status => "skipped" }) if $loghandle; + return; + } - # Now re-add the record as before, adding errors to the prev list - my $more_errors; - eval { - ( $itemnumbers_ref, $more_errors ) = - AddItemBatchFromMarc( $record, $record_id, $biblioitemnumber, '' ); - }; - if ($@) { - warn "ERROR: Adding items to bib $record_id failed: $@\n"; - printlog( { id => $record_id, op => "insert items", status => "ERROR" } ) if ($logfile); - - # if we failed because of an exception, assume that - # the MARC columns in biblioitems were not set. - next RECORD; + if ($record_id) { + my $record_has_added_items = 0; + $yamlhash->{$originalid} = $record_id if $yamlfile; + eval { + ( $itemnumbers_ref, $errors_ref ) = AddItemBatchFromMarc( + $record, + $record_id, + $biblioitemnumber, + $framework + ); + }; + my $error_adding = $@; + if ($error_adding) { + warn "ERROR adding items to biblio $record_id: $error_adding"; + printlog({ id => $record_id, op => "insert items", status => "ERROR" }) if $loghandle; + # If we failed because of an exception, assume that + # the MARC columns in biblioitems were not set. + return; + } + $record_has_added_items = @{$itemnumbers_ref}; + + if ( $dedup_barcode + && grep { $_->{error_code} && $_->{error_code} eq 'duplicate_barcode' } @$errors_ref ) + { + # Find the record called 'barcode'. + my ( $tag, $sub ) = C4::Biblio::GetMarcFromKohaField('items.barcode'); + # Now remove any items that didn't have a duplicate_barcode error, + # erase the barcodes on items that did, and re-add those items. + my %dupes; + foreach my $i ( 0 .. $#{$errors_ref} ) { + my $ref = $errors_ref->[$i]; + if ( $ref && $ref->{error_code} && $ref->{error_code} eq 'duplicate_barcode' ) { + $dupes{ $ref->{item_sequence} } = 1; + # Delete the error message because we're going to + # retry this one. + delete $errors_ref->[$i]; } - $record_has_added_items ||= @{$itemnumbers_ref}; - if ( @{$more_errors} ) { - push @$errors_ref, @{$more_errors}; + } + my $seq = 0; + foreach my $field ( $record->field($tag) ) { + $seq++; + if ( $dupes{$seq} ) { + # Here we remove the barcode. + $field->delete_subfield( code => $sub ); + } else { + # Otherwise, we delete the field because we don't want + # two of them. + $record->delete_fields($field); } } - if ($record_has_added_items) { - printlog( { id => $record_id, op => "insert items", status => "ok" } ) if ($logfile); + # Now re-add the record as before, adding errors to the prev list. + my $more_errors; + eval { + ( $itemnumbers_ref, $more_errors ) = AddItemBatchFromMarc( + $record, + $record_id, + $biblioitemnumber, + '' + ); + }; + if ($@) { + warn "ERROR re-adding items biblio $record_id: $@\n"; + printlog({ id => $record_id, op => "insert items", status => "ERROR" }) if $loghandle; + # If we failed because of an exception, assume that + # the MARC columns in biblioitems were not set. + return; } - - if ( @{$errors_ref} ) { - report_item_errors( $record_id, $errors_ref ); + $record_has_added_items ||= @{$itemnumbers_ref}; + if (@{$more_errors}) { + push @$errors_ref, @{$more_errors}; } + } - my $biblio = Koha::Biblios->find($record_id); - $record = $biblio->metadata_record( { embed_items => 1 } ); + if ($record_has_added_items) { + printlog({ id => $record_id, op => "insert items", status => "ok" }) if $loghandle; + } + if (@$errors_ref) { + report_item_errors( $record_id, $errors_ref ); + } + my $biblio_obj = Koha::Biblios->find($record_id); + if ($biblio_obj) { + my $indexed_record = $biblio_obj->metadata_record({ embed_items => 1 }); push @search_engine_record_ids, $record_id; - push @search_engine_records, $record; + push @search_engine_records, $indexed_record; } } - if ( $record_number % $commitnum == 0 || $record_number == $number || $record_number == $records_total ) { - $schema->txn_commit; - $schema->txn_begin; - if ($indexer) { - $indexer->update_index( \@search_engine_record_ids, \@search_engine_records ) unless $skip_indexing; - if ( C4::Context->preference('AutoLinkBiblios') ) { - foreach my $record (@search_engine_records) { - BiblioAutoLink( $record, $framework ); - } + } # end authorities vs biblios + + # If we've hit a commit boundary + if ( $record_number % $commitnum == 0 ) { + $schema->txn_commit; + $schema->txn_begin; + if ($indexer && !$skip_indexing) { + $indexer->update_index( \@search_engine_record_ids, \@search_engine_records ); + if (!$authorities && C4::Context->preference('AutoLinkBiblios')) { + foreach my $r (@search_engine_records) { + BiblioAutoLink($r, $framework); } - @search_engine_record_ids = (); - @search_engine_records = (); } } + @search_engine_record_ids = (); + @search_engine_records = (); } - print $record->as_formatted() . "\n" if ( $verbose // 0 ) == 2; - last if $record_number == $number; -} -$schema->txn_commit; +} # end sub import_single_record -if ($fk_off) { - $dbh->do("SET FOREIGN_KEY_CHECKS = 1"); -} -# Restore CataloguingLog and AuthoritiesLog -delete $ENV{OVERRIDE_SYSPREF_CataloguingLog}; -delete $ENV{OVERRIDE_SYSPREF_AuthoritiesLog}; +### CHANGED: A function for the older USMARC (non-XML) approach +sub parse_nonxml_with_marcbatch { + my ($fh) = @_; -my $timeneeded = gettimeofday - $starttime; -print "\n$record_number MARC records done in $timeneeded seconds\n"; -if ($logfile) { - print $loghandle "file : $input_marc_file\n"; - print $loghandle "$record_number MARC records done in $timeneeded seconds\n"; - $loghandle->close; + my $batch = MARC::Batch->new('USMARC', $fh); + $batch->warnings_off(); + $batch->strict_off(); + + # Skip file offset + if ($offset) { + print "Skipping offset: $offset records\n" if $verbose; + $batch->next() while $offset-- > 0; + } + + RECORD: while (1) { + my $record; + eval { $record = $batch->next() }; + if ($@) { + warn "Bad MARC record ? : $@\n"; + next RECORD; + } + last unless $record; + + import_single_record($record); + last if ( $number && $record_number == $number ); + } } -if ($yamlfile) { - open my $yamlfileout, q{>}, "$yamlfile" or die "cannot open $yamlfile \n"; - print $yamlfileout Encode::decode_utf8( YAML::XS::Dump($yamlhash) ); + +# This version dynamically removes any marc prefix in each XML element, but uses more memory. +# sub parse_xml_with_twig { +# my ($file) = @_; + +# # We'll read offset records if needed, but doing so with Twig means +# # we have to skip N elements manually. We'll do a counter: +# my $skipcount = $offset; + +# # We'll parse each , convert to MARC::Record, call import_single_record +# my $twig = XML::Twig->new( +# twig_handlers => { +# 'marc:record' => sub { +# print "In handler!\n"; +# my ($t, $elt) = @_; + +# # If offset skipping is not done yet, skip this record +# if ($skipcount > 0) { +# $skipcount--; +# $elt->purge(); +# return; +# } + +# # Convert to string +# my $xml_chunk = $elt->sprint(); + +# my $marcrec; +# eval { +# # If your Koha is MARC21, use 'MARC21' +# # or 'UNIMARC' if you have that +# $marcrec = MARC::Record->new_from_xml($xml_chunk, 'UTF-8', 'MARC21'); +# }; +# if ($@ || !$marcrec) { +# warn "Skipping bad MARC XML record: $@\n"; +# $elt->purge(); +# return; +# } +# print "Looking to call import record sub\n"; +# import_single_record($marcrec); + +# # purge from memory +# $elt->purge(); + +# # if we have a record limit +# if ($number && $record_number >= $number) { +# $t->finish_now(); +# } +# } +# }, +# keep_encoding => 1, +# ); + +# $twig->parsefile($file); +# } + +### CHANGED: A function for streaming MARCXML with XML::Twig, with preprocessing the file. +sub parse_xml_with_twig { + my ($file) = @_; + + # We'll read offset records if needed, but doing so with Twig means + # we have to skip N elements manually. We'll do a counter: + my $skipcount = $offset; + + # Preprocess the XML file to remove namespaces + my $preprocessed_file = 'preprocessed_marc.xml'; + open my $in, '<', $file or die "Can't open input file $file: $!"; + open my $out, '>', $preprocessed_file or die "Can't open output file $preprocessed_file: $!"; + + while (<$in>) { + s/marc://g; # Remove 'marc:' prefix + print $out $_; + } + + close $in; + close $out; + + print "Namespaces removed. Processing preprocessed file: $preprocessed_file\n"; + + # Now process the preprocessed file + my $twig = XML::Twig->new( + twig_handlers => { + 'record' => sub { # No namespace needed anymore + my ($t, $elt) = @_; + + # If offset skipping is not done yet, skip this record + if ($skipcount > 0) { + $skipcount--; + $elt->purge(); + return; + } + + # Convert to string + my $xml_chunk = $elt->sprint(); + + my $marcrec; + eval { + $marcrec = MARC::Record->new_from_xml($xml_chunk, 'UTF-8', 'MARC21'); + }; + if ($@ || !$marcrec) { + warn "Skipping bad MARC XML record: $@\n"; + $elt->purge(); + return; + } + + import_single_record($marcrec); + + $elt->purge(); + + # if we have a record limit + if ($number && $record_number >= $number) { + $t->finish_now(); + } + } + }, + keep_encoding => 1, + ); + + $twig->parsefile($preprocessed_file); } -exit 0; + + +#----------------------------------------------------------------- +# Helper subroutines from original script +#----------------------------------------------------------------- sub YAMLFileEntry { my ( $record, $record_id, $updated ) = @_; @@ -859,6 +945,56 @@ sub get_heading_fields { return $headingfields; } +#----------------------------------------------------------------- +# MAIN +#----------------------------------------------------------------- + +my $fh = IO::File->new($input_marc_file) + or die "Could not open $input_marc_file: $!"; + +### CHANGED: if the user specified -m=MARCXML or something matching /XML/i, +### we do the streaming twig approach. Otherwise, do old MARC::Batch approach. +if ( defined $format && $format =~ /XML/i ) { + print "XML with Twig call...\n"; + parse_xml_with_twig($input_marc_file); +} else { + parse_nonxml_with_marcbatch($fh); +} + +# Final commit +$schema->txn_commit; + +# Index after importations. +if ($indexer && !$skip_indexing) { + $indexer->update_index( \@search_engine_record_ids, \@search_engine_records ); + if (!$authorities && C4::Context->preference('AutoLinkBiblios')) { + foreach my $r (@search_engine_records) { + BiblioAutoLink($r, $framework); + } + } +} + +if ($fk_off) { + $dbh->do("SET FOREIGN_KEY_CHECKS = 1"); +} + +# Restore CataloguingLog and AuthoritiesLog +delete $ENV{OVERRIDE_SYSPREF_CataloguingLog}; +delete $ENV{OVERRIDE_SYSPREF_AuthoritiesLog}; + +my $timeneeded = gettimeofday - $starttime; +print "\n$record_number MARC records done in $timeneeded seconds\n"; +if ($logfile) { + print $loghandle "file : $input_marc_file\n"; + print $loghandle "$record_number MARC records done in $timeneeded seconds\n"; + $loghandle->close; +} +if ($yamlfile) { + open my $yamlfileout, q{>}, "$yamlfile" or die "cannot open $yamlfile \n"; + print $yamlfileout Encode::decode_utf8( YAML::XS::Dump($yamlhash) ); +} +exit 0; + =head1 NAME bulkmarcimport.pl - Import bibliographic/authority records into Koha @@ -1054,5 +1190,4 @@ this option bad records may kill the job. =back -=cut - +=cut \ No newline at end of file -- 2.39.5