X-Git-Url: http://git.rot13.org/?a=blobdiff_plain;f=C4%2FAuthoritiesMarc.pm;h=f9bf733f025ae33f4350bb68c06e16459bd7b0a7;hb=a3608b5e417d4cc6b3e382fcc02ed042bc424a30;hp=71e9c04ee97e317ecef4fd19df7fb75038243d96;hpb=c0c11a87c1bb78fd40a07ad824b3c7ccfb9cb102;p=koha.git diff --git a/C4/AuthoritiesMarc.pm b/C4/AuthoritiesMarc.pm index 71e9c04ee9..f9bf733f02 100644 --- a/C4/AuthoritiesMarc.pm +++ b/C4/AuthoritiesMarc.pm @@ -17,43 +17,48 @@ package C4::AuthoritiesMarc; # Suite 330, Boston, MA 02111-1307 USA use strict; -require Exporter; use C4::Context; use C4::Koha; use MARC::Record; use C4::Biblio; use C4::Search; +use C4::AuthoritiesMarc::MARC21; +use C4::AuthoritiesMarc::UNIMARC; +use C4::Charset; use vars qw($VERSION @ISA @EXPORT); -# set the version for version checking -$VERSION = do { my @v = '$Revision$' =~ /\d+/g; shift(@v).".".join( "_", map { sprintf "%03d", $_ } @v ); }; - -@ISA = qw(Exporter); -@EXPORT = qw( - &GetTagsLabels - &GetAuthType - &GetAuthTypeCode - &GetAuthMARCFromKohaField - &AUTHhtml2marc - - &AddAuthority - &ModAuthority - &DelAuthority - &GetAuthority - &GetAuthorityXML +BEGIN { + # set the version for version checking + $VERSION = 3.01; + + require Exporter; + @ISA = qw(Exporter); + @EXPORT = qw( + &GetTagsLabels + &GetAuthType + &GetAuthTypeCode + &GetAuthMARCFromKohaField + &AUTHhtml2marc + + &AddAuthority + &ModAuthority + &DelAuthority + &GetAuthority + &GetAuthorityXML - &CountUsage - &CountUsageChildren - &SearchAuthorities + &CountUsage + &CountUsageChildren + &SearchAuthorities - &BuildSummary - &BuildUnimarcHierarchies - &BuildUnimarcHierarchy + &BuildSummary + &BuildUnimarcHierarchies + &BuildUnimarcHierarchy - &merge - &FindDuplicateAuthority - ); + &merge + &FindDuplicateAuthority + ); +} =head2 GetAuthMARCFromKohaField @@ -64,9 +69,11 @@ returns tag and subfield linked to kohafield Comment : Suppose Kohafield is only linked to ONE subfield + =back =cut + sub GetAuthMARCFromKohaField { #AUTHfind_marc_from_kohafield my ( $kohafield,$authtypecode ) = @_; @@ -91,9 +98,10 @@ returns ref to array result and count of results returned =back =cut + sub SearchAuthorities { my ($tags, $and_or, $excluding, $operator, $value, $offset,$length,$authtypecode,$sortby) = @_; -# warn "CALL : $tags, $and_or, $excluding, $operator, $value, $offset,$length,$authtypecode,$sortby"; + #use Data::Dumper; map {warn "CALL : ".Data::Dumper::Dumper($_);} @_; my $dbh=C4::Context->dbh; if (C4::Context->preference('NoZebra')) { @@ -110,10 +118,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 "; } @@ -146,30 +152,31 @@ sub SearchAuthorities { $result{$title.$authid}=$authid; } # sort the hash and return the same structure as GetRecords (Zebra querying) - my @finalresult = (); + my @listresult = (); my $numbers=0; if ($sortby eq 'HeadingDsc') { # sort by mainmainentry desc foreach my $key (sort {$b cmp $a} (keys %result)) { - push @finalresult, $result{$key}; + push @listresult, $result{$key}; # warn "push..."$#finalresult; $numbers++; } } else { # sort by mainmainentry ASC foreach my $key (sort (keys %result)) { - push @finalresult, $result{$key}; + push @listresult, $result{$key}; # warn "push..."$#finalresult; $numbers++; } } # limit the $results_per_page to result size if it's more - $length = $numbers-1 if $numbers < $length; + $length = $numbers-$offset if $numbers < ($offset+$length); # for the requested page, replace authid by the complete record # speed improvement : avoid reading too much things - for (my $counter=$offset;$counter<=$offset+$length;$counter++) { + my @finalresult; + for (my $counter=$offset;$counter<=$offset+$length-1;$counter++) { # $finalresult[$counter] = GetAuthority($finalresult[$counter])->as_usmarc; my $separator=C4::Context->preference('authoritysep'); - my $authrecord = MARC::File::USMARC::decode(GetAuthority($finalresult[$counter])->as_usmarc); - my $authid=$authrecord->field('001')->data(); + my $authrecord =GetAuthority($listresult[$counter]); + my $authid=$listresult[$counter]; my $summary=BuildSummary($authrecord,$authid,$authtypecode); my $query_auth_tag = "SELECT auth_tag_to_report FROM auth_types WHERE authtypecode=?"; my $sth = $dbh->prepare($query_auth_tag); @@ -180,7 +187,7 @@ sub SearchAuthorities { $newline{summary} = $summary; $newline{authid} = $authid; $newline{even} = $counter % 2; - $finalresult[$counter]= \%newline; + push @finalresult, \%newline; } return (\@finalresult, $numbers); } else { @@ -198,25 +205,24 @@ sub SearchAuthorities { my @authtypecode; my @auths=split / /,$authtypecode ; foreach my $auth (@auths){ - $query .=" \@attr 1=Authority/format-id \@attr 5=100 ".$auth; ##No truncation on authtype + $query .=" \@attr 1=authtype \@attr 5=100 ".$auth; ##No truncation on authtype push @authtypecode ,$auth; $n++; } if ($n>1){ - $query= "\@or ".$query; + while ($n>1){$query= "\@or ".$query;$n--;} } - my $dosearch; - my $and; - my $q2; + my $and=" \@and " ; + my $q2=""; 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 "; }elsif (@$tags[$i] eq "mainentry") { - $attr =" \@attr 1=Heading-Entity "; + $attr =" \@attr 1=Heading "; }else{ $attr =" \@attr 1=Any "; } @@ -225,21 +231,32 @@ 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; - $dosearch=1; + $q2 =($q2 ne "" ?$and.$q2.$attr:$attr); }#if value } ##Add how many queries generated - $query= $and.$query.$q2; + if ($query=~/\S+/ && $q2 ne ""){ + $query= $and.$query.$q2; + } + elsif ($q2 ne "") { + $query=$q2; + } ## Adding order - $query=' @or @attr 7=1 @attr 1=Heading 0 @or @attr 7=1 @attr 1=Heading-Entity 1'.$query if ($sortby eq "HeadingAsc"); - $query=' @or @attr 7=2 @attr 1=Heading 0 @or @attr 7=1 @attr 1=Heading-Entity 1'.$query if ($sortby eq "HeadingDsc"); + #$query=' @or @attr 7=2 @attr 1=Heading 0 @or @attr 7=1 @attr 1=Heading 1'.$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' + :'' + ); + my $allrecords=" \@attr 1=_ALLRECORDS \@attr 2=103 '' "; + $query=($q2?"\@or $orderstring $query":"\@or $orderstring ".($query?"\@and $allrecords $query":$allrecords) ); $offset=0 unless $offset; my $counter = $offset; @@ -287,10 +304,18 @@ sub SearchAuthorities { my $sth = $dbh->prepare($query_auth_tag); $sth->execute($authtypecode); my $auth_tag_to_report = $sth->fetchrow; + my $reported_tag; + my $mainentry = $authrecord->field($auth_tag_to_report); + if ($mainentry) { + foreach ($mainentry->subfields()) { + $reported_tag .='$'.$_->[0].$_->[1]; + } + } my %newline; $newline{summary} = $summary; $newline{authid} = $authid; $newline{even} = $counter % 2; + $newline{reported_tag} = $reported_tag; $counter++; push @finalresult, \%newline; }## while counter @@ -354,6 +379,7 @@ counts Usage of narrower terms of Authid in bibliorecords. =back =cut + sub CountUsageChildren { my ($authid) = @_; } @@ -368,13 +394,14 @@ returns authtypecode of an authid =back =cut + sub GetAuthTypeCode { #AUTHfind_authtypecode my ($authid) = @_; 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; } @@ -404,6 +431,7 @@ where attribute takes values in : =back =cut + sub GetTagsLabels { my ($forlibrarian,$authtypecode)= @_; my $dbh=C4::Context->dbh; @@ -413,7 +441,7 @@ sub GetTagsLabels { # check that authority exists - $sth=$dbh->prepare("select count(*) from auth_tag_structure where authtypecode=?"); + $sth=$dbh->prepare("SELECT count(*) FROM auth_tag_structure WHERE authtypecode=?"); $sth->execute($authtypecode); my ($total) = $sth->fetchrow; $authtypecode="" unless ($total >0); @@ -486,6 +514,7 @@ Either Create Or Modify existing authority. =back =cut + sub AddAuthority { # pass the MARC::Record to this function, and it will create the records in the authority table my ($record,$authid,$authtypecode) = @_; @@ -495,31 +524,60 @@ sub AddAuthority { # 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 "UNIMARCAUTH") && (!$record->subfield('100','a'))){ + $record->leader(" nx j22 "); + my $date=POSIX::strftime("%Y%m%d",localtime); + if ($record->field('100')){ + $record->field('100')->update('a'=>$date."afrey50 ba0"); + } else { + $record->append_fields( + MARC::Field->new('100',' ',' ' + ,'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); + } + 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; ($authid)=$sth->fetchrow; $authid=$authid+1; ##Insert the recordID in MARC record - ##Both authid and authtypecode is expected to be in the same field. Modify if other requirements arise - $record->add_fields('001',$authid) unless $record->field('001'); - $record->add_fields('152','','','b'=>$authtypecode) unless $record->field('152'); -# 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{ + unless ($record->field('001') && $record->field('001')->data() eq $authid){ + $record->delete_field($record->field('001')); + $record->insert_fields_ordered(MARC::Field->new('001',$authid)); + } + } 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')); - $record->add_fields('100',$authid) unless ($record->field('100')); - $record->add_fields('152','','','b'=>$authtypecode) unless ($record->field('152')); - $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); } @@ -540,7 +598,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") ; } @@ -548,30 +606,27 @@ 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') ){ - # save the file in localfile/modified_authorities + 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")) { $cgidir = C4::Context->intranetdir."/"; + closedir(DIR); } - my $filename = $cgidir."/localfile/modified_authorities/$authid.authid"; + my $filename = $cgidir."/tmp/modified_authorities/$authid.authid"; open AUTH, "> $filename"; print AUTH $authid; close AUTH; - } else { -# &merge($authid,$record,$authid,$record); } return $authid; } @@ -586,16 +641,28 @@ returns xml form of record $authid =back =cut + sub GetAuthorityXML { # Returns MARC::XML of the authority passed in parameter. my ( $authid ) = @_; - 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; - + 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; + } } =head2 GetAuthority @@ -608,14 +675,21 @@ Returns MARC::Record of the authority passed in parameter. =back =cut + sub GetAuthority { my ($authid)=@_; my $dbh=C4::Context->dbh; - my $sth=$dbh->prepare("select marcxml from auth_header where authid=?"); + my $sth=$dbh->prepare("select authtypecode, marcxml from auth_header where authid=?"); $sth->execute($authid); - my ($marcxml) = $sth->fetchrow; - my $record=MARC::Record->new_from_xml($marcxml,'UTF-8',(C4::Context->preference("marcflavour") eq "UNIMARC"?"UNIMARCAUTH":C4::Context->preference("marcflavour"))); + my ($authtypecode, $marcxml) = $sth->fetchrow; + 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); + C4::AuthoritiesMarc::MARC21::fix_marc21_auth_type_location($record, $auth_type_tag, $auth_type_subfield); + } return ($record); } @@ -623,32 +697,29 @@ 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 { my ($authtypecode) = @_; my $dbh=C4::Context->dbh; my $sth; - if ($authtypecode){ - $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; + if (defined $authtypecode){ # NOTE - in MARC21 framework, '' is a valid authority + # 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; } @@ -725,8 +796,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]); @@ -755,8 +831,13 @@ sub BuildSummary{ ## give this a Marc record to return summary my ($record,$authid,$authtypecode)=@_; my $dbh=C4::Context->dbh; - my $authref = GetAuthType($authtypecode); - my $summary = $authref->{summary}; + my $summary; + # handle $authtypecode is NULL or eq "" + if ($authtypecode) { + my $authref = GetAuthType($authtypecode); + $summary = $authref->{summary}; + } + # FIXME: should use I18N.pm my %language; $language{'fre'}="Français"; $language{'eng'}="Anglais"; @@ -774,7 +855,12 @@ sub BuildSummary{ my @fields = $record->fields(); my $reported_tag; # if the library has a summary defined, use it. Otherwise, build a standard one - if ($summary) { + # FIXME - it appears that the summary field in the authority frameworks + # can work as a display template. However, this doesn't + # suit the MARC21 version, so for now the "templating" + # feature will be enabled only for UNIMARC for backwards + # compatibility. + if ($summary and C4::Context->preference('marcflavour') eq 'UNIMARC') { my @fields = $record->fields(); # $reported_tag = '$9'.$result[$counter]; foreach my $field (@fields) { @@ -851,7 +937,12 @@ sub BuildSummary{ $summary.= '