use MARC::Record;
use C4::Biblio;
use C4::Search;
-#use ZOOM;
+
use vars qw($VERSION @ISA @EXPORT);
# set the version for version checking
@ISA = qw(Exporter);
@EXPORT = qw(
- &AUTHgettagslib
- &AUTHfindsubfield
- &AUTHfind_authtypecode
-
- &AUTHaddauthority
- &AUTHmodauthority
- &AUTHdelauthority
- &AUTHaddsubfield
- &AUTHgetauthority
- &AUTHfind_marc_from_kohafield
- &AUTHgetauth_type
- &AUTHcount_usage
- &getsummary
- &authoritysearch
- &XMLgetauthority
-
+ &GetTagsLabels
+ &GetAuthType
+ &GetAuthTypeCode
+ &GetAuthMARCFromKohaField
&AUTHhtml2marc
+
+ &AddAuthority
+ &ModAuthority
+ &DelAuthority
+ &GetAuthority
+ &GetAuthorityXML
+
+ &CountUsage
+ &CountUsageChildren
+ &SearchAuthorities
+
+ &BuildSummary
&BuildUnimarcHierarchies
&BuildUnimarcHierarchy
+
&merge
- &FindDuplicate
+ &FindDuplicateAuthority
);
-sub AUTHfind_marc_from_kohafield {
+=head2 GetAuthMARCFromKohaField
+
+=over 4
+
+( $tag, $subfield ) = &GetAuthMARCFromKohaField ($kohafield,$authtypecode);
+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 ) = @_;
my $dbh=C4::Context->dbh;
return 0, 0 unless $kohafield;
return ($tagfield,$tagsubfield);
}
-sub authoritysearch {
+=head2 SearchAuthorities
+
+=over 4
+
+(\@finalresult, $nbresults)= &SearchAuthorities($tags, $and_or, $excluding, $operator, $value, $offset,$length,$authtypecode,$sortby)
+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) = @_;
my $dbh=C4::Context->dbh;
my $query;
}
##Add how many queries generated
$query= $and.$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");
warn $query;
my $i;
$oAuth[0]=C4::Context->Zconn("authorityserver" , 1);
my $Anewq= new ZOOM::Query::PQF($query,$oAuth[0]);
- # $Anewq->sortby("1=Heading i< 1=Heading-Entity i< ");
- # $Anewq->sortby("1=Heading i< 1=Heading-Entity i< ");
my $oAResult;
$oAResult= $oAuth[0]->search($Anewq) ;
while (($i = ZOOM::event(\@oAuth)) != 0) {
my $ev = $oAuth[$i-1]->last_event();
- # warn("Authority ", $i-1, ": event $ev (", ZOOM::event_str($ev), ")\n");
last if $ev == ZOOM::Event::ZEND;
}
my($error, $errmsg, $addinfo, $diagset) = $oAuth[0]->error_x();
##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)=AUTHfind_marc_from_kohafield($dbh,"auth_header.authid",$authtypecode[0]);
- # my ($linkidfield,$linkidsubfield)=AUTHfind_marc_from_kohafield($dbh,"auth_header.linkid",$authtypecode[0]);
+ # 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 $linkid;
- my @linkids;
my $separator=C4::Context->preference('authoritysep');
- my $linksummary=" ".$separator;
-
- $authrecord = MARC::File::USMARC::decode($marcdata);
-
+ $authrecord = MARC::File::USMARC::decode($marcdata);
my $authid=$authrecord->field('001')->data();
- # if ($authrecord->field($linkidfield)){
- # my @fields=$authrecord->field($linkidfield);
- #
- # # foreach my $field (@fields){
- # # # $linkid=$field->subfield($linkidsubfield) ;
- # # # if ($linkid){ ##There is a linked record add fields to produce summary
- # # # my $linktype=AUTHfind_authtypecode($dbh,$linkid);
- # # # my $linkrecord=AUTHgetauthority($dbh,$linkid);
- # # # $linksummary.="<br> <a href='detail.pl?authid=$linkid'>".getsummary($dbh,$linkrecord,$linkid,$linktype).".</a>".$separator;
- # # # }
- # # }
- # }#
-
- my $summary=getsummary($authrecord,$authid,$authtypecode);
- # $summary="<a href='detail.pl?authid=$authid'>".$summary.".</a>" if ($intranet);
- # $summary="<a href='detail.pl?authid=$authid'>".$summary.".</a>" if ($intranet);
- # if ($linkid && $linksummary ne " ".$separator){
- # $summary="<b>".$summary."</b>".$linksummary;
- # }
- 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{summary} = $summary;
- $newline{authid} = $authid;
- # $newline{linkid} = $linkid;
- # $newline{reported_tag} = $reported_tag;
- # $newline{used} =0;
- # $newline{biblio_fields} = $tags_using_authtype;
- $newline{even} = $counter % 2;
- $counter++;
- push @finalresult, \%newline;
+ 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{summary} = $summary;
+ $newline{authid} = $authid;
+ $newline{even} = $counter % 2;
+ $counter++;
+ push @finalresult, \%newline;
}## while counter
###
for (my $z=0; $z<@finalresult; $z++){
- my $count=AUTHcount_usage($finalresult[$z]{authid});
+ my $count=CountUsage($finalresult[$z]{authid});
$finalresult[$z]{used}=$count;
}# all $z's
return (\@finalresult, $nbresults);
}
-sub AUTHcount_usage {
+=head2 CountUsage
+
+=over 4
+
+$count= &CountUsage($authid)
+counts Usage of Authid in bibliorecords.
+
+=back
+
+=cut
+sub CountUsage {
my ($authid) = @_;
### try ZOOM search here
my $oConnection=C4::Context->Zconn("biblioserver",1);
return ($result);
}
-sub AUTHfind_authtypecode {
+=head2 CountUsageChildren
+
+=over 4
+
+$count= &CountUsageChildren($authid)
+counts Usage of narrower terms of Authid in bibliorecords.
+
+=back
+
+=cut
+sub CountUsageChildren {
+ my ($authid) = @_;
+}
+
+=head2 GetAuthTypeCode
+
+=over 4
+
+$authtypecode= &GetAuthTypeCode($authid)
+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=?");
return $authtypecode;
}
-sub AUTHgettagslib {
+=head2 GetTagsLabels
+
+=over 4
+
+$tagslabel= &GetTagsLabels($forlibrarian,$authtypecode)
+returns a ref to hashref of authorities tag and subfield structure.
+
+tagslabel usage :
+$tagslabel->{$tag}->{$subfield}->{'attribute'}
+where attribute takes values in :
+ lib
+ tab
+ mandatory
+ repeatable
+ authorised_value
+ authtypecode
+ value_builder
+ kohafield
+ seealso
+ hidden
+ isurl
+ link
+
+=back
+
+=cut
+sub GetTagsLabels {
my ($forlibrarian,$authtypecode)= @_;
my $dbh=C4::Context->dbh;
$authtypecode="" unless $authtypecode;
return $res;
}
-sub AUTHaddauthority {
+=head2 AddAuthority
+
+=over 4
+
+$authid= &AddAuthority($record, $authid,$authtypecode)
+returns authid of the newly created authority
+
+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) = @_;
my $dbh=C4::Context->dbh;
my $leader=' a ';##Fixme correct leader as this one just adds utf8 to MARC21
-#substr($leader,8,1)=$leadercode;
-# $record->leader($leader);
-# my ($authfield,$authidsubfield)=AUTHfind_marc_from_kohafield($dbh,"auth_header.authid",$authtypecode);
-# my ($authfield2,$authtypesubfield)=AUTHfind_marc_from_kohafield($dbh,"auth_header.authtypecode",$authtypecode);
-# my ($linkidfield,$linkidsubfield)=AUTHfind_marc_from_kohafield($dbh,"auth_header.linkid",$authtypecode);
# if authid empty => true add, find a new authid number
if (!$authid) {
##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');
- # $record->add_fields('100','','','b'=>$authtypecode);
warn $record->as_formatted;
$dbh->do("lock tables auth_header WRITE");
$sth=$dbh->prepare("insert into auth_header (authid,datecreated,authtypecode,marc) values (?,now(),?,?)");
$sth->execute($authid,$authtypecode,$record->as_usmarc);
$sth->finish;
-
}else{
- ##Modified record reinsertid
-# my $idfield=$record->field('001');
-# $record->delete_field($idfield);
$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'));
-# $record->add_fields($authfield,$authid);
-# $record->add_fields($authfield2,'','',$authtypesubfield=>$authtypecode);
-# warn $record->as_formatted;
$dbh->do("lock tables auth_header WRITE");
my $sth=$dbh->prepare("update auth_header set marc=? where authid=?");
$sth->execute($record->as_usmarc,$authid);
$sth->finish;
- }
- $dbh->do("unlock tables");
- ModZebra($authid,'specialUpdate',"authorityserver");
+ }
+ $dbh->do("unlock tables");
+ ModZebra($authid,'specialUpdate',"authorityserver");
- return ($authid);
+ return ($authid);
}
-sub XMLgetauthority {
- # Returns MARC::XML of the authority passed in parameter.
+=head2 DelAuthority
+
+=over 4
+
+$authid= &DelAuthority($authid)
+Deletes $authid
+
+=back
+
+=cut
+
+
+sub DelAuthority {
+ my ($authid) = @_;
+ my $dbh=C4::Context->dbh;
+
+ ModZebra($authid,"recordDelete","authorityserver");
+ $dbh->do("delete from auth_header where authid=$authid") ;
+
+}
+
+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=? where authid=?");
+ #Now rewrite the $record to table with an add
+ $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
+ my $cgidir = C4::Context->intranetdir ."/cgi-bin";
+ unless (opendir(DIR,"$cgidir")) {
+ $cgidir = C4::Context->intranetdir."/";
+ }
+
+ my $filename = $cgidir."/localfile/modified_authorities/$authid.authid";
+ open AUTH, "> $filename";
+ print AUTH $authid;
+ close AUTH;
+ } else {
+ &merge($authid,$record,$authid,$record);
+ }
+ return $authid;
+}
+
+=head2 GetAuthorityXML
+
+=over 4
+
+$marcxml= &GetAuthorityXML( $authid)
+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 =
}
-sub AUTHgetauthority {
-# Returns MARC::Record of the biblio passed in parameter.
+=head2 GetAuthority
+
+=over 4
+
+$record= &GetAuthority( $authid)
+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 marc from auth_header where authid=?");
$sth->execute($authid);
my ($marc) = $sth->fetchrow;
my $record=MARC::File::USMARC::decode($marc);
-
return ($record);
}
-sub AUTHgetauth_type {
- my ($authtypecode) = @_;
- my $dbh=C4::Context->dbh;
- my $sth=$dbh->prepare("select * from auth_types where authtypecode=?");
- $sth->execute($authtypecode);
- return $sth->fetchrow_hashref;
-}
+=head2 GetAuthType
-sub AUTHmodauthority {
- my ($authid,$record,$authtypecode,$merge)=@_;
- my $dbh=C4::Context->dbh;
- my ($oldrecord)=&AUTHgetauthority($authid);
- if ($oldrecord eq $record) {
- return;
- }
-my $sth=$dbh->prepare("update auth_header set marc=? where authid=?");
-#warn find if linked records exist and delete them
-my($linkidfield,$linkidsubfield)=AUTHfind_marc_from_kohafield("auth_header.linkid",$authtypecode);
-
-if ($oldrecord->field($linkidfield)){
-my @fields=$oldrecord->field($linkidfield);
- foreach my $field (@fields){
-my $linkid=$field->subfield($linkidsubfield) ;
- if ($linkid){
- ##Modify the record of linked
- my $linkrecord=AUTHgetauthority($linkid);
- my $linktypecode=AUTHfind_authtypecode($linkid);
- my ( $linkidfield2,$linkidsubfield2)=AUTHfind_marc_from_kohafield("auth_header.linkid",$linktypecode);
- my @linkfields=$linkrecord->field($linkidfield2);
- foreach my $linkfield (@linkfields){
- if ($linkfield->subfield($linkidsubfield2) eq $authid){
- $linkrecord->delete_field($linkfield);
- $sth->execute($linkrecord->as_usmarc,$linkid);
- ModZebra($linkid,'specialUpdate',"authorityserver");
- }
- }#foreach linkfield
- }
- }#foreach linkid
-}
-#Now rewrite the $record to table with an add
-$authid=AUTHaddauthority($record,$authid,$authtypecode);
+=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
-### 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
+=back
-if (C4::Context->preference('dontmerge') ){
-# save the file in localfile/modified_authorities
- my $cgidir = C4::Context->intranetdir ."/cgi-bin";
- unless (opendir(DIR,"$cgidir")) {
- $cgidir = C4::Context->intranetdir."/";
+=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;
}
-
- my $filename = $cgidir."/localfile/modified_authorities/$authid.authid";
- open AUTH, "> $filename";
- print AUTH $authid;
- close AUTH;
-} else {
- &merge($authid,$record,$authid,$record);
-}
-return $authid;
}
-sub AUTHdelauthority {
- my ($authid,$keep_biblio) = @_;
- my $dbh=C4::Context->dbh;
-# if the keep_biblio is set to 1, then authority entries in biblio are preserved.
-
-ModZebra($authid,"recordDelete","authorityserver");
- $dbh->do("delete from auth_header where authid=$authid") ;
-
-}
sub AUTHhtml2marc {
my ($rtags,$rsubfields,$rvalues,%indicators) = @_;
return $record;
}
+=head2 FindDuplicateAuthority
+
+=over 4
+
+$record= &FindDuplicateAuthority( $record, $authtypecode)
+return $authid,Summary if duplicate is found.
+
+Comments : an improvement would be to return All the records that match.
-sub FindDuplicate {
+=back
+
+=cut
+
+sub FindDuplicateAuthority {
my ($record,$authtypecode)=@_;
# warn "IN for ".$record->as_formatted;
$sth->execute($authtypecode);
my ($auth_tag_to_report) = $sth->fetchrow;
$sth->finish;
-# warn "record :".$record->as_formatted." authtattoreport :$auth_tag_to_report";
- # build a request for authoritysearch
+# 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");
# there is at least 1 result => return the 1st one
if (@$results>0) {
my $marcrecord = MARC::File::USMARC::decode($results->[0]);
- return $marcrecord->field('001')->data,getsummary($marcrecord,$marcrecord->field('001')->data,$authtypecode);
+ return $marcrecord->field('001')->data,BuildSummary($marcrecord,$marcrecord->field('001')->data,$authtypecode);
}
# no result, returns nothing
return;
}
-sub getsummary{
-## give this a Marc record to return summary
-my ($record,$authid,$authtypecode)=@_;
-
-my $dbh=C4::Context->dbh;
-# my $authtypecode = AUTHfind_authtypecode($dbh,$authid);
- my $authref = getauthtype($authtypecode);
- my $summary = $authref->{summary};
- my @fields = $record->fields();
-# chop $tags_using_authtype; # FIXME: why commented out?
- my $reported_tag;
-
- # if the library has a summary defined, use it. Otherwise, build a standard one
- if ($summary) {
- my @fields = $record->fields();
-# $reported_tag = '$9'.$result[$counter];
- foreach my $field (@fields) {
- my $tag = $field->tag();
- my $tagvalue = $field->as_string();
- $summary =~ s/\[(.?.?.?.?)$tag\*(.*?)]/$1$tagvalue$2\[$1$tag$2]/g;
- if ($tag<10) {
- if ($tag eq '001') {
- $reported_tag.='$3'.$field->data();
- }
+=head2 BuildSummary
- } else {
- my @subf = $field->subfields;
- for my $i (0..$#subf) {
- my $subfieldcode = $subf[$i][0];
- my $subfieldvalue = $subf[$i][1];
- my $tagsubf = $tag.$subfieldcode;
- $summary =~ s/\[(.?.?.?.?)$tagsubf(.*?)]/$1$subfieldvalue$2\[$1$tagsubf$2]/g;
-# if ($tag eq $auth_tag_to_report) {
-# $reported_tag.='$'.$subfieldcode.$subfieldvalue;
-# }
- }
- }
- }
- $summary =~ s/\[(.*?)]//g;
- $summary =~ s/\n/<br>/g;
- } else {
- my $heading; # = $authref->{summary};
- my $altheading;
- my $seeheading;
- my $see;
- my @fields = $record->fields();
- 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..')) {
- $heading.= $field->as_string();
- }
- # rejected form(s)
- foreach my $field ($record->field('4..')) {
- $summary.= " <i>".$field->as_string()."</i><br/>";
- $summary.= " <i>see:</i> ".$heading."<br/>";
- }
- # see :
- foreach my $field ($record->field('5..')) {
- $summary.= " <i>".$field->as_string()."</i><br/>";
- $summary.= " <i>see:</i> ".$heading."<br/>";
- }
- # // form
- foreach my $field ($record->field('7..')) {
- $seeheading.= " <i>see also:</i> ".$field->as_string()."<br />";
- $altheading.= " ".$field->as_string()."<br />";
- $altheading.= " <i>see also:</i> ".$heading."<br />";
- }
- $summary = "<b>".$heading."</b><br />".$seeheading.$altheading.$summary;
- } else {
- # construct MARC21 summary
- foreach my $field ($record->field('1..')) {
- if ($record->field('100')) {
- $heading.= $field->as_string('abcdefghjklmnopqrstvxyz68');
- } elsif ($record->field('110')) {
- $heading.= $field->as_string('abcdefghklmnoprstvxyz68');
- } elsif ($record->field('111')) {
- $heading.= $field->as_string('acdefghklnpqstvxyz68');
- } elsif ($record->field('130')) {
- $heading.= $field->as_string('adfghklmnoprstvxyz68');
- } elsif ($record->field('148')) {
- $heading.= $field->as_string('abvxyz68');
- } elsif ($record->field('150')) {
- # $heading.= $field->as_string('abvxyz68');
- $heading.= $field->as_formatted();
- my $tag=$field->tag();
- $heading=~s /^$tag//g;
- $heading =~s /\_/\$/g;
- } elsif ($record->field('151')) {
- $heading.= $field->as_string('avxyz68');
- } elsif ($record->field('155')) {
- $heading.= $field->as_string('abvxyz68');
- } elsif ($record->field('180')) {
- $heading.= $field->as_string('vxyz68');
- } elsif ($record->field('181')) {
- $heading.= $field->as_string('vxyz68');
- } elsif ($record->field('182')) {
- $heading.= $field->as_string('vxyz68');
- } elsif ($record->field('185')) {
- $heading.= $field->as_string('vxyz68');
- } else {
- $heading.= $field->as_string();
- }
- } #See From
- foreach my $field ($record->field('4..')) {
- $seeheading.= " ".$field->as_string()."<br />";
- $seeheading.= " <i>see:</i> ".$seeheading."<br />";
- } #See Also
- foreach my $field ($record->field('5..')) {
- $altheading.= " <i>see also:</i> ".$field->as_string()."<br />";
- $altheading.= " ".$field->as_string()."<br />";
- $altheading.= " <i>see also:</i> ".$altheading."<br />";
- }
- $summary.=$heading.$seeheading.$altheading;
- }
+=over 4
+
+$text= &BuildSummary( $record, $authid, $authtypecode)
+return HTML encoded Summary
+
+Comment : authtypecode can be infered from both record and authid.
+Moreover, authid can also be inferred from $record.
+Would it be interesting to delete those things.
+
+=back
+
+=cut
+
+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 @fields = $record->fields();
+ my $reported_tag;
+ # if the library has a summary defined, use it. Otherwise, build a standard one
+ if ($summary) {
+ my @fields = $record->fields();
+ # $reported_tag = '$9'.$result[$counter];
+ foreach my $field (@fields) {
+ my $tag = $field->tag();
+ my $tagvalue = $field->as_string();
+ $summary =~ s/\[(.?.?.?.?)$tag\*(.*?)]/$1$tagvalue$2\[$1$tag$2]/g;
+ if ($tag<10) {
+ if ($tag eq '001') {
+ $reported_tag.='$3'.$field->data();
+ }
+ } else {
+ my @subf = $field->subfields;
+ for my $i (0..$#subf) {
+ my $subfieldcode = $subf[$i][0];
+ my $subfieldvalue = $subf[$i][1];
+ my $tagsubf = $tag.$subfieldcode;
+ $summary =~ s/\[(.?.?.?.?)$tagsubf(.*?)]/$1$subfieldvalue$2\[$1$tagsubf$2]/g;
}
+ }
+ }
+ $summary =~ s/\[(.*?)]//g;
+ $summary =~ s/\n/<br>/g;
+ } else {
+ my $heading; # = $authref->{summary};
+ my $altheading;
+ my $seeheading;
+ my $see;
+ my @fields = $record->fields();
+ 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..')) {
+ $heading.= $field->as_string();
+ }
+ # rejected form(s)
+ foreach my $field ($record->field('4..')) {
+ $summary.= " <i>".$field->as_string()."</i><br/>";
+ $summary.= " <i>see:</i> ".$heading."<br/>";
+ }
+ # see :
+ foreach my $field ($record->field('5..')) {
+ $summary.= " <i>".$field->as_string()."</i><br/>";
+ $summary.= " <i>see:</i> ".$heading."<br/>";
+ }
+ # // form
+ foreach my $field ($record->field('7..')) {
+ $seeheading.= " <i>see also:</i> ".$field->as_string()."<br />";
+ $altheading.= " ".$field->as_string()."<br />";
+ $altheading.= " <i>see also:</i> ".$heading."<br />";
+ }
+ $summary = "<b>".$heading."</b><br />".$seeheading.$altheading.$summary;
+ } else {
+ # construct MARC21 summary
+ foreach my $field ($record->field('1..')) {
+ if ($record->field('100')) {
+ $heading.= $field->as_string('abcdefghjklmnopqrstvxyz68');
+ } elsif ($record->field('110')) {
+ $heading.= $field->as_string('abcdefghklmnoprstvxyz68');
+ } elsif ($record->field('111')) {
+ $heading.= $field->as_string('acdefghklnpqstvxyz68');
+ } elsif ($record->field('130')) {
+ $heading.= $field->as_string('adfghklmnoprstvxyz68');
+ } elsif ($record->field('148')) {
+ $heading.= $field->as_string('abvxyz68');
+ } elsif ($record->field('150')) {
+ # $heading.= $field->as_string('abvxyz68');
+ $heading.= $field->as_formatted();
+ my $tag=$field->tag();
+ $heading=~s /^$tag//g;
+ $heading =~s /\_/\$/g;
+ } elsif ($record->field('151')) {
+ $heading.= $field->as_string('avxyz68');
+ } elsif ($record->field('155')) {
+ $heading.= $field->as_string('abvxyz68');
+ } elsif ($record->field('180')) {
+ $heading.= $field->as_string('vxyz68');
+ } elsif ($record->field('181')) {
+ $heading.= $field->as_string('vxyz68');
+ } elsif ($record->field('182')) {
+ $heading.= $field->as_string('vxyz68');
+ } elsif ($record->field('185')) {
+ $heading.= $field->as_string('vxyz68');
+ } else {
+ $heading.= $field->as_string();
+ }
+ } #See From
+ foreach my $field ($record->field('4..')) {
+ $seeheading.= " ".$field->as_string()."<br />";
+ $seeheading.= " <i>see:</i> ".$seeheading."<br />";
+ } #See Also
+ foreach my $field ($record->field('5..')) {
+ $altheading.= " <i>see also:</i> ".$field->as_string()."<br />";
+ $altheading.= " ".$field->as_string()."<br />";
+ $altheading.= " <i>see also:</i> ".$altheading."<br />";
+ }
+ $summary.=$heading.$seeheading.$altheading;
+ }
+ }
return $summary;
}
+=head2 BuildUnimarcHierarchies
+
+=over 4
+
+$text= &BuildUnimarcHierarchies( $authid, $force)
+return text containing trees for hierarchies
+for them to be stored in auth_header
+
+Example of text:
+122,1314,2452;1324,2342,3,2452
+
+=back
+
+=cut
sub BuildUnimarcHierarchies{
my $authid = shift @_;
# warn "authid : $authid";
my @globalresult;
my $dbh=C4::Context->dbh;
my $hierarchies;
- my $data = AUTHgetheader($authid);
-
+ my $data = GetHeaderAuthority($authid);
if ($data->{'authtrees'} and not $force){
return $data->{'authtrees'};
} elsif ($data->{'authtrees'}){
$hierarchies=$data->{'authtrees'};
} else {
- my $record = AUTHgetauthority($authid);
+ my $record = GetAuthority($authid);
my $found;
foreach my $field ($record->field('550')){
if ($field->subfield('5') && $field->subfield('5') eq 'g'){
- my $parentrecord = AUTHgetauthority($field->subfield('3'));
+ my $parentrecord = GetAuthority($field->subfield('3'));
my $localresult=$hierarchies;
my $trees;
$trees = BuildUnimarcHierarchies($field->subfield('3'));
#Unless there is no ancestor, I am alone.
$hierarchies="$authid" unless ($hierarchies);
}
- AUTHsavetrees($authid,$hierarchies);
+ AddAuthorityTrees($authid,$hierarchies);
return $hierarchies;
}
+=head2 BuildUnimarcHierarchy
+
+=over 4
+
+$ref= &BuildUnimarcHierarchy( $record, $class,$authid)
+return a hashref in order to display hierarchy for record and final Authid $authid
+
+"loopparents"
+"loopchildren"
+"class"
+"loopauthid"
+"current_value"
+"value"
+
+"ifparents"
+"ifchildren"
+Those two latest ones should disappear soon.
+
+=back
+
+=cut
sub BuildUnimarcHierarchy{
- my $record = shift @_;
- my $class = shift @_;
- my $authid_constructed = shift @_;
- my $authid=$record->subfield('250','3');
- my %cell;
- my $parents=""; my $children="";
- my (@loopparents,@loopchildren);
- foreach my $field ($record->field('550')){
- if ($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('250',"a");
- return \%cell;
+ my $record = shift @_;
+ my $class = shift @_;
+ my $authid_constructed = shift @_;
+ my $authid=$record->subfield('250','3');
+ my %cell;
+ my $parents=""; my $children="";
+ my (@loopparents,@loopchildren);
+ foreach my $field ($record->field('550')){
+ if ($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('250',"a");
+ return \%cell;
}
-sub AUTHgetheader{
- my $authid = shift @_;
- my $sql= "SELECT * from auth_header WHERE authid = ?";
- my $dbh=C4::Context->dbh;
- my $rq= $dbh->prepare($sql);
- $rq->execute($authid);
- my $data= $rq->fetchrow_hashref;
- return $data;
+=head2 GetHeaderAuthority
+
+=over 4
+
+$ref= &GetHeaderAuthority( $authid)
+return a hashref in order auth_header table data
+
+=back
+
+=cut
+sub GetHeaderAuthority{
+ my $authid = shift @_;
+ my $sql= "SELECT * from auth_header WHERE authid = ?";
+ my $dbh=C4::Context->dbh;
+ my $rq= $dbh->prepare($sql);
+ $rq->execute($authid);
+ my $data= $rq->fetchrow_hashref;
+ return $data;
}
-sub AUTHsavetrees{
- my $authid = shift @_;
- my $trees = shift @_;
- my $sql= "UPDATE IGNORE auth_header set authtrees=? WHERE authid = ?";
- my $dbh=C4::Context->dbh;
- my $rq= $dbh->prepare($sql);
- $rq->execute($trees,$authid);
+=head2 AddAuthorityTrees
+
+=over 4
+
+$ref= &AddAuthorityTrees( $authid, $trees)
+return success or failure
+
+=back
+
+=cut
+
+sub AddAuthorityTrees{
+ my $authid = shift @_;
+ my $trees = shift @_;
+ my $sql= "UPDATE IGNORE auth_header set authtrees=? WHERE authid = ?";
+ my $dbh=C4::Context->dbh;
+ my $rq= $dbh->prepare($sql);
+ return $rq->execute($trees,$authid);
}
+=head2 merge
+
+=over 4
+
+$ref= &merge(mergefrom,$MARCfrom,$mergeto,$MARCto)
+
+
+Could add some feature : Migrating from a typecode to an other for instance.
+Then we should add some new parameter : bibliotargettag, authtargettag
+
+=back
+
+=cut
sub merge {
my ($mergefrom,$MARCfrom,$mergeto,$MARCto) = @_;
my $dbh=C4::Context->dbh;
- my $authtypecodefrom = AUTHfind_authtypecode($mergefrom);
- my $authtypecodeto = AUTHfind_authtypecode($mergeto);
+ my $authtypecodefrom = GetAuthTypeCode($mergefrom);
+ my $authtypecodeto = GetAuthTypeCode($mergeto);
# return if authority does not exist
my @X = $MARCfrom->fields();
return if $#X == -1;
@X = $MARCto->fields();
return if $#X == -1;
-
-
# 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 @record_to;
@record_to = $MARCto->field($auth_tag_to_report)->subfields() if $MARCto->field($auth_tag_to_report);
my @record_from;
# 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;
+ my @tags_using_authtype;
while (my ($tagfield) = $sth->fetchrow) {
push @tags_using_authtype,$tagfield."9" ;
}
- # now, find every biblio using this authority
-### try ZOOM search here
-my $oConnection=C4::Context->Zconn("biblioserver");
-my $query;
-$query= "an= ".$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;
+ # now, find every biblio using this authority
+ my $oConnection=C4::Context->Zconn("biblioserver");
+ my $query;
+ $query= "an= ".$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]";
+ $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
+ }#for $subfield
}
- $marcrecord->delete_field($tag);
- $marcrecord->add_fields($tag);
+ $marcrecord->delete_field($tag);
+ $marcrecord->add_fields($tag);
$update=1;
- }#for each tag
+ }#for each tag
}#foreach tagfield
- my $oldbiblio = TransformMarcToKoha($dbh,$marcrecord,"") ;
- if ($update==1){
- # FIXME : this NEWmodbiblio does not exist anymore...
- &ModBiblio($marcrecord,$oldbiblio->{'biblionumber'},GetFrameworkCode($oldbiblio->{'biblionumber'})) ;
- }
-
-}#foreach $marc
+ my $oldbiblio = TransformMarcToKoha($dbh,$marcrecord,"") ;
+ if ($update==1){
+ &ModBiblio($marcrecord,$oldbiblio->{'biblionumber'},GetFrameworkCode($oldbiblio->{'biblionumber'})) ;
+ }
+
+ }#foreach $marc
+ # 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
END { } # module clean-up code here (global destructor)
# $Id$
# $Log$
+# Revision 1.45 2007/04/06 14:48:45 hdl
+# Code Cleaning : AuthoritiesMARC.
+#
# Revision 1.44 2007/04/05 12:17:55 btoumi
# add "sort by" with heading-entity in authorities search
#
#
# Revision 1.28.2.17 2007/02/05 13:16:08 hdl
# Removing Link from AuthoritiesMARC summary (caused a problem owed to the API differences between opac and intranet)
-# + removing $dbh in authoritysearch
+# + removing $dbh in SearchAuthorities
# + adding links in templates on summaries to go to full view.
# (no more links in popup authorities. or should we add it ?)
#
# Using search for an= for an authority-Number.
#
# Revision 1.28.2.12 2007/01/09 13:51:31 hdl
-# Bug Fixing : AUTHcount_usage used *synchronous* connection where biblio used ****asynchronous**** one.
+# Bug Fixing : CountUsage used *synchronous* connection where biblio used ****asynchronous**** one.
# First try to get it work.
#
# Revision 1.28.2.11 2007/01/05 14:37:26 btoumi
projects / koha-equinox.git / commitdiff