X-Git-Url: http://git.rot13.org/?a=blobdiff_plain;f=C4%2FAuthoritiesMarc.pm;h=72d0992199650ad444a68b53b486b507a0ccc86b;hb=f64ab9ecf3de12a1ee14837cb576e06e530765e2;hp=c99d332c56e902053f6c914a14324807731bbb98;hpb=b549d7e1f1b7d518e16fa48af7360a38e8233fec;p=koha.git diff --git a/C4/AuthoritiesMarc.pm b/C4/AuthoritiesMarc.pm index c99d332c56..72d0992199 100644 --- a/C4/AuthoritiesMarc.pm +++ b/C4/AuthoritiesMarc.pm @@ -25,6 +25,7 @@ use C4::Search; use C4::AuthoritiesMarc::MARC21; use C4::AuthoritiesMarc::UNIMARC; use C4::Charset; +use C4::Debug; use vars qw($VERSION @ISA @EXPORT); @@ -118,10 +119,8 @@ sub SearchAuthorities { for(my $i = 0 ; $i <= $#{$value} ; $i++) { if (@$value[$i]){ - if (@$tags[$i] eq "mainmainentry") { - $query .=" AND mainmainentry"; - }elsif (@$tags[$i] eq "mainentry") { - $query .=" AND mainentry"; + if (@$tags[$i] =~/mainentry|mainmainentry/) { + $query .= qq( AND @$tags[$i] ); } else { $query .=" AND "; } @@ -206,8 +205,9 @@ sub SearchAuthorities { my $n=0; my @authtypecode; my @auths=split / /,$authtypecode ; + my @queries; foreach my $auth (@auths){ - $query .=" \@attr 1=authtype \@attr 5=100 ".$auth; ##No truncation on authtype + push @queries, " \@attr 1=authtype \@attr 5=100 ".$auth; ##No truncation on authtype push @authtypecode ,$auth; $n++; } @@ -216,14 +216,16 @@ sub SearchAuthorities { } my $dosearch; - my $and; - my $q2; + my $and=" \@and " ; for(my $i = 0 ; $i <= $#{$value} ; $i++) { if (@$value[$i]){ ##If mainentry search $a tag if (@$tags[$i] eq "mainmainentry") { - $attr =" \@attr 1=Heading "; + + $attr =" \@attr 1=Heading-Main "; +# $attr =" \@attr 1=Heading "; + }elsif (@$tags[$i] eq "mainentry") { $attr =" \@attr 1=Heading "; }else{ @@ -234,26 +236,31 @@ sub SearchAuthorities { }elsif (@$operator[$i] eq "="){ $attr.=" \@attr 4=107 "; #Number Exact match }elsif (@$operator[$i] eq "start"){ - $attr.=" \@attr 4=1 \@attr 5=1 ";#Phrase, Right truncated + $attr.=" \@attr 3=2 \@attr 4=1 \@attr 5=1 ";#Firstinfield Phrase, Right truncated } else { $attr .=" \@attr 5=1 \@attr 4=6 ";## Word list, right truncated, anywhere } - $and .=" \@and " ; $attr =$attr."\"".@$value[$i]."\""; - $q2 .=$attr; + push @queries, "$attr"; $dosearch=1; }#if value } ##Add how many queries generated - if ($query=~/\S+/){ - $query= $and.$query.$q2 - } else { - $query=$q2; - } + my $query; + foreach my $query_part (@queries){ + $query=($query?$and.$query_part.$query:$query_part); + } ## Adding order #$query=' @or @attr 7=2 @attr 1=Heading 0 @or @attr 7=1 @attr 1=Heading 1'.$query if ($sortby eq "HeadingDsc"); - $query=' @or @attr 7=1 @attr 1=Heading 0'.$query if ($sortby eq "HeadingAsc"); - $query=' @or @attr 7=2 @attr 1=Heading 0'.$query if ($sortby eq "HeadingDsc"); + my $orderstring= ($sortby eq "HeadingAsc"? + '@attr 7=1 @attr 1=Heading 0' + : + $sortby eq "HeadingDsc"? + '@attr 7=2 @attr 1=Heading 0' + :'' + ); + $query=($dosearch?"\@or $orderstring $query":"\@or ".($query?"$and $query":"")." \@attr 1=_ALLRECORDS \@attr 2=103 '' $orderstring "); + $debug && warn $query; $offset=0 unless $offset; my $counter = $offset; @@ -398,7 +405,7 @@ sub GetAuthTypeCode { my $dbh=C4::Context->dbh; my $sth = $dbh->prepare("select authtypecode from auth_header where authid=?"); $sth->execute($authid); - my ($authtypecode) = $sth->fetchrow; + my $authtypecode = $sth->fetchrow; return $authtypecode; } @@ -516,11 +523,43 @@ sub AddAuthority { # pass the MARC::Record to this function, and it will create the records in the authority table my ($record,$authid,$authtypecode) = @_; my $dbh=C4::Context->dbh; - my $leader=' a ';##Fixme correct leader as this one just adds utf8 to MARC21 + my $leader=' nz a22 o 4500';#Leader for incomplete MARC21 record # if authid empty => true add, find a new authid number my $format= 'UNIMARCAUTH' if (uc(C4::Context->preference('marcflavour')) eq 'UNIMARC'); $format= 'MARC21' if (uc(C4::Context->preference('marcflavour')) ne 'UNIMARC'); + + if ($format eq "MARC21") { + if (!$record->leader) { + $record->leader($leader); + } + if (!$record->field('003')) { + $record->insert_fields_ordered( + MARC::Field->new('003',C4::Context->preference('MARCOrgCode')) + ); + } + my $time=POSIX::strftime("%Y%m%d%H%M%S",localtime); + if (!$record->field('005')) { + $record->insert_fields_ordered( + MARC::Field->new('005',$time.".0") + ); + } + my $date=POSIX::strftime("%y%m%d",localtime); + if (!$record->field('008')) { + $record->insert_fields_ordered( + MARC::Field->new('008',$date."|||a|||||| | ||| d") + ); + } + if (!$record->field('040')) { + $record->insert_fields_ordered( + MARC::Field->new('040','','', + 'a' => C4::Context->preference('MARCOrgCode'), + 'c' => C4::Context->preference('MARCOrgCode') + ) + ); + } + } + if (($format eq "UNIMARCAUTH") && (!$record->subfield('100','a'))){ $record->leader(" nx j22 "); my $date=POSIX::strftime("%Y%m%d",localtime); @@ -532,18 +571,21 @@ sub AddAuthority { ,'a'=>$date."afrey50 ba0") ); } - } - + } my ($auth_type_tag, $auth_type_subfield) = get_auth_type_location($authtypecode); if (!$authid and $format 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); } - - unless ($record->field($auth_type_tag) && $record->subfield($auth_type_tag, $auth_type_subfield)) { + if (my $field=$record->field($auth_type_tag)){ + $field->update($auth_type_subfield=>$authtypecode); + } + else { $record->add_fields($auth_type_tag,'','', $auth_type_subfield=>$authtypecode); } + my $auth_exists=0; + my $oldRecord; if (!$authid) { my $sth=$dbh->prepare("select max(authid) from auth_header"); $sth->execute; @@ -554,20 +596,24 @@ sub AddAuthority { $record->delete_field($record->field('001')); $record->insert_fields_ordered(MARC::Field->new('001',$authid)); } -# warn $record->as_formatted; - $dbh->do("lock tables auth_header WRITE"); - $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->finish; - }else{ + } else { + $auth_exists=$dbh->do(qq(select authid from auth_header where authid=?),undef,$authid); +# warn "auth_exists = $auth_exists"; + } + if ($auth_exists>0){ + $oldRecord=GetAuthority($authid); $record->add_fields('001',$authid) unless ($record->field('001')); - $dbh->do("lock tables auth_header WRITE"); - my $sth=$dbh->prepare("update auth_header set marc=?,marcxml=? where authid=?"); - $sth->execute($record->as_usmarc,$record->as_xml_record($format),$authid); +# 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->finish; } - $dbh->do("unlock tables"); - ModZebra($authid,'specialUpdate',"authorityserver",$record); + 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->finish; + } + ModZebra($authid,'specialUpdate',"authorityserver",$oldRecord,$record); return ($authid); } @@ -588,7 +634,7 @@ sub DelAuthority { my ($authid) = @_; my $dbh=C4::Context->dbh; - ModZebra($authid,"recordDelete","authorityserver",GetAuthority($authid)); + ModZebra($authid,"recordDelete","authorityserver",GetAuthority($authid),undef); $dbh->do("delete from auth_header where authid=$authid") ; } @@ -596,18 +642,16 @@ sub DelAuthority { sub ModAuthority { my ($authid,$record,$authtypecode,$merge)=@_; my $dbh=C4::Context->dbh; -# my ($oldrecord)=&GetAuthority($authid); -# if ($oldrecord eq $record) { -# return; -# } -# my $sth=$dbh->prepare("update auth_header set marc=?,marcxml=? where authid=?"); #Now rewrite the $record to table with an add + my $oldrecord=GetAuthority($authid); $authid=AddAuthority($record,$authid,$authtypecode); ### If a library thinks that updating all biblios is a long process and wishes to leave that to a cron job to use merge_authotities.p ### they should have a system preference "dontmerge=1" otherwise by default biblios will be updated ### the $merge flag is now depreceated and will be removed at code cleaning - if (C4::Context->preference('dontmerge') ){ + if (C4::Context->preference('MergeAuthoritiesOnUpdate') ){ + &merge($authid,$oldrecord,$authid,$record); + } else { # save the file in tmp/modified_authorities my $cgidir = C4::Context->intranetdir ."/cgi-bin"; unless (opendir(DIR,"$cgidir")) { @@ -619,8 +663,6 @@ sub ModAuthority { open AUTH, "> $filename"; print AUTH $authid; close AUTH; - } else { -# &merge($authid,$record,$authid,$record); } return $authid; } @@ -639,23 +681,22 @@ returns xml form of record $authid sub GetAuthorityXML { # Returns MARC::XML of the authority passed in parameter. my ( $authid ) = @_; - my $format= 'UNIMARCAUTH' if (uc(C4::Context->preference('marcflavour')) eq 'UNIMARC'); - $format= 'MARC21' if (uc(C4::Context->preference('marcflavour')) ne 'UNIMARC'); - if ($format eq "MARC21") { - # for MARC21, call GetAuthority instead of - # getting the XML directly since we may - # need to fix up the location of the authority - # code -- note that this is reasonably safe - # because GetAuthorityXML is used only by the - # indexing processes like zebraqueue_start.pl - my $record = GetAuthority($authid); - return $record->as_xml_record($format); - } else { - my $dbh=C4::Context->dbh; - my $sth = $dbh->prepare("select marcxml from auth_header where authid=? " ); - $sth->execute($authid); - my ($marcxml)=$sth->fetchrow; - return $marcxml; + if (uc(C4::Context->preference('marcflavour')) eq 'UNIMARC') { + my $dbh=C4::Context->dbh; + my $sth = $dbh->prepare("select marcxml from auth_header where authid=? " ); + $sth->execute($authid); + my ($marcxml)=$sth->fetchrow; + return $marcxml; + } + else { + # for MARC21, call GetAuthority instead of + # getting the XML directly since we may + # need to fix up the location of the authority + # code -- note that this is reasonably safe + # because GetAuthorityXML is used only by the + # indexing processes like zebraqueue_start.pl + my $record = GetAuthority($authid); + return $record->as_xml_record('MARC21'); } } @@ -676,8 +717,9 @@ sub GetAuthority { my $sth=$dbh->prepare("select authtypecode, marcxml from auth_header where authid=?"); $sth->execute($authid); my ($authtypecode, $marcxml) = $sth->fetchrow; - my $record=MARC::Record->new_from_xml(StripNonXmlChars($marcxml),'UTF-8', - (C4::Context->preference("marcflavour") eq "UNIMARC"?"UNIMARCAUTH":C4::Context->preference("marcflavour"))); + my $record=eval {MARC::Record->new_from_xml(StripNonXmlChars($marcxml),'UTF-8', + (C4::Context->preference("marcflavour") eq "UNIMARC"?"UNIMARCAUTH":C4::Context->preference("marcflavour")))}; + return undef if ($@); $record->encoding('UTF-8'); if (C4::Context->preference("marcflavour") eq "MARC21") { my ($auth_type_tag, $auth_type_subfield) = get_auth_type_location($authtypecode); @@ -690,14 +732,14 @@ sub GetAuthority { =over 4 -$result= &GetAuthType( $authtypecode) -If $authtypecode is not "" then - Returns hashref to authtypecode information -else - returns ref to array of hashref information of all Authtypes +$result = &GetAuthType($authtypecode) =back +If the authority type specified by C<$authtypecode> exists, +returns a hashref of the type's fields. If the type +does not exist, returns undef. + =cut sub GetAuthType { @@ -705,19 +747,14 @@ sub GetAuthType { my $dbh=C4::Context->dbh; my $sth; if (defined $authtypecode){ # NOTE - in MARC21 framework, '' is a valid authority - # type - $sth=$dbh->prepare("select * from auth_types where authtypecode=?"); - $sth->execute($authtypecode); - } else { - $sth=$dbh->prepare("select * from auth_types"); - $sth->execute; - } - my $res=$sth->fetchall_arrayref({}); - if (scalar(@$res)==1){ - return $res->[0]; - } else { - return $res; + # type (FIXME but why?) + $sth=$dbh->prepare("select * from auth_types where authtypecode=?"); + $sth->execute($authtypecode); + if (my $res = $sth->fetchrow_hashref) { + return $res; + } } + return; } @@ -794,8 +831,13 @@ sub FindDuplicateAuthority { # warn "record :".$record->as_formatted." auth_tag_to_report :$auth_tag_to_report"; # build a request for SearchAuthorities my $query='at='.$authtypecode.' '; - map {$query.= " and he=\"".$_->[1]."\"" if ($_->[0]=~/[A-z]/)} $record->field($auth_tag_to_report)->subfields() if $record->field($auth_tag_to_report); - my ($error,$results)=SimpleSearch($query,"authorityserver"); + my $filtervalues=qr([\001-\040\!\'\"\`\#\$\%\&\*\+,\-\./:;<=>\?\@\(\)\{\[\]\}_\|\~]); + if ($record->field($auth_tag_to_report)) { + foreach ($record->field($auth_tag_to_report)->subfields()) { + $_->[1]=~s/$filtervalues/ /g; $query.= " and he,wrdl=\"".$_->[1]."\"" if ($_->[0]=~/[A-z]/); + } + } + my ($error, $results, $total_hits)=SimpleSearch( $query, 0, 1, [ "authorityserver" ] ); # there is at least 1 result => return the 1st one if (@$results>0) { my $marcrecord = MARC::File::USMARC::decode($results->[0]); @@ -899,8 +941,10 @@ sub BuildSummary{ $notes.= ''.$field->subfield('a')."\n"; } foreach my $field ($record->field('4..')) { - my $thesaurus = "thes. : ".$thesaurus{"$field->subfield('2')"}." : " if ($field->subfield('2')); - $see.= ''.$thesaurus.$field->subfield('a')." -- \n"; + if ($field->subfield('2')) { + my $thesaurus = "thes. : ".$thesaurus{"$field->subfield('2')"}." : "; + $see.= ''.$thesaurus.$field->subfield('a')." -- \n"; + } } # see : foreach my $field ($record->field('5..')) { @@ -1064,7 +1108,7 @@ sub BuildUnimarcHierarchy{ my $record = shift @_; my $class = shift @_; my $authid_constructed = shift @_; - my $authid=$record->subfield('250','3'); + my $authid=$record->subfield('2..','3'); my %cell; my $parents=""; my $children=""; my (@loopparents,@loopchildren); @@ -1085,7 +1129,7 @@ sub BuildUnimarcHierarchy{ $cell{"class"}=$class; $cell{"loopauthid"}=$authid; $cell{"current_value"} =1 if $authid eq $authid_constructed; - $cell{"value"}=$record->subfield('250',"a"); + $cell{"value"}=$record->subfield('2..',"a"); return \%cell; } @@ -1146,80 +1190,121 @@ Then we should add some new parameter : bibliotargettag, authtargettag sub merge { my ($mergefrom,$MARCfrom,$mergeto,$MARCto) = @_; + my ($counteditedbiblio,$countunmodifiedbiblio,$counterrors)=(0,0,0); my $dbh=C4::Context->dbh; my $authtypecodefrom = GetAuthTypeCode($mergefrom); my $authtypecodeto = GetAuthTypeCode($mergeto); +# warn "mergefrom : $authtypecodefrom $mergefrom mergeto : $authtypecodeto $mergeto "; # return if authority does not exist - my @X = $MARCfrom->fields(); - return if $#X == -1; - @X = $MARCto->fields(); - return if $#X == -1; + 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; # search the tag to report my $sth = $dbh->prepare("select auth_tag_to_report from auth_types where authtypecode=?"); $sth->execute($authtypecodefrom); - my ($auth_tag_to_report) = $sth->fetchrow; + 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)->subfields() if $MARCto->field($auth_tag_to_report); + @record_to = $MARCto->field($auth_tag_to_report_to)->subfields() if $MARCto->field($auth_tag_to_report_to); my @record_from; - @record_from = $MARCfrom->field($auth_tag_to_report)->subfields() if $MARCfrom->field($auth_tag_to_report); + @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. - $sth = $dbh->prepare("select distinct tagfield from marc_subfield_structure where authtypecode=?"); - $sth->execute($authtypecodefrom); - my @tags_using_authtype; - while (my ($tagfield) = $sth->fetchrow) { - push @tags_using_authtype,$tagfield."9" ; - } - + #Getting marcbiblios impacted by the change. if (C4::Context->preference('NoZebra')) { - warn "MERGE TO DO"; + #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; + foreach (@biblionumbers) { + if ($_=~/(\d+),.*/) { + my $marc=GetMarcBiblio($1); + push @reccache,$marc; + } + } + } } else { - # now, find every biblio using this authority - my $oConnection=C4::Context->Zconn("biblioserver"); + #zebra connection + my $oConnection=C4::Context->Zconn("biblioserver",0); + $oConnection->option("preferredRecordSyntax"=>"XML"); my $query; - $query= "an= ".$mergefrom; + $query= "an=".$mergefrom; my $oResult = $oConnection->search(new ZOOM::Query::CCL2RPN( $query, $oConnection )); - my $count=$oResult->size() if ($oResult); - my @reccache; + my $count = 0; + if ($oResult) { + $count=$oResult->size(); + } my $z=0; while ( $z<$count ) { - my $rec; - $rec=$oResult->record($z); + my $rec; + $rec=$oResult->record($z); my $marcdata = $rec->raw(); - push @reccache, $marcdata; - $z++; + 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); + $oConnection->destroy(); + } + #warn scalar(@reccache)." biblios to update"; + # 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); + my @tags_using_authtype; + 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; + $marcrecord= MARC::Record->new_from_xml($marcrecord,"utf8",C4::Context->preference("marcflavour")) unless(C4::Context->preference('NoZebra')); + foreach my $tagfield (@tags_using_authtype){ +# warn "tagfield : $tagfield "; + foreach my $field ($marcrecord->field($tagfield)){ + 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); foreach my $subfield (@record_to) { - # warn "$subfield,$subfield->[0],$subfield->[1]"; - $tag->update($subfield->[0] =>$subfield->[1]); - }#for $subfield + $field_to->add_subfields($subfield->[0] =>$subfield->[1]); } - $marcrecord->delete_field($tag); - $marcrecord->add_fields($tag); + $marcrecord->delete_field($field); + $marcrecord->insert_grouped_field($field_to); $update=1; + } }#for each tag - }#foreach tagfield - my $oldbiblio = TransformMarcToKoha($dbh,$marcrecord,"") ; - if ($update==1){ - &ModBiblio($marcrecord,$oldbiblio->{'biblionumber'},GetFrameworkCode($oldbiblio->{'biblionumber'})) ; - } - - }#foreach $marc - } + }#foreach tagfield + my ($bibliotag,$bibliosubf) = GetMarcFromKohaField("biblio.biblionumber","") ; + my $biblionumber; + if ($bibliotag<10){ + $biblionumber=$marcrecord->field($bibliotag)->data; + } + else { + $biblionumber=$marcrecord->subfield($bibliotag,$bibliosubf); + } + unless ($biblionumber){ + warn "pas de numéro de notice bibliographique dans : ".$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;