@@ -, +, @@ - 606 $9 1214 $3 123 $a Europe $9 1215 $3 456 $y France $9 1210 $3 199 $x Politiciens $9 1216 $3 789 $z 1801-1860 -250 $a Politiciens -250 $a Politique - 606 $9 1214 $3 123 $a Europe $9 1215 $3 456 $y France $9 1210 $3 199 $x Politique $9 1216 $3 789 $z 1801-1860 - 606 $9 1210 $3 199 $a Politiciens - 606 $9 1210 $3 199 $a Politique --- C4/AuthoritiesMarc.pm | 447 +++++++++++++++++----------- C4/Charset.pm | 45 +++ installer/data/mysql/kohastructure.sql | 1 + installer/data/mysql/updatedatabase.pl | 10 + installer/data/mysql/versions/bug_8304.sql | 7 + misc/migration_tools/bulkmarcimport.pl | 218 ++++++++++---- misc/migration_tools/merge_authority.pl | 12 +- 7 files changed, 516 insertions(+), 224 deletions(-) create mode 100644 installer/data/mysql/versions/bug_8304.sql --- a/C4/AuthoritiesMarc.pm +++ a/C4/AuthoritiesMarc.pm @@ -19,12 +19,14 @@ package C4::AuthoritiesMarc; use strict; use warnings; use C4::Context; +use List::MoreUtils qw/any none first_index/; use MARC::Record; use C4::Biblio; use C4::Search; use C4::AuthoritiesMarc::MARC21; use C4::AuthoritiesMarc::UNIMARC; use C4::Charset; +use C4::Debug; use C4::Log; use Koha::Authority; @@ -32,7 +34,7 @@ use vars qw($VERSION @ISA @EXPORT); BEGIN { # set the version for version checking - $VERSION = 3.07.00.049; + $VERSION = 3.11.00.001; require Exporter; @ISA = qw(Exporter); @@ -62,6 +64,7 @@ BEGIN { &GuessAuthTypeCode &GuessAuthId + authorityflavour ); } @@ -95,6 +98,24 @@ sub GetAuthMARCFromKohaField { return ($tagfield,$tagsubfield); } +=head2 authorityflavour + + $authorityflavour = authorityflavour(); + return the marc flavour used for authorities + +=cut +my $authorityflavour; + +sub authorityflavour { + return $authorityflavour if defined $authorityflavour; + $authorityflavour = + (uc(C4::Context->preference('marcflavour')) eq 'UNIMARC'? + "UNIMARCAUTH": + C4::Context->preference('marcflavour') + ); + return $authorityflavour; +} + =head2 SearchAuthorities (\@finalresult, $nbresults)= &SearchAuthorities($tags, $and_or, @@ -449,16 +470,16 @@ sub GetAuthTypeCode { =head2 GuessAuthTypeCode - my $authtypecode = GuessAuthTypeCode($record); + my $authtypecode = GuessAuthTypeCode($record, [$headingfields]); Get the record and tries to guess the adequate authtypecode from its content. =cut sub GuessAuthTypeCode { - my ($record) = @_; + my ($record, $heading_fields) = @_; return unless defined $record; -my $heading_fields = { + $heading_fields //= { "MARC21"=>{ '100'=>{authtypecode=>'PERSO_NAME'}, '110'=>{authtypecode=>'CORPO_NAME'}, @@ -653,15 +674,7 @@ sub AddAuthority { my $leader=' nz a22 o 4500';#Leader for incomplete MARC21 record # if authid empty => true add, find a new authid number - my $format; - if (uc(C4::Context->preference('marcflavour')) eq 'UNIMARC') { - $format= 'UNIMARCAUTH'; - } - else { - $format= 'MARC21'; - } - - #update date/time to 005 for marc and unimarc +#update date/time to 005 for marc and unimarc my $time=POSIX::strftime("%Y%m%d%H%M%S",localtime); my $f5=$record->field('005'); if (!$f5) { @@ -672,7 +685,7 @@ sub AddAuthority { } SetUTF8Flag($record); - if ($format eq "MARC21") { + if (authorityflavour() eq "MARC21") { if (!$record->leader) { $record->leader($leader); } @@ -704,7 +717,7 @@ sub AddAuthority { } } - if ($format eq "UNIMARCAUTH") { + if (authorityflavour() eq "UNIMARCAUTH") { $record->leader(" nx j22 ") unless ($record->leader()); my $date=POSIX::strftime("%Y%m%d",localtime); if (my $string=$record->subfield('100',"a")){ @@ -721,7 +734,7 @@ sub AddAuthority { } } my ($auth_type_tag, $auth_type_subfield) = get_auth_type_location($authtypecode); - if (!$authid and $format eq "MARC21") { + if (!$authid and authorityflavour() eq "MARC21") { # only need to do this fix when modifying an existing authority C4::AuthoritiesMarc::MARC21::fix_marc21_auth_type_location($record, $auth_type_tag, $auth_type_subfield); } @@ -753,12 +766,12 @@ sub AddAuthority { $record->add_fields('001',$authid) unless ($record->field('001')); # warn "\n\n\n enregistrement".$record->as_formatted; my $sth=$dbh->prepare("update auth_header set authtypecode=?,marc=?,marcxml=? where authid=?"); - $sth->execute($authtypecode,$record->as_usmarc,$record->as_xml_record($format),$authid) or die $sth->errstr; + $sth->execute($authtypecode,$record->as_usmarc,$record->as_xml_record(authorityflavour()),$authid) or die $sth->errstr; $sth->finish; } else { my $sth=$dbh->prepare("insert into auth_header (authid,datecreated,authtypecode,marc,marcxml) values (?,now(),?,?,?)"); - $sth->execute($authid,$authtypecode,$record->as_usmarc,$record->as_xml_record($format)); + $sth->execute($authid,$authtypecode,$record->as_usmarc,$record->as_xml_record(authorityflavour())); $sth->finish; logaction( "AUTHORITIES", "ADD", $authid, "authority" ) if C4::Context->preference("AuthoritiesLog"); } @@ -809,9 +822,9 @@ sub ModAuthority { &merge($authid,$oldrecord,$authid,$record); } else { # save a record in need_merge_authorities table - my $sqlinsert="INSERT INTO need_merge_authorities (authid, done) ". - "VALUES (?,?)"; - $dbh->do($sqlinsert,undef,($authid,0)); + my $sqlinsert="INSERT INTO need_merge_authorities (authid, init_value, done) ". + "VALUES (?,?,?)"; + $dbh->do($sqlinsert,undef,($authid,$oldrecord->as_xml_record(authorityflavour()),0)); } logaction( "AUTHORITIES", "MODIFY", $authid, "BEFORE=>" . $oldrecord->as_formatted ) if C4::Context->preference("AuthoritiesLog"); return $authid; @@ -1439,6 +1452,7 @@ sub AddAuthorityTrees{ return $rq->execute($trees,$authid); } + =head2 merge $ref= &merge(mergefrom,$MARCfrom,$mergeto,$MARCto) @@ -1448,184 +1462,283 @@ Then we should add some new parameter : bibliotargettag, authtargettag =cut + +# Test if a subfield exist in a subfield list +sub _test_subfcode_presence { + my ( $subfields, $subfcode ) = @_; + return grep { $_->[0] eq $subfcode } @$subfields; +} + +# Test if a string exists in a field +sub _test_string { + my ( $string, @fields ) = @_; + my $return = 0; + for my $field (@fields) { + if ( grep { $_->[1] =~ /$string/i } $field->subfields ) { + $return = 1; + last; + } + } + return $return; +} + +# _process_subfcode_4_merge sets the correct subfcode +sub _process_subfcode_4_merge { + my ( $tagfield, $bibliosubfields, $authorityrecord, $authoritysubfields, + $authtypecode ) + = @_; + return unless ( uc( C4::Context->preference('marcflavour') ) eq 'UNIMARC' ); + if ( $tagfield eq "600" + or $tagfield eq "606" + or $tagfield eq "607" + or $tagfield eq "700" + or $tagfield eq "701" + or $tagfield eq "702" + or $tagfield eq "710" + or $tagfield eq "711" + or $tagfield eq "712" ) + { + my $authtag = GetAuthType($authtypecode); + my $chronological_auth = + _test_string( qq{S'emploie uniquement en subdivision chronologique}, + $authorityrecord->field('3..') ); + my $subfz_absent = not _test_subfcode_presence( $bibliosubfields, 'z' ); + if ( _test_subfcode_presence( $bibliosubfields, "a" ) ) { + if ( ( $authtag->{'auth_tag_to_report'} eq '215' ) + and ( $tagfield ne "607" ) ) + { + return "y"; + + } + elsif ( $chronological_auth and $subfz_absent ) { + return "z"; + } + else { + return "x"; + } + } + return; + } + return; +} + sub merge { - my ($mergefrom,$MARCfrom,$mergeto,$MARCto) = @_; - my ($counteditedbiblio,$countunmodifiedbiblio,$counterrors)=(0,0,0); - my $dbh=C4::Context->dbh; + my ( $mergefrom, $MARCfrom, $mergeto, $MARCto ) = @_; + my $dbh = C4::Context->dbh; + my $marcflavour = C4::Context->preference('marcflavour'); my $authtypecodefrom = GetAuthTypeCode($mergefrom); - my $authtypecodeto = GetAuthTypeCode($mergeto); -# warn "mergefrom : $authtypecodefrom $mergefrom mergeto : $authtypecodeto $mergeto "; + my $authtypecodeto = GetAuthTypeCode($mergeto); + $MARCfrom ||= GetAuthority($mergefrom); + $MARCto ||= GetAuthority($mergeto); + my @editedbiblios = (); + # return if authority does not exist - return "error MARCFROM not a marcrecord ".Data::Dumper::Dumper($MARCfrom) if scalar($MARCfrom->fields()) == 0; - return "error MARCTO not a marcrecord".Data::Dumper::Dumper($MARCto) if scalar($MARCto->fields()) == 0; + return "error MARCFROM not a marcrecord " . Data::Dumper::Dumper($MARCfrom) + if ( !$MARCfrom or scalar( $MARCfrom->fields() ) == 0 ); + return "error MARCTO not a marcrecord" . Data::Dumper::Dumper($MARCto) + if ( !$MARCto or scalar( $MARCto->fields() ) == 0 ); + # search the tag to report - my $sth = $dbh->prepare("select auth_tag_to_report from auth_types where authtypecode=?"); + my $sth = $dbh->prepare( + "select auth_tag_to_report from auth_types where authtypecode=?"); $sth->execute($authtypecodefrom); my ($auth_tag_to_report_from) = $sth->fetchrow; $sth->execute($authtypecodeto); my ($auth_tag_to_report_to) = $sth->fetchrow; - + my @record_to; - @record_to = $MARCto->field($auth_tag_to_report_to)->subfields() if $MARCto->field($auth_tag_to_report_to); + @record_to = + grep { $_->[0] !~ /[0-9]/ } + $MARCto->field($auth_tag_to_report_to)->subfields() + if $MARCto->field($auth_tag_to_report_to); + if ( uc($marcflavour) eq 'UNIMARC' and $MARCto->field('009') ) { + unshift @record_to, [ 3 => $MARCto->field('009')->data() ]; + } + my $field_to; + $field_to = $MARCto->field($auth_tag_to_report_to) + if $MARCto->field($auth_tag_to_report_to); my @record_from; - @record_from = $MARCfrom->field($auth_tag_to_report_from)->subfields() if $MARCfrom->field($auth_tag_to_report_from); - + @record_from = $MARCfrom->field($auth_tag_to_report_from)->subfields() + if $MARCfrom->field($auth_tag_to_report_from); + my @reccache; + # search all biblio tags using this authority. #Getting marcbiblios impacted by the change. - if (C4::Context->preference('NoZebra')) { - #nozebra way - my $dbh=C4::Context->dbh; - my $rq=$dbh->prepare(qq(SELECT biblionumbers from nozebra where indexname="an" and server="biblioserver" and value="$mergefrom" )); + if ( C4::Context->preference('NoZebra') ) { + + #nozebra way + my $dbh = C4::Context->dbh; + my $rq = $dbh->prepare( +qq(SELECT biblionumbers from nozebra where indexname="an" and server="biblioserver" and value="$mergefrom" ) + ); $rq->execute; - while (my $biblionumbers=$rq->fetchrow){ - my @biblionumbers=split /;/,$biblionumbers; + while ( my $biblionumbers = $rq->fetchrow ) { + my @biblionumbers = split /;/, $biblionumbers; foreach (@biblionumbers) { - if ($_=~/(\d+),.*/) { - my $marc=GetMarcBiblio($1); - push @reccache,$marc; + if ( $_ =~ /(\d+),.*/ ) { + my $marc = GetMarcBiblio($1); + push @reccache, $marc; } } } - } else { - #zebra connection - my $oConnection=C4::Context->Zconn("biblioserver",0); - # We used to use XML syntax here, but that no longer works. - # Thankfully, we don't need it. - my $query; - $query= "an=".$mergefrom; - my $oResult = $oConnection->search(new ZOOM::Query::CCL2RPN( $query, $oConnection )); - my $count = 0; - if ($oResult) { - $count=$oResult->size(); - } - my $z=0; - while ( $z<$count ) { - my $rec; - $rec=$oResult->record($z); - my $marcdata = $rec->raw(); - my $marcrecordzebra= MARC::Record->new_from_usmarc($marcdata); - my ( $biblionumbertagfield, $biblionumbertagsubfield ) = &GetMarcFromKohaField( "biblio.biblionumber", '' ); - my $i = ($biblionumbertagfield < 10) ? $marcrecordzebra->field($biblionumbertagfield)->data : $marcrecordzebra->subfield($biblionumbertagfield, $biblionumbertagsubfield); - my $marcrecorddb=GetMarcBiblio($i); - push @reccache, $marcrecorddb; - $z++; + } + else { + + #zebra connection + my ( $err, $res, $result ) = + C4::Search::SimpleSearch( "an=$mergefrom", 0, 999999 ); + my $z = 0; + foreach my $rawrecord (@$res) { + my $marcrecord = MARC::File::USMARC::decode($rawrecord); + SetUTF8Flag($marcrecord); + push @reccache, $marcrecord; } - $oResult->destroy(); } - #warn scalar(@reccache)." biblios to update"; - # Get All candidate Tags for the change + + # Get All candidate Tags for the change # (This will reduce the search scope in marc records). - $sth = $dbh->prepare("select distinct tagfield from marc_subfield_structure where authtypecode=?"); - $sth->execute($authtypecodefrom); + $sth = $dbh->prepare( +"select distinct tagfield from marc_subfield_structure where authtypecode<>''" + ); + $sth->execute(); my @tags_using_authtype; - while (my ($tagfield) = $sth->fetchrow) { - push @tags_using_authtype,$tagfield ; + while ( my ($tagfield) = $sth->fetchrow ) { + push @tags_using_authtype, $tagfield; } - my $tag_to=0; - if ($authtypecodeto ne $authtypecodefrom){ - # If many tags, take the first - $sth->execute($authtypecodeto); - $tag_to=$sth->fetchrow; - #warn $tag_to; - } - # BulkEdit marc records - # May be used as a template for a bulkedit field - foreach my $marcrecord(@reccache){ - my $update; - foreach my $tagfield (@tags_using_authtype){ -# warn "tagfield : $tagfield "; - foreach my $field ($marcrecord->field($tagfield)){ - # biblio is linked to authority with $9 subfield containing authid - my $auth_number=$field->subfield("9"); - my $tag=$field->tag(); - if ($auth_number==$mergefrom) { - my $field_to=MARC::Field->new(($tag_to?$tag_to:$tag),$field->indicator(1),$field->indicator(2),"9"=>$mergeto); - my $exclude='9'; - foreach my $subfield (grep {$_->[0] ne '9'} @record_to) { - $field_to->add_subfields($subfield->[0] =>$subfield->[1]); - $exclude.= $subfield->[0]; + my $tag_to = 0; + + # if any element in this list matchs exactly a subfield in the biblio field + # which is before the $9, the subfield is removed. + my @data_to_remove = map { $_->[1] } @record_from; + if ( uc( C4::Context->preference('marcflavour') ) eq "UNIMARC" ) { + + # If in UNIMARC, we also want to remove PPN if it's before $9 (it will + # be reinserted after) + foreach my $record ( $MARCto, $MARCfrom ) { + my $field = $record->field('009'); + if ( $field and ( my $data = $field->data() ) ) { + push @data_to_remove, $data; + } + } + } + + foreach my $marcrecord (@reccache) { + foreach my $tagfield (@tags_using_authtype) { + foreach my $field ( $marcrecord->field($tagfield) ) { + my $update; + my $tag = $field->tag(); + my @newsubfields; + my %indexes; + + #get to next field if no subfield + my @localsubfields = $field->subfields(); + my $index_9_auth = first_index { + ( $_->[0] eq 9 ) + and ( $_->[1] eq "$mergefrom" ); } - $exclude='['.$exclude.']'; -# add subfields in $field not included in @record_to - my @restore= grep {$_->[0]!~/$exclude/} $field->subfields(); - foreach my $subfield (@restore) { - $field_to->add_subfields($subfield->[0] =>$subfield->[1]); - } + @localsubfields; + next if ( $index_9_auth < 0 ); + + # Removes the data if before the $9 + my $index = 0; + for my $subf ( @localsubfields[ 0 .. $index_9_auth ] ) { + if ( any { $subf->[1] eq $_ } @data_to_remove ) { + $debug && warn "found $subf->[0] " . $subf->[1]; + splice @localsubfields, $index, 1; + $index_9_auth--; + } + else { + $index++; + } + } + + #Get the next $9 subfield + my $nextindex_9 = + first_index { $_->[0] =~ /[12456789]/ } + @localsubfields[ $index_9_auth + 1 .. $#localsubfields ]; + + #Change the first tag if required + # That is : change the first tag ($a) to what it is in the biblio record + # Since some composed authorities will place the $a into $x or $y + + my @previous_subfields = @localsubfields[ 0 .. $index_9_auth ]; + +# Changing the record_to first $a subfield code is quite a dangerous idea. +# But in order to clone the subfield structure and avoid the side effect affectation +# one would need to parse the whole subfield structure +# This would break performance a little more. + my $changesubfcode; + if ( + $changesubfcode = _process_subfcode_4_merge( + $tag, \@previous_subfields, + $MARCto, \@record_to, + $authtypecodeto + ) + ) + { + my $index_subf_a = + first_index { $_->[0] eq "a" } @record_to; + $record_to[$index_subf_a]->[0] = $changesubfcode + if defined($changesubfcode); + } + +# Replace in local subfields the subfields related to recordfrom with data from record_to + + my @localrecord_to = @record_to; + @localrecord_to = ( [ 9, $mergeto ], @localrecord_to ); + my $length = + ( $nextindex_9 > 0 ) + ? $nextindex_9 + 1 + : $#localsubfields - $#previous_subfields + 1; + splice( + @localsubfields, $index_9_auth, + $length, @localrecord_to + ); + + # very nice api for MARC::Record + # It seems that some elements localsubfields can be undefined so skip them + @newsubfields = + map { ( defined $_ ? @$_ : () ) } @localsubfields; + + #filter to subfields which are not in the subfield + my $field_to = MARC::Field->new( + ( $tag_to ? $tag_to : $tag ), $field->indicator(1), + $field->indicator(2), @newsubfields + ); $marcrecord->delete_field($field); - $marcrecord->insert_grouped_field($field_to); - $update=1; + $marcrecord->insert_fields_ordered($field_to); + + # if the first $a was change, restore it before next iteration + if ($changesubfcode) { + my $index_subf = + first_index { $_->[0] eq $changesubfcode } @record_to; + $record_to[$index_subf]->[0] = "a"; } - }#for each tag - }#foreach tagfield - my ($bibliotag,$bibliosubf) = GetMarcFromKohaField("biblio.biblionumber","") ; + } #for each tag + } #foreach tagfield + my ( $bibliotag, $bibliosubf ) = + GetMarcFromKohaField( "biblio.biblionumber", "" ); my $biblionumber; - if ($bibliotag<10){ - $biblionumber=$marcrecord->field($bibliotag)->data; + if ( $bibliotag < 10 ) { + $biblionumber = $marcrecord->field($bibliotag)->data; } else { - $biblionumber=$marcrecord->subfield($bibliotag,$bibliosubf); + $biblionumber = $marcrecord->subfield( $bibliotag, $bibliosubf ); } - unless ($biblionumber){ - warn "pas de numéro de notice bibliographique dans : ".$marcrecord->as_formatted; + unless ($biblionumber) { + warn "No biblionumber in : " + . $marcrecord->as_formatted; next; } - if ($update==1){ - &ModBiblio($marcrecord,$biblionumber,GetFrameworkCode($biblionumber)) ; - $counteditedbiblio++; - warn $counteditedbiblio if (($counteditedbiblio % 10) and $ENV{DEBUG}); - } - }#foreach $marc - return $counteditedbiblio; - # now, find every other authority linked with this authority - # now, find every other authority linked with this authority -# my $oConnection=C4::Context->Zconn("authorityserver"); -# my $query; -# # att 9210 Auth-Internal-authtype -# # att 9220 Auth-Internal-LN -# # ccl.properties to add for authorities -# $query= "= ".$mergefrom; -# my $oResult = $oConnection->search(new ZOOM::Query::CCL2RPN( $query, $oConnection )); -# my $count=$oResult->size() if ($oResult); -# my @reccache; -# my $z=0; -# while ( $z<$count ) { -# my $rec; -# $rec=$oResult->record($z); -# my $marcdata = $rec->raw(); -# push @reccache, $marcdata; -# $z++; -# } -# $oResult->destroy(); -# foreach my $marc(@reccache){ -# my $update; -# my $marcrecord; -# $marcrecord = MARC::File::USMARC::decode($marc); -# foreach my $tagfield (@tags_using_authtype){ -# $tagfield=substr($tagfield,0,3); -# my @tags = $marcrecord->field($tagfield); -# foreach my $tag (@tags){ -# my $tagsubs=$tag->subfield("9"); -# #warn "$tagfield:$tagsubs:$mergefrom"; -# if ($tagsubs== $mergefrom) { -# $tag->update("9" =>$mergeto); -# foreach my $subfield (@record_to) { -# # warn "$subfield,$subfield->[0],$subfield->[1]"; -# $tag->update($subfield->[0] =>$subfield->[1]); -# }#for $subfield -# } -# $marcrecord->delete_field($tag); -# $marcrecord->add_fields($tag); -# $update=1; -# }#for each tag -# }#foreach tagfield -# my $authoritynumber = TransformMarcToKoha($dbh,$marcrecord,"") ; -# if ($update==1){ -# &ModAuthority($marcrecord,$authoritynumber,GetAuthTypeCode($authoritynumber)) ; -# } -# -# }#foreach $marc -}#sub + my $mod_ok = + &ModBiblio( $marcrecord, $biblionumber, + GetFrameworkCode($biblionumber) ); + push @editedbiblios, $biblionumber if $mod_ok; + } #foreach $marc + DelAuthority($mergefrom) if ( $mergefrom != $mergeto ); + return @editedbiblios; +} #sub =head2 get_auth_type_location --- a/C4/Charset.pm +++ a/C4/Charset.pm @@ -40,6 +40,7 @@ BEGIN { SetMarcUnicodeFlag StripNonXmlChars nsb_clean + SanitizeEntity ); } @@ -188,6 +189,7 @@ sub NormalizeString{ return $string; } + =head2 MarcToUTF8Record ($marc_record, $converted_from, $errors_arrayref) = MarcToUTF8Record($marc_blob, @@ -1158,6 +1160,49 @@ sub char_decode5426 { return $result; } +=head2 SanitizeEntity + + my $utf8string = SanitizeEntity($record); + +Removes & from records (since zebra is adding multiple &s + +=cut + +sub SanitizeEntity { + my $record = shift; + + foreach my $field ($record->fields()) { + if ($field->is_control_field()) { + $field->update(entity_clean($field->data())); + } else { + my @subfields = $field->subfields(); + my @new_subfields; + foreach my $subfield (@subfields) { + push @new_subfields, $subfield->[0] => entity_clean($subfield->[1]); + } + if (scalar(@new_subfields) > 0) { + my $new_field; + eval { + $new_field = MARC::Field->new($field->tag(), $field->indicator(1), $field->indicator(2), @new_subfields); + }; + if ($@) { + warn "error : $@"; + } else { + $field->replace_with($new_field); + } + + } + } + } + return $record; +} + +sub entity_clean { + my $string=shift; + $string=~s/(&)(amp;)+/$1/g; + return $string; +} + 1; --- a/installer/data/mysql/kohastructure.sql +++ a/installer/data/mysql/kohastructure.sql @@ -1358,6 +1358,7 @@ DROP TABLE IF EXISTS `need_merge_authorities`; CREATE TABLE `need_merge_authorities` ( -- keeping track of authority records still to be merged by merge_authority cron job (used only if pref dontmerge is ON) `id` int NOT NULL auto_increment PRIMARY KEY, -- unique id `authid` bigint NOT NULL, -- reference to authority record + `init_value` longtext DEFAULT NULL, -- previous value of the record (required when 'merging') `done` tinyint DEFAULT 0 -- indication whether merge has been executed (0=not done, 1= done, 2= in progress) ) ENGINE=InnoDB DEFAULT CHARSET=utf8; --- a/installer/data/mysql/updatedatabase.pl +++ a/installer/data/mysql/updatedatabase.pl @@ -6411,6 +6411,16 @@ if ( C4::Context->preference("Version") < TransformToNum($DBversion) ) { SetVersion($DBversion); } +$DBversion = "XXX.XX.XX.XXX"; +if ( C4::Context->preference("Version") < TransformToNum($DBversion) ) { + $dbh->do(qq{ + ALTER TABLE need_merge_authorities ADD COLUMN init_value LONGTEXT DEFAULT NULL AFTER authid; + }); + + print "Upgrade to $DBversion done (Bug 8304: Support For Rameau merge fixing)\n"; + SetVersion($DBversion); +} + =head1 FUNCTIONS =head2 TableExists($table) --- a/installer/data/mysql/versions/bug_8304.sql +++ a/installer/data/mysql/versions/bug_8304.sql @@ -0,0 +1,7 @@ +-- Bug 8304: Support For Rameau merge fixing +-- +-- This patch adds a new column to need_merge_authorities storing the previous version of +-- edited authority in order to be able to delete the values of the heading reported in +-- the biblio record when merging. + +ALTER TABLE need_merge_authorities ADD COLUMN init_value LONGTEXT DEFAULT NULL AFTER authid; --- a/misc/migration_tools/bulkmarcimport.pl +++ a/misc/migration_tools/bulkmarcimport.pl @@ -24,15 +24,19 @@ use C4::Koha; use C4::Debug; use C4::Charset; use C4::Items; +use YAML; use Unicode::Normalize; use Time::HiRes qw(gettimeofday); use Getopt::Long; use IO::File; use Pod::Usage; -binmode STDOUT, ':encoding(UTF-8)'; +use open qw( :std :utf8 ); +binmode( STDOUT, ":utf8" ); 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 ( $insert, $filters, $update, $all, $yamlfile, $authtypes ); my $cleanisbn = 1; my ($sourcetag,$sourcesubfield,$idmapfl, $dedup_barcode); my $framework = ''; @@ -46,7 +50,7 @@ GetOptions( 'o|offset:f' => \$offset, 'h' => \$version, 'd' => \$delete, - 't' => \$test_parameter, + 't|test' => \$test_parameter, 's' => \$skip_marc8_conversion, 'c:s' => \$char_encoding, 'v:s' => \$verbose, @@ -56,6 +60,11 @@ GetOptions( 'k|keepids:s' => \$keepids, 'b|biblios' => \$biblios, 'a|authorities' => \$authorities, + 'authtypes:s' => \$authtypes, + 'filter=s@' => \$filters, + 'insert' => \$insert, + 'update' => \$update, + 'all' => \$all, 'match=s@' => \$match, 'i|isbn' => \$isbn_check, 'x:s' => \$sourcetag, @@ -64,14 +73,23 @@ GetOptions( 'cleanisbn!' => \$cleanisbn, 'dedupbarcode' => \$dedup_barcode, 'framework=s' => \$framework, + 'yaml:s' => \$yamlfile, ); -$biblios=!$authorities||$biblios; +$biblios ||= !$authorities; +$insert ||= !$update; + +if ($all) { + $insert = 1; + $update = 1; +} if ($version || ($input_marc_file eq '')) { pod2usage( -verbose => 2 ); exit; } +my $heading_fields=get_heading_fields(); + if (defined $idmapfl) { open(IDMAP,">$idmapfl") or die "cannot open $idmapfl \n"; } @@ -142,7 +160,7 @@ $batch->warnings_off(); $batch->strict_off(); my $i=0; my $commitnum = $commit ? $commit : 50; - +my $yamlhash; # Skip file offset if ( $offset ) { @@ -199,6 +217,7 @@ RECORD: while ( ) { next RECORD; } } + SetUTF8Flag($record); my $isbn; # remove trailing - in isbn (only for biblios, of course) if ($biblios && $cleanisbn) { @@ -212,45 +231,77 @@ RECORD: while ( ) { } my $id; # search for duplicates (based on Local-number) - if ($match){ - require C4::Search; - my $query=build_query($match,$record); - my $server=($authorities?'authorityserver':'biblioserver'); - my ($error, $results,$totalhits)=C4::Search::SimpleSearch( $query, 0, 3, [$server] ); - die "unable to search the database for duplicates : $error" if (defined $error); - #warn "$query $server : $totalhits"; - if ( @{$results} == 1 ){ - my $marcrecord = MARC::File::USMARC::decode($results->[0]); - $id=GetRecordId($marcrecord,$tagid,$subfieldid); - } - elsif ( @{$results} > 1){ - $debug && warn "more than one match for $query"; - } - else { - $debug && warn "nomatch for $query"; - } + my $originalid; + $originalid = GetRecordId( $record, $tagid, $subfieldid ); + if ($match) { + require C4::Search; + my $query = build_query( $match, $record ); + my $server = ( $authorities ? 'authorityserver' : 'biblioserver' ); + $debug && warn $query; + my ( $error, $results, $totalhits ) = C4::Search::SimpleSearch( $query, 0, 3, [$server] ); + die "unable to search the database for duplicates : $error" if ( defined $error ); + $debug && warn "$query $server : $totalhits"; + if ( $results && scalar(@$results) == 1 ) { + my $marcrecord = MARC::File::USMARC::decode( $results->[0] ); + SetUTF8Flag($marcrecord); + $id = GetRecordId( $marcrecord, $tagid, $subfieldid ); + if ( $authorities && $marcFlavour ) { + #Skip if authority in database is the same as the on in database + if ( $marcrecord->field('005')->data >= $record->field('005')->data ) { + if ($yamlfile) { + $yamlhash->{$originalid}->{'authid'} = $id; + + # On récupère tous les souschamps des champs vedettes d'autorités + my @subfields; + foreach my $field ( $marcrecord->field("2..") ) { + push @subfields, map { ( $_->[0] =~ /[a-z]/ ? $_->[1] : () ) } $field->subfields(); + } + $yamlhash->{$originalid}->{'subfields'} = \@subfields; + } + next; + } + } + } elsif ( $results && scalar(@$results) > 1 ) { + $debug && warn "more than one match for $query"; + } else { + $debug && warn "nomatch for $query"; + } } - my $originalid; - if ($keepids){ - $originalid=GetRecordId($record,$tagid,$subfieldid); - if ($originalid){ - my $storeidfield; - if (length($keepids)==3){ - $storeidfield=MARC::Field->new($keepids,$originalid); - } - else { - $storeidfield=MARC::Field->new(substr($keepids,0,3),"","",substr($keepids,3,1),$originalid); - } - $record->insert_fields_ordered($storeidfield); - $record->delete_field($record->field($tagid)); - } + if ($keepids && $originalid) { + my $storeidfield; + if ( length($keepids) == 3 ) { + $storeidfield = MARC::Field->new( $keepids, $originalid ); + } else { + $storeidfield = MARC::Field->new( substr( $keepids, 0, 3 ), "", "", substr( $keepids, 3, 1 ), $originalid ); + } + $record->insert_fields_ordered($storeidfield); + $record->delete_field( $record->field($tagid) ); } + foreach my $stringfilter (@$filters) { + if ( length($stringfilter) == 3 ) { + foreach my $field ( $record->field($stringfilter) ) { + $record->delete_field($field); + $debug && warn "removed : ", $field->as_string; + } + } else { + my ( $removetag, $removesubfield, $removematch ) = ( $1, $2, $3 ) + if $stringfilter =~ /([0-9]{3})([a-z0-9])(.*)/; + if ( ( $removetag > "010" ) && $removesubfield ) { + foreach my $field ( $record->field($removetag) ) { + $field->delete_subfield( code => "$removesubfield", match => $removematch ); + $debug && warn "Potentially removed : ", $field->subfield($removesubfield); + } + } + } + } + unless ($test_parameter) { if ($authorities){ use C4::AuthoritiesMarc; - my $authtypecode=GuessAuthTypeCode($record); + my $authtypecode=GuessAuthTypeCode($record, $heading_fields); + $authtypecode//='SNC'; my $authid= ($id?$id:GuessAuthId($record)); - if ($authid && GetAuthority($authid)){ + if ($authid && GetAuthority($authid) && $update ){ ## Authority has an id and is in database : Replace eval { ( $authid ) = ModAuthority($authid,$record, $authtypecode) }; if ($@){ @@ -283,6 +334,14 @@ RECORD: while ( ) { printlog({id=>$originalid||$id||$authid, op=>"insert",status=>"ok"}) if ($logfile); } } + if ($yamlfile) { + $yamlhash->{$originalid}->{'authid'} = $authid; + my @subfields; + foreach my $field ( $record->field("2..") ) { + push @subfields, map { ( $_->[0] =~ /[a-z]/ ? $_->[1] : () ) } $field->subfields(); + } + $yamlhash->{$originalid}->{'subfields'} = \@subfields; + } } else { my ( $biblionumber, $biblioitemnumber, $itemnumbers_ref, $errors_ref ); @@ -306,20 +365,33 @@ RECORD: while ( ) { } # create biblio, unless we already have it ( either match or isbn ) if ($biblionumber) { - eval{$biblioitemnumber=GetBiblioData($biblionumber)->{biblioitemnumber};} - } - else - { - eval { ( $biblionumber, $biblioitemnumber ) = AddBiblio($record, $framework, { defer_marc_save => 1 }) }; + eval{$biblioitemnumber=GetBiblioData($biblionumber)->{biblioitemnumber};}; + if ($update) { + eval { ( $biblionumber, $biblioitemnumber ) = ModBiblio( $record, $biblionumber, GetFrameworkcode($biblionumber) ) }; + if ($@) { + warn "ERROR: Edit biblio $biblionumber failed: $@\n"; + printlog( { id => $id || $originalid || $biblionumber, op => "update", status => "ERROR" } ) if ($logfile); + next RECORD; + } else { + printlog( { id => $id || $originalid || $biblionumber, op => "update", status => "ok" } ) if ($logfile); + } + } else { + printlog( { id => $id || $originalid || $biblionumber, op => "insert", status => "warning : already in database" } ) if ($logfile); + } + } else { + if ($insert) { + eval { ( $biblionumber, $biblioitemnumber ) = AddBiblio( $record, '', { defer_marc_save => 1 } ) }; + if ($@) { + warn "ERROR: Adding biblio $biblionumber failed: $@\n"; + printlog( { id => $id || $originalid || $biblionumber, op => "insert", status => "ERROR" } ) if ($logfile); + next RECORD; + } else { + printlog( { id => $id || $originalid || $biblionumber, op => "insert", status => "ok" } ) if ($logfile); + } + } else { + printlog( { id => $id || $originalid || $biblionumber, op => "update", status => "warning : not in database" } ) if ($logfile); + } } - if ( $@ ) { - warn "ERROR: Adding biblio $biblionumber failed: $@\n"; - printlog({id=>$id||$originalid||$biblionumber, op=>"insert",status=>"ERROR"}) if ($logfile); - next RECORD; - } - else{ - printlog({id=>$id||$originalid||$biblionumber, op=>"insert",status=>"ok"}) if ($logfile); - } eval { ( $itemnumbers_ref, $errors_ref ) = AddItemBatchFromMarc( $record, $biblionumber, $biblioitemnumber, '' ); }; my $error_adding = $@; # Work on a clone so that if there are real errors, we can maybe @@ -384,6 +456,7 @@ RECORD: while ( ) { if ($#{ $errors_ref } > -1) { report_item_errors($biblionumber, $errors_ref); } + $yamlhash->{$originalid} = $biblionumber if ($yamlfile); } $dbh->commit() if (0 == $i % $commitnum); } @@ -407,6 +480,10 @@ if ($logfile){ print $loghandle "$i MARC records done in $timeneeded seconds\n"; $loghandle->close; } +if ($yamlfile) { + open YAML, "> $yamlfile" or die "cannot open $yamlfile \n"; + print YAML Dump($yamlhash); +} exit 0; sub GetRecordId{ @@ -462,9 +539,22 @@ sub report_item_errors { } sub printlog{ my $logelements=shift; - print $loghandle join (";",@$logelements{qw}),"\n"; + print $loghandle join( ";", map { defined $_ ? $_ : "" } @$logelements{qw} ), "\n"; } +sub get_heading_fields{ + my $headingfields; + if ($authtypes){ + $headingfields=YAML::LoadFile($authtypes); + $headingfields={C4::Context->preference('marcflavour')=>$headingfields}; + $debug && warn YAML::Dump($headingfields); + } + unless ($headingfields){ + $headingfields=C4::Context->dbh->selectall_hashref("SELECT auth_tag_to_report, authtypecode from auth_types where auth_tag_to_report <>'' or auth_tag_to_report IS NOT NULL",'auth_tag_to_report',{Slice=>{}}); + $headingfields={C4::Context->preference('marcflavour')=>$headingfields}; + } + return $headingfields; +} =head1 NAME @@ -526,7 +616,7 @@ The I of records to wait before performing a 'commit' operation File logs actions done for each record and their status into file -=item B<-t> +=item B<-t, -test> Test mode: parses the file, saying what he would do, but doing nothing. @@ -549,6 +639,30 @@ biblioitems, items Input file I: I or I (defaults to ISO2709) +=item B<-authtypes> + +file yamlfile with authoritiesTypes and distinguishable record field in order +to store the correct authtype + +=item B<-yaml> + +yaml file format a yaml file with ids +keepids field store ids in field (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 + +=item B<-insert> + +if set, only insert when possible + +=item B<-update> + +if set, only updates (any biblio should have a matching record) + +=item B<-all> + +if set, do whatever is required + =item B<-k, -keepids>= Field store ids in I (usefull for authorities, where 001 contains the --- a/misc/migration_tools/merge_authority.pl +++ a/misc/migration_tools/merge_authority.pl @@ -77,19 +77,21 @@ print "Merging\n" unless $noconfirm; if ($batch) { my $authref; $dbh->do("update need_merge_authorities set done=2 where done=0"); #temporary status 2 means: selected for merge - $authref=$dbh->selectall_arrayref("select distinct authid from need_merge_authorities where done=2"); + $authref=$dbh->selectall_arrayref("select distinct authid, init_value from need_merge_authorities where done=2"); foreach(@$authref) { my $authid=$_->[0]; + my $value_init=$_->[1]; + my $MARCinit=eval{MARC::Record->new_from_xml($value_init, "utf-8",authorityflavour())} if defined $value_init; + # if no valid xml record, then we may use MARCauth (the way it was before) + $MARCinit//=$MARCauth; print "managing $authid\n" if $verbose; my $MARCauth = GetAuthority($authid) ; next unless ($MARCauth); - merge($authid,$MARCauth,$authid,$MARCauth) if ($MARCauth); + merge($authid,$MARCinit,$authid,$MARCauth) if ($MARCauth); } $dbh->do("update need_merge_authorities set done=1 where done=2"); #DONE } else { - my $MARCfrom = GetAuthority($mergefrom); - my $MARCto = GetAuthority($mergeto); - &merge($mergefrom,$MARCfrom,$mergeto,$MARCto); + &merge($mergefrom,$authfrom,$mergeto,$authto); #Could add mergefrom authority to mergeto rejected forms before deletion DelAuthority($mergefrom) if ($mergefrom != $mergeto); } --