@@ -, +, @@ --- C4/Biblio.pm | 118 ++++++++++++++++++++++---- misc/migration_tools/bulkmarcimport.pl | 70 ++++++++++++++- t/db_dependent/PreserveLegacyId.t | 150 +++++++++++++++++++++++++++++++++ 3 files changed, 319 insertions(+), 19 deletions(-) create mode 100755 t/db_dependent/PreserveLegacyId.t --- a/C4/Biblio.pm +++ a/C4/Biblio.pm @@ -2944,9 +2944,33 @@ sub _koha_add_biblio { $biblio->{'serial'} = 0; if ( $biblio->{'seriestitle'} ) { $biblio->{'serial'} = 1 } } + + ### Validating biblionumber. + my $biblionumber; + my $isBiblioNumberOk = ''; #placeholder for the sql-clause which inserts biblionumber + if (exists $biblio->{'biblionumber'}) { + $biblionumber = $biblio->{'biblionumber'}; + if (! ($biblionumber =~ /^\d+$/) ) { + $error .= "C4::Biblio::_koha_add_biblio():> Biblionumber $biblionumber is not a number! Using a new biblionumber\n"; + } + elsif (! ($biblionumber > 0)) { + $error .= "C4::Biblio::_koha_add_biblio():> Biblionumber $biblionumber is not greater than 0! Using a new biblionumber\n"; + } + #The real Perl LONG_MAX is 2147483646, but using 2147483640 + # so we can detect the imminent primary key exhaustion before it actually is exhausted. + elsif (! ($biblionumber < 2147483640)) { + $error .= "C4::Biblio::_koha_add_biblio():> Biblionumber $biblionumber is too large for Perl! Using a new biblionumber\n"; + } + else { + #We have validated the biblionumber and can prepare to insert it. + $isBiblioNumberOk = 'biblionumber = ?,'; + } + + } my $query = "INSERT INTO biblio SET frameworkcode = ?, + $isBiblioNumberOk author = ?, title = ?, unititle =?, @@ -2958,16 +2982,31 @@ sub _koha_add_biblio { abstract = ? "; my $sth = $dbh->prepare($query); - $sth->execute( - $frameworkcode, $biblio->{'author'}, $biblio->{'title'}, $biblio->{'unititle'}, $biblio->{'notes'}, - $biblio->{'serial'}, $biblio->{'seriestitle'}, $biblio->{'copyrightdate'}, $biblio->{'abstract'} - ); + + if ($isBiblioNumberOk) { + $sth->execute( + $frameworkcode, $biblionumber, $biblio->{'author'}, $biblio->{'title'}, $biblio->{'unititle'}, $biblio->{'notes'}, + $biblio->{'serial'}, $biblio->{'seriestitle'}, $biblio->{'copyrightdate'}, $biblio->{'abstract'} + ); + } + else { + $sth->execute( + $frameworkcode, $biblio->{'author'}, $biblio->{'title'}, $biblio->{'unititle'}, $biblio->{'notes'}, + $biblio->{'serial'}, $biblio->{'seriestitle'}, $biblio->{'copyrightdate'}, $biblio->{'abstract'} + ); + } + - my $biblionumber = $dbh->{'mysql_insertid'}; + $biblionumber = $isBiblioNumberOk ? $biblionumber : $dbh->{'mysql_insertid'}; if ( $dbh->errstr ) { $error .= "ERROR in _koha_add_biblio $query" . $dbh->errstr; + } + + + if (defined $error) { warn $error; } + $sth->finish(); @@ -3093,9 +3132,33 @@ Internal function to add a biblioitem sub _koha_add_biblioitem { my ( $dbh, $biblioitem ) = @_; my $error; + + ### Validating biblionumber. + my $biblioitemnumber; + my $isBiblioitemNumberOk = ''; #placeholder for the sql-clause which inserts biblionumber + if (exists $biblioitem->{'biblioitemnumber'}) { + $biblioitemnumber = $biblioitem->{'biblioitemnumber'}; + if (! ($biblioitemnumber =~ /^\d+$/) ) { + $error .= "C4::Biblio::_koha_add_biblioitem():> biblioitemnumber $biblioitemnumber is not a number! Using a new biblioitemnumber\n"; + } + elsif (! ($biblioitemnumber > 0)) { + $error .= "C4::Biblio::_koha_add_biblioitem():> biblioitemnumber $biblioitemnumber is not greater than 0! Using a new biblioitemnumber\n"; + } + #The real Perl LONG_MAX is 2147483646, but using 2147483640 + # so we can detect the imminent primary key exhaustion before it actually is exhausted. + elsif (! ($biblioitemnumber < 2147483640)) { + $error .= "C4::Biblio::_koha_add_biblioitem():> biblioitemnumber $biblioitemnumber is too large for Perl! Using a new biblioitemnumber\n"; + } + else { + #We have validated the biblionumber and can prepare to insert it. + $isBiblioitemNumberOk = 'biblioitemnumber = ?,'; + } + + } my ($cn_sort) = GetClassSort( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} ); my $query = "INSERT INTO biblioitems SET + $isBiblioitemNumberOk biblionumber = ?, volume = ?, number = ?, @@ -3129,24 +3192,45 @@ sub _koha_add_biblioitem { agerestriction = ? "; my $sth = $dbh->prepare($query); - $sth->execute( - $biblioitem->{'biblionumber'}, $biblioitem->{'volume'}, $biblioitem->{'number'}, $biblioitem->{'itemtype'}, - $biblioitem->{'isbn'}, $biblioitem->{'issn'}, $biblioitem->{'publicationyear'}, $biblioitem->{'publishercode'}, - $biblioitem->{'volumedate'}, $biblioitem->{'volumedesc'}, $biblioitem->{'collectiontitle'}, $biblioitem->{'collectionissn'}, - $biblioitem->{'collectionvolume'}, $biblioitem->{'editionstatement'}, $biblioitem->{'editionresponsibility'}, $biblioitem->{'illus'}, - $biblioitem->{'pages'}, $biblioitem->{'bnotes'}, $biblioitem->{'size'}, $biblioitem->{'place'}, - $biblioitem->{'lccn'}, $biblioitem->{'marc'}, $biblioitem->{'url'}, $biblioitem->{'biblioitems.cn_source'}, - $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'}, $biblioitem->{'cn_suffix'}, $cn_sort, - $biblioitem->{'totalissues'}, $biblioitem->{'ean'}, $biblioitem->{'agerestriction'} - ); - my $bibitemnum = $dbh->{'mysql_insertid'}; + + if ($isBiblioitemNumberOk) { + $sth->execute( + $biblioitem->{'biblioitemnumber'}, + $biblioitem->{'biblionumber'}, $biblioitem->{'volume'}, $biblioitem->{'number'}, $biblioitem->{'itemtype'}, + $biblioitem->{'isbn'}, $biblioitem->{'issn'}, $biblioitem->{'publicationyear'}, $biblioitem->{'publishercode'}, + $biblioitem->{'volumedate'}, $biblioitem->{'volumedesc'}, $biblioitem->{'collectiontitle'}, $biblioitem->{'collectionissn'}, + $biblioitem->{'collectionvolume'}, $biblioitem->{'editionstatement'}, $biblioitem->{'editionresponsibility'}, $biblioitem->{'illus'}, + $biblioitem->{'pages'}, $biblioitem->{'bnotes'}, $biblioitem->{'size'}, $biblioitem->{'place'}, + $biblioitem->{'lccn'}, $biblioitem->{'marc'}, $biblioitem->{'url'}, $biblioitem->{'biblioitems.cn_source'}, + $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'}, $biblioitem->{'cn_suffix'}, $cn_sort, + $biblioitem->{'totalissues'}, $biblioitem->{'ean'}, $biblioitem->{'agerestriction'} + ); + } + else { + $sth->execute( + $biblioitem->{'biblionumber'}, $biblioitem->{'volume'}, $biblioitem->{'number'}, $biblioitem->{'itemtype'}, + $biblioitem->{'isbn'}, $biblioitem->{'issn'}, $biblioitem->{'publicationyear'}, $biblioitem->{'publishercode'}, + $biblioitem->{'volumedate'}, $biblioitem->{'volumedesc'}, $biblioitem->{'collectiontitle'}, $biblioitem->{'collectionissn'}, + $biblioitem->{'collectionvolume'}, $biblioitem->{'editionstatement'}, $biblioitem->{'editionresponsibility'}, $biblioitem->{'illus'}, + $biblioitem->{'pages'}, $biblioitem->{'bnotes'}, $biblioitem->{'size'}, $biblioitem->{'place'}, + $biblioitem->{'lccn'}, $biblioitem->{'marc'}, $biblioitem->{'url'}, $biblioitem->{'biblioitems.cn_source'}, + $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'}, $biblioitem->{'cn_suffix'}, $cn_sort, + $biblioitem->{'totalissues'}, $biblioitem->{'ean'}, $biblioitem->{'agerestriction'} + ); + } + + $biblioitemnumber = $isBiblioitemNumberOk ? $biblioitemnumber : $dbh->{'mysql_insertid'}; if ( $dbh->errstr ) { $error .= "ERROR in _koha_add_biblioitem $query" . $dbh->errstr; + } + + if (defined $error) { warn $error; } + $sth->finish(); - return ( $bibitemnum, $error ); + return ( $biblioitemnumber, $error ); } =head2 _koha_delete_biblio --- a/misc/migration_tools/bulkmarcimport.pl +++ a/misc/migration_tools/bulkmarcimport.pl @@ -34,7 +34,7 @@ use Pod::Usage; use open qw( :std :encoding(UTF-8) ); binmode( STDOUT, ":encoding(UTF-8)" ); my ( $input_marc_file, $number, $offset) = ('',0,0); -my ($version, $delete, $test_parameter, $skip_marc8_conversion, $char_encoding, $verbose, $commit, $fk_off,$format,$biblios,$authorities,$keepids,$match, $isbn_check, $logfile); +my ($version, $delete, $test_parameter, $skip_marc8_conversion, $char_encoding, $verbose, $commit, $fk_off,$format,$biblios,$authorities,$keepids,$match, $isbn_check, $logfile, $legacyIdAsBiblionumberFromHere); my ( $insert, $filters, $update, $all, $yamlfile, $authtypes ); my $cleanisbn = 1; my ($sourcetag,$sourcesubfield,$idmapfl, $dedup_barcode); @@ -73,6 +73,7 @@ GetOptions( 'yaml:s' => \$yamlfile, 'dedupbarcode' => \$dedup_barcode, 'framework=s' => \$framework, + 'g|legacyIdAsBiblionumberFromHere:s' => \$legacyIdAsBiblionumberFromHere, ); $biblios ||= !$authorities; $insert ||= !$update; @@ -166,14 +167,23 @@ if ( $offset ) { $batch->next() while ($offset--); } -my ($tagid,$subfieldid); +my ($tagid, $subfieldid, $binum_tagid, $binum_subfieldid); if ($authorities){ $tagid='001'; } else { ( $tagid, $subfieldid ) = GetMarcFromKohaField( "biblio.biblionumber", $framework ); + ( $binum_tagid, $binum_subfieldid ) = + GetMarcFromKohaField( "biblioitems.biblioitemnumber", $framework ); $tagid||="001"; + + #This is important for the functionality $legacyIdAsBiblionumberFromHere + if ($tagid ne $binum_tagid) { + warn "Koha to MARC mapping values biblio.biblionumber and biblioitems.biblioitemnumber must share the same MARC field!"; + exit(1); + } + } # the SQL query to search on isbn @@ -204,6 +214,26 @@ RECORD: while ( ) { $i++; print "."; print "\n$i" unless $i % 100; + + + + ### If you are like me and don't have the legacy id in $999c and $999d, you + ### can use this functionality to copy the id on the fly. + ### By default, copy legacy id field 001 to 999c and 999d ### + if ($legacyIdAsBiblionumberFromHere) { + my $legacyIdField = $record->field( $legacyIdAsBiblionumberFromHere ); + if ($legacyIdField) { + my $legacyId = $legacyIdField->data(); + my $biblionumberField = MARC::Field->new( $tagid, '', '', + $subfieldid => $legacyId, + $binum_subfieldid => $legacyId, + ); + $record->append_fields($biblionumberField); + } + else { + warn "No $legacyIdAsBiblionumberFromHere found!"; + } + } # transcode the record to UTF8 if needed & applicable. if ($record->encoding() eq 'MARC-8' and not $skip_marc8_conversion) { @@ -579,6 +609,14 @@ bulkmarcimport.pl - Import bibliographic/authority records into Koha $ export KOHA_CONF=/etc/koha.conf $ perl misc/migration_tools/bulkmarcimport.pl -d -commit 1000 \\ -file /home/jmf/koha.mrc -n 3000 + + Migrate your legacy bibliographic records to Koha, while having the legacy id + in a field $999 according to your directives here + "Administration" > "Koha to Marc mapping". + You also have the legacy id in field $001 so your analytic and component + records links wont be broken. + $ perl misc/migration_tools/bulkmarcimport.pl -d -commit 1000 \\ + -file /home/jmf/koha.marcxml -m MARCXML -b =head1 WARNING @@ -586,6 +624,15 @@ Don't use this script before you've entered and checked your MARC parameters tables twice (or more!). Otherwise, the import won't work correctly and you will get invalid data. +If you want to assign your legacy bibliographic id as the biblionumber and +biblioitemnumber in Koha biblio- and bibliotiems -tables, you must first +specify the mappings in "Administration" > "Koha to MARC mapping". + +It is extremely recommended to use field $999 to migrate your legacy id's. +If you set it to for ex. 001, librarians might manually reuse an existing id. +Also make sure that the legacy id is a strict positive integer and less than +perl -MPOSIX -le 'print LONG_MAX'. + =head1 DESCRIPTION =over @@ -685,6 +732,12 @@ Field store ids in I (usefull for authorities, where 001 contains the authid for Koha, that can contain a very valuable info for authorities coming from LOC or BNF. useless for biblios probably) +If your legacy id is already in 001, or the field you want it in. Dont use this +parameter as it will move the biblionumber from your definition at +"Administration" > "Koha to Marc mapping" as a duplicate of your original id. +Thus you lose your MARC-field mapped to biblionumber before the record is +processed. + =item B<-match>= I matchindex,fieldtomatch matchpoint to use to deduplicate fieldtomatch @@ -732,6 +785,19 @@ This is the code for the framework that the requested records will have attached to them when they are created. If not specified, then the default framework will be used. +=item B<-g, -legacyIdAsBiblionumberFromHere>= + +If you already have your legacy database id in your marc record and want to +preserve it, but still want to get it set as the biblionumber and biblioitemnumber +in Kohas database, use this. + +Example: +Field 001 has your legacy id. +Koha to MARC mapping needs legacy id in 999c and 999d as well for biblionumber +and biblioitemnumber, use + -g 001 +to copy the legacy id to field 999cd and thus get the id preserved in DB. + =back =cut --- a/t/db_dependent/PreserveLegacyId.t +++ a/t/db_dependent/PreserveLegacyId.t @@ -0,0 +1,150 @@ +#!/usr/bin/perl +# +# This Koha test module is a stub! +# Add more tests here!!! + +use Modern::Perl; +use utf8; + +use Test::More tests => 3; +use MARC::Record; + +BEGIN { + use_ok('C4::Record'); + use_ok('C4::Biblio'); +} + +### Preparing our testing data ### +my $bibFramework = ''; #Using the default bibliographic framework. +my $marcxml=qq( + + 00000cim a22000004a 4500 + 1001 + 2013-06-03 07:04:07+02 + ss||||j||||||| + uuuu xxk|||||||||||||||||eng|c + + 0-00-103147-3 + 14.46 EUR + + + eng + + + 83.5 + ykl + + + SHAKESPEARE, WILLIAM. + + + THE TAMING OF THE SHREW / + WILLIAM SHAKESPEARE + [ÄÄNITE]. + + + LONDON : + COLLINS. + + + 2 ÄÄNIKASETTIA. + + + FI-Jm + 83.5 + + + FI-Konti + 83.5 + + +); + +my $record=marcxml2marc($marcxml); + +my ( $biblionumberTagid, $biblionumberSubfieldid ) = + GetMarcFromKohaField( "biblio.biblionumber", $bibFramework ); +my ( $biblioitemnumberTagid, $biblioitemnumberSubfieldid ) = + GetMarcFromKohaField( "biblioitems.biblioitemnumber", $bibFramework ); + +# Making sure the Koha to MARC mappings stand correct +is ($biblionumberTagid, $biblioitemnumberTagid, 'Testing "Koha to MARC mapping" biblionumber and biblioitemnumber source MARC field sameness'); +if ($biblionumberTagid ne $biblioitemnumberTagid) { + warn "Koha to MARC mapping values biblio.biblionumber and biblioitems.biblioitemnumber must share the same MARC field!"; +} + +#Moving the 001 to the field configured for legacy id +my $legacyIdField = $record->field( '001' ); +my $legacyId = $legacyIdField->data(); +my $biblionumberField = MARC::Field->new( $biblionumberTagid, '', '', + $biblionumberSubfieldid => $legacyId, + $biblioitemnumberSubfieldid => $legacyId, +); +$record->append_fields($biblionumberField); + +#Convenience method to easily change the legacy id. +# Is used to test out database id boundary values. +sub changeLegacyId { + my ($record, $newId) = @_; + + # Because the author of Marc::Record decided it would be nice to replace all subfields with new ones whenever they are updated, + # old references are lost and need to be found again. + my $legacyIdField = $record->field( '001' ); + my $biblionumberField = $record->field( $biblionumberTagid ); + + $legacyIdField->update( $newId ); + $biblionumberField->update( $biblionumberSubfieldid => $newId, + $biblioitemnumberSubfieldid => $newId); + $legacyId = $newId; + + +} + +############################## +### Running the main test! ### +############################## + +## INSERT the record to the DB, SELECT the one we got, +## then find out if the biblionumber and biblioitemnumbers are the original ones. + +my $dbh = C4::Context->dbh; + +$dbh->{AutoCommit} = 0; #We don't want to save anything in DB as this is just a test run! +$dbh->{RaiseError} = 1; + +##Testing just below the critical threshold in _koha_add_item() primary key validators. +## Test should run OK. Also this biblionumber hardly is reserved :) +changeLegacyId($record, 2147483639); + +my ( $newBiblionumber, $newBiblioitemnumber ) = AddBiblio( $record, $bibFramework, { defer_marc_save => 1 } ); +my $selectedBiblio = GetBiblio($legacyId); + +is ($legacyId, $newBiblionumber, 'Biblionumber returned by AddBiblio matches'); +is ($legacyId, $selectedBiblio->{biblionumber}, 'Biblionumber returned by GetBiblio matches the legacy biblionumber'); + + +##Testing primary key exhaustion situation. Validator should prevent biblionumber or biblioitemnumber INSERTion +## if the value is over the safety threshold 2147483639 == LONG_MAX +## So both tests should fail. +changeLegacyId($record, 2147483645); + +( $newBiblionumber, $newBiblioitemnumber ) = AddBiblio( $record, $bibFramework, { defer_marc_save => 1 } ); +$selectedBiblio = GetBiblio($legacyId); + +isnt ($legacyId, $newBiblionumber, 'Testing primary key exhaustion prevention.'); +isnt ($legacyId, $selectedBiblio->{biblionumber}, 'Primary key exhausted biblio matching'); + +##Testing bad primary key situation. Validator should prevent biblionumber or biblioitemnumber INSERTion +## if the value is not a pure integer/long. +## So both tests should fail. +changeLegacyId($record, '12134FAN'); + +( $newBiblionumber, $newBiblioitemnumber ) = AddBiblio( $record, $bibFramework, { defer_marc_save => 1 } ); +$selectedBiblio = GetBiblio($legacyId); + +isnt ($legacyId, $newBiblionumber, 'Testing primary key not-an-integer prevention.'); +isnt ($legacyId, $selectedBiblio->{biblionumber}, 'Primary key not-an-integer biblio matching'); + + +$dbh->rollback(); +$dbh->disconnect(); --