From cee5263655620ba458440a3ecdbee0a789bed3d3 Mon Sep 17 00:00:00 2001 From: Henri-Damien LAURENT Date: Tue, 7 Feb 2012 17:24:04 +0100 Subject: [PATCH] Bug 8304 : composed authorities Rameau management Bug 5635: bulkmarcimport new parameters & features This patch is designed to manage the composed authorities the Way Rameau is coping with them in France. This enables libraries to merge composed authorities and only change the heading field. It supposes that the previous data is sent to merge function so that process deletes previous heading entries. Say you have in a biblio record : - 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 And you change authority 1210 -250 $a Politiciens into -250 $a Politique You should get : - 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 In an other record : - 606 $9 1210 $3 199 $a Politiciens You should get : - 606 $9 1210 $3 199 $a Politique This patch changes the merge function. And adds three internal functions. merge function has been prettyfied And documentation from GuessAuthTypeCode has been updated (had not been) Signed-off-by: Pierre Angot --- 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 diff --git a/C4/AuthoritiesMarc.pm b/C4/AuthoritiesMarc.pm index 4a3392f..e25965b 100644 --- a/C4/AuthoritiesMarc.pm +++ b/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 diff --git a/C4/Charset.pm b/C4/Charset.pm index c294b36..cf33def 100644 --- a/C4/Charset.pm +++ b/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; diff --git a/installer/data/mysql/kohastructure.sql b/installer/data/mysql/kohastructure.sql index ed673da..35b8995 100644 --- a/installer/data/mysql/kohastructure.sql +++ b/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; diff --git a/installer/data/mysql/updatedatabase.pl b/installer/data/mysql/updatedatabase.pl index e703296..6ded653 100755 --- a/installer/data/mysql/updatedatabase.pl +++ b/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) diff --git a/installer/data/mysql/versions/bug_8304.sql b/installer/data/mysql/versions/bug_8304.sql new file mode 100644 index 0000000..d3383f8 --- /dev/null +++ b/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; diff --git a/misc/migration_tools/bulkmarcimport.pl b/misc/migration_tools/bulkmarcimport.pl index e0f905c..b35774e 100755 --- a/misc/migration_tools/bulkmarcimport.pl +++ b/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 diff --git a/misc/migration_tools/merge_authority.pl b/misc/migration_tools/merge_authority.pl index 8e09594..a5cf103 100755 --- a/misc/migration_tools/merge_authority.pl +++ b/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); } -- 1.7.2.5