X-Git-Url: http://koha-dev.rot13.org:8081/gitweb/?a=blobdiff_plain;f=C4%2FAuthoritiesMarc.pm;h=95fe33a732ccb6d4f8858b9bd4bc3f5d3e029243;hb=5d6c092921919526ade501facb1220f8a108a08f;hp=6593ee2e96c0b9bb748e08b365206af7c89063d2;hpb=3d55391eee5b22ee46764b3b1d73b6ef0ad46621;p=koha_fer diff --git a/C4/AuthoritiesMarc.pm b/C4/AuthoritiesMarc.pm index 6593ee2e96..95fe33a732 100644 --- a/C4/AuthoritiesMarc.pm +++ b/C4/AuthoritiesMarc.pm @@ -26,6 +26,7 @@ use C4::AuthoritiesMarc::MARC21; use C4::AuthoritiesMarc::UNIMARC; use C4::Charset; use C4::Log; +use Koha::Authority; use vars qw($VERSION @ISA @EXPORT); @@ -52,8 +53,9 @@ BEGIN { &SearchAuthorities &BuildSummary - &BuildUnimarcHierarchies - &BuildUnimarcHierarchy + &BuildAuthHierarchies + &BuildAuthHierarchy + &GenerateHierarchy &merge &FindDuplicateAuthority @@ -107,276 +109,221 @@ sub SearchAuthorities { my ($tags, $and_or, $excluding, $operator, $value, $offset,$length,$authtypecode,$sortby,$skipmetadata) = @_; # warn Dumper($tags, $and_or, $excluding, $operator, $value, $offset,$length,$authtypecode,$sortby); my $dbh=C4::Context->dbh; - if (C4::Context->preference('NoZebra')) { - - # - # build the query - # - my $query; - my @auths=split / /,$authtypecode ; - foreach my $auth (@auths){ - $query .="AND auth_type= $auth "; - } - $query =~ s/^AND //; - my $dosearch; - for(my $i = 0 ; $i <= $#{$value} ; $i++) - { - if (@$value[$i]){ - if (@$tags[$i] =~/mainentry|mainmainentry/) { - $query .= qq( AND @$tags[$i] ); - } else { - $query .=" AND "; - } - if (@$operator[$i] eq 'is') { - $query.=(@$tags[$i]?"=":""). '"'.@$value[$i].'"'; - }elsif (@$operator[$i] eq "="){ - $query.=(@$tags[$i]?"=":""). '"'.@$value[$i].'"'; - }elsif (@$operator[$i] eq "start"){ - $query.=(@$tags[$i]?"=":"").'"'.@$value[$i].'%"'; - } else { - $query.=(@$tags[$i]?"=":"").'"'.@$value[$i].'%"'; - } - $dosearch=1; - }#if value - } - # - # do the query (if we had some search term - # - if ($dosearch) { -# warn "QUERY : $query"; - my $result = C4::Search::NZanalyse($query,'authorityserver'); -# warn "result : $result"; - my %result; - foreach (split /;/,$result) { - my ($authid,$title) = split /,/,$_; - # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title - # and we don't want to get only 1 result for each of them !!! - # hint & speed improvement : we can order without reading the record - # so order, and read records only for the requested page ! - $result{$title.$authid}=$authid; - } - # sort the hash and return the same structure as GetRecords (Zebra querying) - my @listresult = (); - my $numbers=0; - if ($sortby eq 'HeadingDsc') { # sort by mainmainentry desc - foreach my $key (sort {$b cmp $a} (keys %result)) { - push @listresult, $result{$key}; -# warn "push..."$#finalresult; - $numbers++; - } - } else { # sort by mainmainentry ASC - foreach my $key (sort (keys %result)) { - push @listresult, $result{$key}; -# warn "push..."$#finalresult; - $numbers++; - } - } - # limit the $results_per_page to result size if it's more - $length = $numbers-$offset if $numbers < ($offset+$length); - # for the requested page, replace authid by the complete record - # speed improvement : avoid reading too much things - 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 =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); - $sth->execute($authtypecode); - my $auth_tag_to_report = $sth->fetchrow; - my %newline; - $newline{used}=CountUsage($authid); - $newline{summary} = $summary; - $newline{authid} = $authid; - $newline{even} = $counter % 2; - push @finalresult, \%newline; - } - return (\@finalresult, $numbers); - } else { - return; - } - } else { - my $query; - my $attr = ''; - # the marclist may contain "mainentry". In this case, search the tag_to_report, that depends on - # the authtypecode. Then, search on $a of this tag_to_report - # also store main entry MARC tag, to extract it at end of search - my $mainentrytag; - ##first set the authtype search and may be multiple authorities + my $query; + my $qpquery = ''; + my $QParser; + $QParser = C4::Context->queryparser if (C4::Context->preference('UseQueryParser')); + my $attr = ''; + # the marclist may contain "mainentry". In this case, search the tag_to_report, that depends on + # the authtypecode. Then, search on $a of this tag_to_report + # also store main entry MARC tag, to extract it at end of search + my $mainentrytag; + ##first set the authtype search and may be multiple authorities + if ($authtypecode) { my $n=0; my @authtypecode; my @auths=split / /,$authtypecode ; foreach my $auth (@auths){ $query .=" \@attr 1=authtype \@attr 5=100 ".$auth; ##No truncation on authtype - push @authtypecode ,$auth; + push @authtypecode ,$auth; $n++; } if ($n>1){ while ($n>1){$query= "\@or ".$query;$n--;} } - - my $dosearch; - my $and=" \@and " ; - my $q2; - my $attr_cnt = 0; - for(my $i = 0 ; $i <= $#{$value} ; $i++) - { - if (@$value[$i]){ - if ( @$tags[$i] eq "mainmainentry" ) { - $attr = " \@attr 1=Heading-Main "; - } - elsif ( @$tags[$i] eq "mainentry" ) { - $attr = " \@attr 1=Heading "; - } - elsif ( @$tags[$i] eq "match" ) { - $attr = " \@attr 1=Match "; - } - elsif ( @$tags[$i] eq "match-heading" ) { - $attr = " \@attr 1=Match-heading "; - } - elsif ( @$tags[$i] eq "see-from" ) { - $attr = " \@attr 1=Match-heading-see-from "; - } - elsif ( @$tags[$i] eq "thesaurus" ) { - $attr = " \@attr 1=Subject-heading-thesaurus "; - } - else { # Assume any if no index was specified - $attr = " \@attr 1=Any "; - } - if ( @$operator[$i] eq 'is' ) { - $attr .= " \@attr 4=1 \@attr 5=100 " - ; ##Phrase, No truncation,all of subfield field must match - } - elsif ( @$operator[$i] eq "=" ) { - $attr .= " \@attr 4=107 "; #Number Exact match - } - elsif ( @$operator[$i] eq "start" ) { - $attr .= " \@attr 3=2 \@attr 4=1 \@attr 5=1 " - ; #Firstinfield Phrase, Right truncated - } - elsif ( @$operator[$i] eq "exact" ) { - $attr .= " \@attr 4=1 \@attr 5=100 \@attr 6=3 " - ; ##Phrase, No truncation,all of subfield field must match - } - else { - $attr .= " \@attr 5=1 \@attr 4=6 " - ; ## Word list, right truncated, anywhere - } - @$value[$i] =~ s/"/\\"/g; # Escape the double-quotes in the search value - $attr =$attr."\"".@$value[$i]."\""; - $q2 .=$attr; - $dosearch=1; - ++$attr_cnt; - }#if value + if ($QParser) { + $qpquery .= '(authtype:' . join('|| authtype:', @auths) . ')'; } - ##Add how many queries generated - if (defined $query && $query=~/\S+/){ - $query= $and x $attr_cnt . $query . (defined $q2 ? $q2 : ''); - } else { - $query= $q2; - } - ## Adding order - #$query=' @or @attr 7=2 @attr 1=Heading 0 @or @attr 7=1 @attr 1=Heading 1'.$query if ($sortby eq "HeadingDsc"); - my $orderstring; - if ($sortby eq 'HeadingAsc') { - $orderstring = '@attr 7=1 @attr 1=Heading 0'; - } elsif ($sortby eq 'HeadingDsc') { - $orderstring = '@attr 7=2 @attr 1=Heading 0'; - } elsif ($sortby eq 'AuthidAsc') { - $orderstring = '@attr 7=1 @attr 1=Local-Number 0'; - } elsif ($sortby eq 'AuthidDsc') { - $orderstring = '@attr 7=2 @attr 1=Local-Number 0'; + } + + my $dosearch; + my $and=" \@and " ; + my $q2; + my $attr_cnt = 0; + for(my $i = 0 ; $i <= $#{$value} ; $i++) + { + if (@$value[$i]){ + if ( @$tags[$i] eq "mainmainentry" ) { + $attr = " \@attr 1=Heading-Main "; + } + elsif ( @$tags[$i] eq "mainentry" ) { + $attr = " \@attr 1=Heading "; + } + elsif ( @$tags[$i] eq "match" ) { + $attr = " \@attr 1=Match "; + } + elsif ( @$tags[$i] eq "match-heading" ) { + $attr = " \@attr 1=Match-heading "; + } + elsif ( @$tags[$i] eq "see-from" ) { + $attr = " \@attr 1=Match-heading-see-from "; + } + elsif ( @$tags[$i] eq "thesaurus" ) { + $attr = " \@attr 1=Subject-heading-thesaurus "; + } + else { # Assume any if no index was specified + $attr = " \@attr 1=Any "; + } + if ( @$operator[$i] eq 'is' ) { + $attr .= " \@attr 4=1 \@attr 5=100 " + ; ##Phrase, No truncation,all of subfield field must match + } + elsif ( @$operator[$i] eq "=" ) { + $attr .= " \@attr 4=107 "; #Number Exact match + } + elsif ( @$operator[$i] eq "start" ) { + $attr .= " \@attr 3=2 \@attr 4=1 \@attr 5=1 " + ; #Firstinfield Phrase, Right truncated + } + elsif ( @$operator[$i] eq "exact" ) { + $attr .= " \@attr 4=1 \@attr 5=100 \@attr 6=3 " + ; ##Phrase, No truncation,all of subfield field must match + } + else { + $attr .= " \@attr 5=1 \@attr 4=6 " + ; ## Word list, right truncated, anywhere + if ($sortby eq 'Relevance') { + $attr .= "\@attr 2=102 "; + } + } + @$value[$i] =~ s/"/\\"/g; # Escape the double-quotes in the search value + $attr =$attr."\"".@$value[$i]."\""; + $q2 .=$attr; + $dosearch=1; + ++$attr_cnt; + if ($QParser) { + $qpquery .= " $tags->[$i]:\"$value->[$i]\""; + } + }#if value + } + ##Add how many queries generated + if (defined $query && $query=~/\S+/){ + $query= $and x $attr_cnt . $query . (defined $q2 ? $q2 : ''); + } else { + $query= $q2; + } + ## Adding order + #$query=' @or @attr 7=2 @attr 1=Heading 0 @or @attr 7=1 @attr 1=Heading 1'.$query if ($sortby eq "HeadingDsc"); + my $orderstring; + if ($sortby eq 'HeadingAsc') { + $orderstring = '@attr 7=1 @attr 1=Heading 0'; + } elsif ($sortby eq 'HeadingDsc') { + $orderstring = '@attr 7=2 @attr 1=Heading 0'; + } elsif ($sortby eq 'AuthidAsc') { + $orderstring = '@attr 7=1 @attr 4=109 @attr 1=Local-Number 0'; + } elsif ($sortby eq 'AuthidDsc') { + $orderstring = '@attr 7=2 @attr 4=109 @attr 1=Local-Number 0'; + } + if ($QParser) { + $qpquery .= ' all:all' unless $value->[0]; + + if ( $value->[0] =~ m/^qp=(.*)$/ ) { + $qpquery = $1; } + + $qpquery .= " #$sortby" unless $sortby eq ''; + + $QParser->parse( $qpquery ); + $query = $QParser->target_syntax('authorityserver'); + } else { $query=($query?$query:"\@attr 1=_ALLRECORDS \@attr 2=103 ''"); $query="\@or $orderstring $query" if $orderstring; + } - $offset=0 unless $offset; - my $counter = $offset; - $length=10 unless $length; - my @oAuth; - my $i; - $oAuth[0]=C4::Context->Zconn("authorityserver" , 1); - my $Anewq= new ZOOM::Query::PQF($query,$oAuth[0]); - my $oAResult; - $oAResult= $oAuth[0]->search($Anewq) ; - while (($i = ZOOM::event(\@oAuth)) != 0) { - my $ev = $oAuth[$i-1]->last_event(); - last if $ev == ZOOM::Event::ZEND; - } - my($error, $errmsg, $addinfo, $diagset) = $oAuth[0]->error_x(); - if ($error) { - warn "oAuth error: $errmsg ($error) $addinfo $diagset\n"; - goto NOLUCK; - } - - my $nbresults; - $nbresults=$oAResult->size(); - my $nremains=$nbresults; - my @result = (); - my @finalresult = (); - - if ($nbresults>0){ + $offset=0 unless $offset; + my $counter = $offset; + $length=10 unless $length; + my @oAuth; + my $i; + $oAuth[0]=C4::Context->Zconn("authorityserver" , 1); + my $Anewq= new ZOOM::Query::PQF($query,$oAuth[0]); + my $oAResult; + $oAResult= $oAuth[0]->search($Anewq) ; + while (($i = ZOOM::event(\@oAuth)) != 0) { + my $ev = $oAuth[$i-1]->last_event(); + last if $ev == ZOOM::Event::ZEND; + } + my($error, $errmsg, $addinfo, $diagset) = $oAuth[0]->error_x(); + if ($error) { + warn "oAuth error: $errmsg ($error) $addinfo $diagset\n"; + goto NOLUCK; + } + + my $nbresults; + $nbresults=$oAResult->size(); + my $nremains=$nbresults; + my @result = (); + my @finalresult = (); + + if ($nbresults>0){ + + ##Find authid and linkid fields + ##we may be searching multiple authoritytypes. + ## FIXME this assumes that all authid and linkid fields are the same for all authority types + # my ($authidfield,$authidsubfield)=GetAuthMARCFromKohaField($dbh,"auth_header.authid",$authtypecode[0]); + # my ($linkidfield,$linkidsubfield)=GetAuthMARCFromKohaField($dbh,"auth_header.linkid",$authtypecode[0]); + while (($counter < $nbresults) && ($counter < ($offset + $length))) { - ##Find authid and linkid fields - ##we may be searching multiple authoritytypes. - ## FIXME this assumes that all authid and linkid fields are the same for all authority types - # my ($authidfield,$authidsubfield)=GetAuthMARCFromKohaField($dbh,"auth_header.authid",$authtypecode[0]); - # my ($linkidfield,$linkidsubfield)=GetAuthMARCFromKohaField($dbh,"auth_header.linkid",$authtypecode[0]); - while (($counter < $nbresults) && ($counter < ($offset + $length))) { - - ##Here we have to extract MARC record and $authid from ZEBRA AUTHORITIES - my $rec=$oAResult->record($counter); - my $marcdata=$rec->raw(); - my $authrecord; - my $separator=C4::Context->preference('authoritysep'); - $authrecord = MARC::File::USMARC::decode($marcdata); - my $authid=$authrecord->field('001')->data(); - my %newline; - $newline{authid} = $authid; - if ( !$skipmetadata ) { - my $summary = - BuildSummary( $authrecord, $authid, $authtypecode ); - my $query_auth_tag = + ##Here we have to extract MARC record and $authid from ZEBRA AUTHORITIES + my $rec=$oAResult->record($counter); + my $separator=C4::Context->preference('AuthoritySeparator'); + my $authrecord = C4::Search::new_record_from_zebra( + 'authorityserver', + $rec->raw() + ); + + if ( !defined $authrecord or !defined $authrecord->field('001') ) { + $counter++; + next; + } + + my $authid=$authrecord->field('001')->data(); + my %newline; + $newline{authid} = $authid; + if ( !$skipmetadata ) { + my $query_auth_tag = "SELECT auth_tag_to_report FROM auth_types WHERE authtypecode=?"; - 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 $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 $thisauthtype = GetAuthType(GetAuthTypeCode($authid)); - $newline{authtype} = defined ($thisauthtype) ? - $thisauthtype->{'authtypetext'} : - (GetAuthType($authtypecode) ? $_->{'authtypetext'} : ''); - $newline{summary} = $summary; - $newline{even} = $counter % 2; - $newline{reported_tag} = $reported_tag; } - $counter++; - push @finalresult, \%newline; - }## while counter - ### - if (! $skipmetadata) { - for (my $z=0; $z<@finalresult; $z++){ - my $count=CountUsage($finalresult[$z]{authid}); - $finalresult[$z]{used}=$count; - }# all $z's + my $thisauthtypecode = GetAuthTypeCode($authid); + my $thisauthtype = GetAuthType($thisauthtypecode); + unless (defined $thisauthtype) { + $thisauthtypecode = $authtypecode; + $thisauthtype = GetAuthType($authtypecode); } + my $summary = BuildSummary( $authrecord, $authid, $thisauthtypecode ); - }## if nbresult - NOLUCK: - $oAResult->destroy(); - # $oAuth[0]->destroy(); - - return (\@finalresult, $nbresults); - } + $newline{authtype} = defined($thisauthtype) ? + $thisauthtype->{'authtypetext'} : ''; + $newline{summary} = $summary; + $newline{even} = $counter % 2; + $newline{reported_tag} = $reported_tag; + } + $counter++; + push @finalresult, \%newline; + }## while counter + ### + if (! $skipmetadata) { + for (my $z=0; $z<@finalresult; $z++){ + my $count=CountUsage($finalresult[$z]{authid}); + $finalresult[$z]{used}=$count; + }# all $z's + } + + }## if nbresult + NOLUCK: + $oAResult->destroy(); + # $oAuth[0]->destroy(); + + return (\@finalresult, $nbresults); } =head2 CountUsage @@ -389,15 +336,9 @@ counts Usage of Authid in bibliorecords. sub CountUsage { my ($authid) = @_; - if (C4::Context->preference('NoZebra')) { - # Read the index Koha-Auth-Number for this authid and count the lines - my $result = C4::Search::NZanalyse("an=$authid"); - my @tab = split /;/,$result; - return scalar @tab; - } else { ### ZOOM search here my $query; - $query= "an=".$authid; + $query= "an:".$authid; my ($err,$res,$result) = C4::Search::SimpleSearch($query,0,10); if ($err) { warn "Error: $err from search $query"; @@ -405,7 +346,6 @@ sub CountUsage { } return $result; - } } =head2 CountUsageChildren @@ -447,9 +387,9 @@ 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'}, @@ -588,7 +528,7 @@ sub GetTagsLabels { $res->{$tag}->{repeatable} = $repeatable; } $sth= $dbh->prepare( -"SELECT tagfield,tagsubfield,liblibrarian,libopac,tab, mandatory, repeatable,authorised_value,frameworkcode as authtypecode,value_builder,kohafield,seealso,hidden,isurl +"SELECT tagfield,tagsubfield,liblibrarian,libopac,tab, mandatory, repeatable,authorised_value,frameworkcode as authtypecode,value_builder,kohafield,seealso,hidden,isurl,defaultvalue FROM auth_subfield_structure WHERE authtypecode=? ORDER BY tagfield,tagsubfield" @@ -603,12 +543,13 @@ ORDER BY tagfield,tagsubfield" my $hidden; my $isurl; my $link; + my $defaultvalue; while ( ( $tag, $subfield, $liblibrarian, , $libopac, $tab, $mandatory, $repeatable, $authorised_value, $authtypecode, $value_builder, $kohafield, $seealso, $hidden, - $isurl, $link ) + $isurl, $defaultvalue, $link ) = $sth->fetchrow ) { @@ -624,6 +565,7 @@ ORDER BY tagfield,tagsubfield" $res->{$tag}->{$subfield}->{hidden} = $hidden; $res->{$tag}->{$subfield}->{isurl} = $isurl; $res->{$tag}->{$subfield}->{link} = $link; + $res->{$tag}->{$subfield}->{defaultvalue} = $defaultvalue; } return $res; } @@ -697,17 +639,18 @@ sub AddAuthority { if ($format eq "UNIMARCAUTH") { $record->leader(" nx j22 ") unless ($record->leader()); - my $date=POSIX::strftime("%Y%m%d",localtime); + my $date=POSIX::strftime("%Y%m%d",localtime); + my $defaultfield100 = C4::Context->preference('UNIMARCAuthorityField100'); if (my $string=$record->subfield('100',"a")){ $string=~s/fre50/frey50/; $record->field('100')->update('a'=>$string); } elsif ($record->field('100')){ - $record->field('100')->update('a'=>$date."afrey50 ba0"); + $record->field('100')->update('a'=>$date.$defaultfield100); } else { $record->append_fields( MARC::Field->new('100',' ',' ' - ,'a'=>$date."afrey50 ba0") + ,'a'=>$date.$defaultfield100) ); } } @@ -804,7 +747,7 @@ sub ModAuthority { "VALUES (?,?)"; $dbh->do($sqlinsert,undef,($authid,0)); } - logaction( "AUTHORITIES", "MODIFY", $authid, "BEFORE=>" . $oldrecord->as_formatted ) if C4::Context->preference("AuthoritiesLog"); + logaction( "AUTHORITIES", "MODIFY", $authid, "authority BEFORE=>" . $oldrecord->as_formatted ) if C4::Context->preference("AuthoritiesLog"); return $authid; } @@ -848,19 +791,9 @@ Returns MARC::Record of the authority passed in parameter. sub GetAuthority { my ($authid)=@_; - my $dbh=C4::Context->dbh; - my $sth=$dbh->prepare("select authtypecode, marcxml from auth_header where authid=?"); - $sth->execute($authid); - 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); + my $authority = Koha::Authority->get_from_authid($authid); + return unless $authority; + return ($authority->record); } =head2 GetAuthType @@ -911,18 +844,29 @@ sub FindDuplicateAuthority { $sth->finish; # warn "record :".$record->as_formatted." auth_tag_to_report :$auth_tag_to_report"; # build a request for SearchAuthorities - my $query='at='.$authtypecode.' '; + my $QParser; + $QParser = C4::Context->queryparser if (C4::Context->preference('UseQueryParser')); + my $op; + if ($QParser) { + $op = '&&'; + } else { + $op = 'and'; + } + my $query='at:'.$authtypecode.' '; 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]/); - } + foreach ($record->field($auth_tag_to_report)->subfields()) { + $_->[1]=~s/$filtervalues/ /g; $query.= " $op he:\"".$_->[1]."\"" if ($_->[0]=~/[A-z]/); + } } my ($error, $results, $total_hits) = C4::Search::SimpleSearch( $query, 0, 1, [ "authorityserver" ] ); # there is at least 1 result => return the 1st one if (!defined $error && @{$results} ) { - my $marcrecord = MARC::File::USMARC::decode($results->[0]); - return $marcrecord->field('001')->data,BuildSummary($marcrecord,$marcrecord->field('001')->data,$authtypecode); + my $marcrecord = C4::Search::new_record_from_zebra( + 'authorityserver', + $results->[0] + ); + return $marcrecord->field('001')->data,BuildSummary($marcrecord,$marcrecord->field('001')->data,$authtypecode); } # no result, returns nothing return; @@ -945,14 +889,20 @@ sub BuildSummary { my ($record,$authid,$authtypecode)=@_; my $dbh=C4::Context->dbh; my %summary; + my $summary_template; # handle $authtypecode is NULL or eq "" if ($authtypecode) { my $authref = GetAuthType($authtypecode); $summary{authtypecode} = $authref->{authtypecode}; $summary{type} = $authref->{authtypetext}; - $summary{summary} = $authref->{summary}; + $summary_template = $authref->{summary}; + # for MARC21, the authority type summary displays a label meant for + # display + if (C4::Context->preference('marcflavour') ne 'UNIMARC') { + $summary{summary} = $authref->{summary}; + } } - my $marc21subfields = 'abcdfghjklmnopqrstuvxyz'; + my $marc21subfields = 'abcdfghjklmnopqrstuvxyz68'; my %marc21controlrefs = ( 'a' => 'earlier', 'b' => 'later', 'd' => 'acronym', @@ -963,6 +913,11 @@ sub BuildSummary { 'i' => 'subfi', 't' => 'parent' ); + my %unimarc_relation_from_code = ( + g => 'broader', + h => 'narrower', + a => 'seealso', + ); my %thesaurus; $thesaurus{'1'}="Peuples"; $thesaurus{'2'}="Anthroponymes"; @@ -978,14 +933,14 @@ sub BuildSummary { # suit the MARC21 version, so for now the "templating" # feature will be enabled only for UNIMARC for backwards # compatibility. - if ($summary{summary} and C4::Context->preference('marcflavour') eq 'UNIMARC') { + if ($summary_template and C4::Context->preference('marcflavour') eq 'UNIMARC') { my @fields = $record->fields(); # $reported_tag = '$9'.$result[$counter]; - my @stringssummary; + my @repets; foreach my $field (@fields) { my $tag = $field->tag(); my $tagvalue = $field->as_string(); - my $localsummary= $summary{summary}; + my $localsummary= $summary_template; $localsummary =~ s/\[(.?.?.?.?)$tag\*(.*?)\]/$1$tagvalue$2\[$1$tag$2\]/g; if ($tag<10) { if ($tag eq '001') { @@ -1000,13 +955,13 @@ sub BuildSummary { $localsummary =~ s/\[(.?.?.?.?)$tagsubf(.*?)\]/$1$subfieldvalue$2\[$1$tagsubf$2\]/g; } } - push @stringssummary, $localsummary if ($localsummary ne $summary{summary}); + if ($localsummary ne $summary_template) { + $localsummary =~ s/\[(.*?)\]//g; + $localsummary =~ s/\n/
/g; + push @repets, $localsummary; + } } - my $resultstring; - $resultstring = join(" -- ",@stringssummary); - $resultstring =~ s/\[(.*?)\]//g; - $resultstring =~ s/\n/
/g; - $summary{summary} = $resultstring; + $summary{repets} = \@repets; } my @authorized; my @notes; @@ -1017,7 +972,11 @@ sub BuildSummary { # construct UNIMARC summary, that is quite different from MARC21 one # accepted form foreach my $field ($record->field('2..')) { - push @authorized, { heading => $field->as_string('abcdefghijlmnopqrstuvwxyz'), field => $field->tag() }; + push @authorized, { + heading => $field->as_string('abcdefghijlmnopqrstuvwxyz'), + hemain => ( $field->subfield('a') // undef ), + field => $field->tag(), + }; } # rejected form(s) foreach my $field ($record->field('3..')) { @@ -1025,23 +984,36 @@ sub BuildSummary { } foreach my $field ($record->field('4..')) { my $thesaurus = $field->subfield('2') ? "thes. : ".$thesaurus{"$field->subfield('2')"}." : " : ''; - push @seefrom, { heading => $thesaurus . $field->as_string('abcdefghijlmnopqrstuvwxyz'), type => 'seefrom', field => $field->tag() }; + push @seefrom, { + heading => $thesaurus . $field->as_string('abcdefghijlmnopqrstuvwxyz'), + hemain => ( $field->subfield('a') // undef ), + type => 'seefrom', + field => $field->tag(), + }; } -# see : - foreach my $field ($record->field('5..')) { - if (($field->subfield('5')) && ($field->subfield('a')) && ($field->subfield('5') eq 'g')) { - push @seealso, { $field->as_string('abcdefgjxyz'), type => 'broader', field => $field->tag() }; - } elsif (($field->subfield('5')) && ($field->as_string) && ($field->subfield('5') eq 'h')){ - push @seealso, { heading => $field->as_string('abcdefgjxyz'), type => 'narrower', field => $field->tag() }; - } elsif ($field->subfield('a')) { - push @seealso, { heading => $field->as_string('abcdefgxyz'), type => 'seealso', field => $field->tag() }; + + # see : + @seealso = map { + my $type = $unimarc_relation_from_code{$_->subfield('5') || 'a'}; + my $heading = $_->as_string('abcdefgjxyz'); + { + field => $_->tag, + type => $type, + heading => $heading, + hemain => ( $_->subfield('a') // undef ), + search => $heading, + authid => ( $_->subfield('9') // undef ), } - } -# // form - foreach my $field ($record->field('7..')) { - my $lang = substr($field->subfield('8'),3,3); - push @otherscript, { lang => $lang, term => $field->subfield('a'), direction => 'ltr', field => $field->tag() }; - } + } $record->field('5..'); + + # Other forms + @otherscript = map { { + lang => length ($_->subfield('8')) == 6 ? substr ($_->subfield('8'), 3, 3) : $_->subfield('8') || '', + term => $_->subfield('a') . ($_->subfield('b') ? ', ' . $_->subfield('b') : ''), + direction => 'ltr', + field => $_->tag, + } } $record->field('7..'); + } else { # construct MARC21 summary # FIXME - looping over 1XX is questionable @@ -1079,35 +1051,67 @@ sub BuildSummary { $subfields_to_report = 'vxyz'; } if ($subfields_to_report) { - push @authorized, { heading => $field->as_string($subfields_to_report), field => $tag }; + push @authorized, { + heading => $field->as_string($subfields_to_report), + hemain => ( $field->subfield( substr($subfields_to_report, 0, 1) ) // undef ), + field => $tag, + }; } else { - push @authorized, { heading => $field->as_string(), field => $tag }; + push @authorized, { + heading => $field->as_string(), + hemain => ( $field->subfield( 'a' ) // undef ), + field => $tag, + }; } } foreach my $field ($record->field('4..')) { #See From my $type = 'seefrom'; - $type = $marc21controlrefs{substr $field->subfield('w'), 0, 1} if ($field->subfield('w')); + $type = ($marc21controlrefs{substr $field->subfield('w'), 0, 1} || '') if ($field->subfield('w')); if ($type eq 'notapplicable') { $type = substr $field->subfield('w'), 2, 1; $type = 'earlier' if $type && $type ne 'n'; } if ($type eq 'subfi') { - push @seefrom, { heading => $field->as_string($marc21subfields), type => $field->subfield('i'), field => $field->tag() }; + push @seefrom, { + heading => $field->as_string($marc21subfields), + hemain => $field->subfield( substr($marc21subfields, 0, 1) ), + type => ($field->subfield('i') || ''), + field => $field->tag(), + }; } else { - push @seefrom, { heading => $field->as_string($marc21subfields), type => $type, field => $field->tag() }; + push @seefrom, { + heading => $field->as_string($marc21subfields), + hemain => $field->subfield( substr($marc21subfields, 0, 1) ), + type => $type, + field => $field->tag(), + }; } } foreach my $field ($record->field('5..')) { #See Also my $type = 'seealso'; - $type = $marc21controlrefs{substr $field->subfield('w'), 0, 1} if ($field->subfield('w')); + $type = ($marc21controlrefs{substr $field->subfield('w'), 0, 1} || '') if ($field->subfield('w')); if ($type eq 'notapplicable') { $type = substr $field->subfield('w'), 2, 1; $type = 'earlier' if $type && $type ne 'n'; } if ($type eq 'subfi') { - push @seealso, { heading => $field->as_string($marc21subfields), type => $field->subfield('i'), field => $field->tag() }; + push @seealso, { + heading => $field->as_string($marc21subfields), + hemain => $field->subfield( substr($marc21subfields, 0, 1) ), + type => $field->subfield('i'), + field => $field->tag(), + search => $field->as_string($marc21subfields) || '', + authid => $field->subfield('9') || '' + }; } else { - push @seealso, { heading => $field->as_string($marc21subfields), type => $type, field => $field->tag() }; + push @seealso, { + heading => $field->as_string($marc21subfields), + hemain => $field->subfield( substr($marc21subfields, 0, 1) ), + type => $type, + field => $field->tag(), + search => $field->as_string($marc21subfields) || '', + authid => $field->subfield('9') || '' + }; } } foreach my $field ($record->field('6..')) { @@ -1134,6 +1138,7 @@ sub BuildSummary { } } $summary{mainentry} = $authorized[0]->{heading}; + $summary{mainmainentry} = $authorized[0]->{hemain}; $summary{authorized} = \@authorized; $summary{notes} = \@notes; $summary{seefrom} = \@seefrom; @@ -1142,9 +1147,73 @@ sub BuildSummary { return \%summary; } -=head2 BuildUnimarcHierarchies +=head2 GetAuthorizedHeading + + $heading = &GetAuthorizedHeading({ record => $record, authid => $authid }) + +Takes a MARC::Record object describing an authority record or an authid, and +returns a string representation of the first authorized heading. This routine +should be considered a temporary shim to ease the future migration of authority +data from C4::AuthoritiesMarc to the object-oriented Koha::*::Authority. + +=cut + +sub GetAuthorizedHeading { + my $args = shift; + my $record; + unless ($record = $args->{record}) { + return unless $args->{authid}; + $record = GetAuthority($args->{authid}); + } + return unless (ref $record eq 'MARC::Record'); + if (C4::Context->preference('marcflavour') eq 'UNIMARC') { +# construct UNIMARC summary, that is quite different from MARC21 one +# accepted form + foreach my $field ($record->field('2..')) { + return $field->as_string('abcdefghijlmnopqrstuvwxyz'); + } + } else { + foreach my $field ($record->field('1..')) { + my $tag = $field->tag(); + next if "152" eq $tag; +# FIXME - 152 is not a good tag to use +# in MARC21 -- purely local tags really ought to be +# 9XX + if ($tag eq '100') { + return $field->as_string('abcdefghjklmnopqrstvxyz68'); + } elsif ($tag eq '110') { + return $field->as_string('abcdefghklmnoprstvxyz68'); + } elsif ($tag eq '111') { + return $field->as_string('acdefghklnpqstvxyz68'); + } elsif ($tag eq '130') { + return $field->as_string('adfghklmnoprstvxyz68'); + } elsif ($tag eq '148') { + return $field->as_string('abvxyz68'); + } elsif ($tag eq '150') { + return $field->as_string('abvxyz68'); + } elsif ($tag eq '151') { + return $field->as_string('avxyz68'); + } elsif ($tag eq '155') { + return $field->as_string('abvxyz68'); + } elsif ($tag eq '180') { + return $field->as_string('vxyz68'); + } elsif ($tag eq '181') { + return $field->as_string('vxyz68'); + } elsif ($tag eq '182') { + return $field->as_string('vxyz68'); + } elsif ($tag eq '185') { + return $field->as_string('vxyz68'); + } else { + return $field->as_string(); + } + } + } + return; +} + +=head2 BuildAuthHierarchies - $text= &BuildUnimarcHierarchies( $authid, $force) + $text= &BuildAuthHierarchies( $authid, $force) return text containing trees for hierarchies for them to be stored in auth_header @@ -1154,54 +1223,59 @@ Example of text: =cut -sub BuildUnimarcHierarchies{ - my $authid = shift @_; +sub BuildAuthHierarchies{ + my $authid = shift @_; # warn "authid : $authid"; - my $force = shift @_; - my @globalresult; - my $dbh=C4::Context->dbh; - my $hierarchies; - my $data = GetHeaderAuthority($authid); - if ($data->{'authtrees'} and not $force){ - return $data->{'authtrees'}; + my $force = shift @_ || (C4::Context->preference('marcflavour') eq 'UNIMARC' ? 0 : 1); + my @globalresult; + my $dbh=C4::Context->dbh; + my $hierarchies; + my $data = GetHeaderAuthority($authid); + if ($data->{'authtrees'} and not $force){ + return $data->{'authtrees'}; # } elsif ($data->{'authtrees'}){ # $hierarchies=$data->{'authtrees'}; - } else { - my $record = GetAuthority($authid); - my $found; - return unless $record; - foreach my $field ($record->field('5..')){ - if ($field->subfield('5') && $field->subfield('5') eq 'g'){ - my $subfauthid=_get_authid_subfield($field); - next if ($subfauthid eq $authid); - my $parentrecord = GetAuthority($subfauthid); - my $localresult=$hierarchies; - my $trees; - $trees = BuildUnimarcHierarchies($subfauthid); - my @trees; - if ($trees=~/;/){ - @trees = split(/;/,$trees); - } else { - push @trees, $trees; - } - foreach (@trees){ - $_.= ",$authid"; + } else { + my $record = GetAuthority($authid); + my $found; + return unless $record; + foreach my $field ($record->field('5..')){ + my $broader = 0; + $broader = 1 if ( + (C4::Context->preference('marcflavour') eq 'UNIMARC' && $field->subfield('5') && $field->subfield('5') eq 'g') || + (C4::Context->preference('marcflavour') ne 'UNIMARC' && $field->subfield('w') && substr($field->subfield('w'), 0, 1) eq 'g')); + if ($broader) { + my $subfauthid=_get_authid_subfield($field) || ''; + next if ($subfauthid eq $authid); + my $parentrecord = GetAuthority($subfauthid); + next unless $parentrecord; + my $localresult=$hierarchies; + my $trees; + $trees = BuildAuthHierarchies($subfauthid); + my @trees; + if ($trees=~/;/){ + @trees = split(/;/,$trees); + } else { + push @trees, $trees; + } + foreach (@trees){ + $_.= ",$authid"; + } + @globalresult = (@globalresult,@trees); + $found=1; + } + $hierarchies=join(";",@globalresult); } - @globalresult = (@globalresult,@trees); - $found=1; - } - $hierarchies=join(";",@globalresult); +#Unless there is no ancestor, I am alone. + $hierarchies="$authid" unless ($hierarchies); } - #Unless there is no ancestor, I am alone. - $hierarchies="$authid" unless ($hierarchies); - } - AddAuthorityTrees($authid,$hierarchies); - return $hierarchies; + AddAuthorityTrees($authid,$hierarchies); + return $hierarchies; } -=head2 BuildUnimarcHierarchy +=head2 BuildAuthHierarchy - $ref= &BuildUnimarcHierarchy( $record, $class,$authid) + $ref= &BuildAuthHierarchy( $record, $class,$authid) return a hashref in order to display hierarchy for record and final Authid $authid @@ -1212,42 +1286,101 @@ return a hashref in order to display hierarchy for record and final Authid $auth "current_value" "value" -"ifparents" -"ifchildren" -Those two latest ones should disappear soon. +=cut + +sub BuildAuthHierarchy{ + my $record = shift @_; + my $class = shift @_; + my $authid_constructed = shift @_; + return unless ($record && $record->field('001')); + my $authid=$record->field('001')->data(); + my %cell; + my $parents=""; my $children=""; + my (@loopparents,@loopchildren); + my $marcflavour = C4::Context->preference('marcflavour'); + my $relationshipsf = $marcflavour eq 'UNIMARC' ? '5' : 'w'; + foreach my $field ($record->field('5..')){ + my $subfauthid=_get_authid_subfield($field); + if ($subfauthid && $field->subfield($relationshipsf) && $field->subfield('a')){ + my $relationship = substr($field->subfield($relationshipsf), 0, 1); + if ($relationship eq 'h'){ + push @loopchildren, { "authid"=>$subfauthid,"value"=>$field->subfield('a')}; + } + elsif ($relationship eq 'g'){ + push @loopparents, { "authid"=>$subfauthid,"value"=>$field->subfield('a')}; + } +# brothers could get in there with an else + } + } + $cell{"parents"}=\@loopparents; + $cell{"children"}=\@loopchildren; + $cell{"class"}=$class; + $cell{"authid"}=$authid; + $cell{"current_value"} =1 if ($authid eq $authid_constructed); + $cell{"value"}=C4::Context->preference('marcflavour') eq 'UNIMARC' ? $record->subfield('2..',"a") : $record->subfield('1..', 'a'); + return \%cell; +} + +=head2 BuildAuthHierarchyBranch + + $branch = &BuildAuthHierarchyBranch( $tree, $authid[, $cnt]) + +Return a data structure representing an authority hierarchy +given a list of authorities representing a single branch in +an authority hierarchy tree. $authid is the current node in +the tree (which may or may not be somewhere in the middle). +$cnt represents the level of the upper-most item, and is only +used when BuildAuthHierarchyBranch is called recursively (i.e., +don't ever pass in anything but zero to it). =cut -sub BuildUnimarcHierarchy{ - my $record = shift @_; - my $class = shift @_; - my $authid_constructed = shift @_; - return undef unless ($record); - my $authid=$record->field('001')->data(); - my %cell; - my $parents=""; my $children=""; - my (@loopparents,@loopchildren); - foreach my $field ($record->field('5..')){ - my $subfauthid=_get_authid_subfield($field); - if ($subfauthid && $field->subfield('5') && $field->subfield('a')){ - if ($field->subfield('5') eq 'h'){ - push @loopchildren, { "childauthid"=>$field->subfield('3'),"childvalue"=>$field->subfield('a')}; - } - elsif ($field->subfield('5') eq 'g'){ - push @loopparents, { "parentauthid"=>$field->subfield('3'),"parentvalue"=>$field->subfield('a')}; - } - # brothers could get in there with an else - } - } - $cell{"ifparents"}=1 if (scalar(@loopparents)>0); - $cell{"ifchildren"}=1 if (scalar(@loopchildren)>0); - $cell{"loopparents"}=\@loopparents if (scalar(@loopparents)>0); - $cell{"loopchildren"}=\@loopchildren if (scalar(@loopchildren)>0); - $cell{"class"}=$class; - $cell{"loopauthid"}=$authid; - $cell{"current_value"} =1 if $authid eq $authid_constructed; - $cell{"value"}=$record->subfield('2..',"a"); - return \%cell; +sub BuildAuthHierarchyBranch { + my ($tree, $authid, $cnt) = @_; + $cnt |= 0; + my $elementdata = GetAuthority(shift @$tree); + my $branch = BuildAuthHierarchy($elementdata,"child".$cnt, $authid); + if (scalar @$tree > 0) { + my $nextBranch = BuildAuthHierarchyBranch($tree, $authid, ++$cnt); + my $nextAuthid = $nextBranch->{authid}; + my $found; + # If we already have the next branch listed as a child, let's + # replace the old listing with the new one. If not, we will add + # the branch at the end. + foreach my $cell (@{$branch->{children}}) { + if ($cell->{authid} eq $nextAuthid) { + $cell = $nextBranch; + $found = 1; + last; + } + } + push @{$branch->{children}}, $nextBranch unless $found; + } + return $branch; +} + +=head2 GenerateHierarchy + + $hierarchy = &GenerateHierarchy($authid); + +Return an arrayref holding one or more "trees" representing +authority hierarchies. + +=cut + +sub GenerateHierarchy { + my ($authid) = @_; + my $trees = BuildAuthHierarchies($authid); + my @trees = split /;/,$trees ; + push @trees,$trees unless (@trees); + my @loophierarchies; + foreach my $tree (@trees){ + my @tree=split /,/,$tree; + push @tree, $tree unless (@tree); + my $branch = BuildAuthHierarchyBranch(\@tree, $authid); + push @loophierarchies, [ $branch ]; + } + return \@loophierarchies; } sub _get_authid_subfield{ @@ -1323,47 +1456,32 @@ sub merge { 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" )); - $rq->execute; - while (my $biblionumbers=$rq->fetchrow){ - my @biblionumbers=split /;/,$biblionumbers; - foreach (@biblionumbers) { - if ($_=~/(\d+),.*/) { - my $marc=GetMarcBiblio($1); - push @reccache,$marc; - } - } - } - } else { - #zebra connection - my $oConnection=C4::Context->Zconn("biblioserver",0); - my $oldSyntax = $oConnection->option("preferredRecordSyntax"); - $oConnection->option("preferredRecordSyntax"=>"XML"); - 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_xml($marcdata,"utf8",C4::Context->preference("marcflavour")); - 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++; - } - $oResult->destroy(); - $oConnection->option("preferredRecordSyntax"=>$oldSyntax); + #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 $marcrecordzebra = C4::Search::new_record_from_zebra( + 'biblioserver', + $oResult->record($z)->raw() + ); + 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++; } + $oResult->destroy(); #warn scalar(@reccache)." biblios to update"; # Get All candidate Tags for the change # (This will reduce the search scope in marc records). @@ -1387,12 +1505,13 @@ sub merge { 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 (@record_to) { + foreach my $subfield (grep {$_->[0] ne '9'} @record_to) { $field_to->add_subfields($subfield->[0] =>$subfield->[1]); $exclude.= $subfield->[0]; }