X-Git-Url: http://git.rot13.org/?a=blobdiff_plain;f=C4%2FAuthoritiesMarc.pm;h=aef8b6c60e7481cd069495e183978d73d3c31096;hb=198bae17b1ebd42f4c1ce3b21e13b7ad7b844b64;hp=d08786dd952f8fc885d5d2b317fad69959e4538f;hpb=9cfafb870edcd27658769b130e46869d3bddda83;p=koha.git diff --git a/C4/AuthoritiesMarc.pm b/C4/AuthoritiesMarc.pm index d08786dd95..aef8b6c60e 100644 --- a/C4/AuthoritiesMarc.pm +++ b/C4/AuthoritiesMarc.pm @@ -17,810 +17,1382 @@ package C4::AuthoritiesMarc; # Suite 330, Boston, MA 02111-1307 USA use strict; -require Exporter; use C4::Context; -use C4::Database; use C4::Koha; use MARC::Record; use C4::Biblio; +use C4::Search; +use C4::AuthoritiesMarc::MARC21; +use C4::AuthoritiesMarc::UNIMARC; +use C4::Charset; +use C4::Debug; use vars qw($VERSION @ISA @EXPORT); -# set the version for version checking -$VERSION = 0.01; - -@ISA = qw(Exporter); -@EXPORT = qw( - &AUTHgettagslib - &AUTHfindsubfield - &AUTHfind_authtypecode - - &AUTHaddauthority - &AUTHmodauthority - &AUTHdelauthority - &AUTHaddsubfield - &AUTHgetauthority - - &AUTHgetauth_type - - &authoritysearch - - &MARCmodsubfield - &AUTHhtml2marc - &AUTHaddword - &MARCaddword &MARCdelword - &char_decode - ); - -sub authoritysearch { - my ($dbh, $tags, $and_or, $excluding, $operator, $value, $offset,$length,$authtypecode) = @_; - # build the sql request. She will look like : - # select m1.bibid - # from auth_subfield_table as m1, auth_subfield_table as m2 - # where m1.authid=m2.authid and - # (m1.subfieldvalue like "Des%" and m2.subfieldvalue like "27%") - - # "Normal" statements - my @normal_tags = (); - my @normal_and_or = (); - my @normal_operator = (); - my @normal_value = (); - # Extracts the NOT statements from the list of statements - for(my $i = 0 ; $i <= $#{$value} ; $i++) - { - if(@$operator[$i] eq "contains") # if operator is contains, splits the words in separate requests - { - foreach my $word (split(/ /, @$value[$i])) - { - unless (C4::Context->stopwords->{uc($word)}) { #it's NOT a stopword => use it. Otherwise, ignore - my $tag = substr(@$tags[$i],0,3); - my $subf = substr(@$tags[$i],3,1); - push @normal_tags, @$tags[$i]; - push @normal_and_or, "and"; # assumes "foo" and "bar" if "foo bar" is entered - push @normal_operator, @$operator[$i]; - push @normal_value, $word; - } - } - } - else - { - push @normal_tags, @$tags[$i]; - push @normal_and_or, @$and_or[$i]; - push @normal_operator, @$operator[$i]; - push @normal_value, @$value[$i]; - } - } +BEGIN { + # set the version for version checking + $VERSION = 3.01; - # Finds the basic results without the NOT requests - my ($sql_tables, $sql_where1, $sql_where2) = create_request($dbh,\@normal_tags, \@normal_and_or, \@normal_operator, \@normal_value); + require Exporter; + @ISA = qw(Exporter); + @EXPORT = qw( + &GetTagsLabels + &GetAuthType + &GetAuthTypeCode + &GetAuthMARCFromKohaField + &AUTHhtml2marc - my $sth; + &AddAuthority + &ModAuthority + &DelAuthority + &GetAuthority + &GetAuthorityXML + + &CountUsage + &CountUsageChildren + &SearchAuthorities + + &BuildSummary + &BuildUnimarcHierarchies + &BuildUnimarcHierarchy + + &merge + &FindDuplicateAuthority + ); +} - if ($sql_where2) { - $sth = $dbh->prepare("select distinct m1.authid from auth_header,$sql_tables where m1.authid=auth_header.authid and auth_header.authtypecode=? and $sql_where2 and ($sql_where1)"); - warn "Q2 : select distinct m1.authid from auth_header,$sql_tables where m1.authid=auth_header.authid and auth_header.authtypecode=? and $sql_where2 and ($sql_where1)"; - } else { - $sth = $dbh->prepare("select distinct m1.authid from auth_header,$sql_tables where m1.authid=auth_header.authid and auth_header.authtypecode=? and $sql_where1"); - warn "Q : select distinct m1.authid from auth_header,$sql_tables where m1.authid=auth_header.authid and auth_header.authtypecode=? and $sql_where1"; - } - $sth->execute($authtypecode); - my @result = (); - while (my ($authid) = $sth->fetchrow) { - push @result,$authid; - } +=head2 GetAuthMARCFromKohaField - # we have authid list. Now, loads summary from [offset] to [offset]+[length] - my $counter = $offset; - my @finalresult = (); - my $oldline; - while (($counter <= $#result) && ($counter <= ($offset + $length))) { -# warn " HERE : $counter, $#result, $offset, $length"; - # get MARC::Record of the authority - my $record = AUTHgetauthority($dbh,$result[$counter]); - # then build the summary - my $authtypecode = AUTHfind_authtypecode($dbh,$result[$counter]); - my $authref = getauthtype($authtypecode); - my $summary = $authref->{summary}; - my @fields = $record->fields(); - foreach my $field (@fields) { - my $tag = $field->tag(); - if ($tag<10) { - } 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\[$1$tagsubf$2]$2$3/g; - } - } - } - $summary =~ s/\[(.*?)]//g; - $summary =~ s/\n/
/g; - - # find biblio MARC field using this authtypecode (to jump to biblio) - my $authtypecode = AUTHfind_authtypecode($dbh,$result[$counter]); - my $sth = $dbh->prepare("select distinct tagfield from marc_subfield_structure where authtypecode=?"); - $sth->execute($authtypecode); - my $tags_using_authtype; - while (my ($tagfield) = $sth->fetchrow) { -# warn "TAG : $tagfield"; - $tags_using_authtype.= $tagfield."9,"; - } - chop $tags_using_authtype; - - # then add a line for the template loop - my %newline; - $newline{summary} = $summary; - $newline{authid} = $result[$counter]; - $newline{used} = &AUTHcount_usage($result[$counter]); - $newline{biblio_fields} = $tags_using_authtype; - $counter++; - push @finalresult, \%newline; - } - my $nbresults = $#result + 1; - return (\@finalresult, $nbresults); +=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; + $authtypecode="" unless $authtypecode; + my $marcfromkohafield; + my $sth = $dbh->prepare("select tagfield,tagsubfield from auth_subfield_structure where kohafield= ? and authtypecode=? "); + $sth->execute($kohafield,$authtypecode); + my ($tagfield,$tagsubfield) = $sth->fetchrow; + + return ($tagfield,$tagsubfield); } -# Creates the SQL Request - -sub create_request { - my ($dbh,$tags, $and_or, $operator, $value) = @_; - - my $sql_tables; # will contain marc_subfield_table as m1,... - my $sql_where1; # will contain the "true" where - my $sql_where2 = "("; # will contain m1.authid=m2.authid - my $nb_active=0; # will contain the number of "active" entries. and entry is active is a value is provided. - my $nb_table=1; # will contain the number of table. ++ on each entry EXCEPT when an OR is provided. - - - for(my $i=0; $i<=@$value;$i++) { - if (@$value[$i]) { - $nb_active++; - if ($nb_active==1) { - if (@$operator[$i] eq "start") { - $sql_tables .= "auth_subfield_table as m$nb_table,"; - $sql_where1 .= "(m1.subfieldvalue like ".$dbh->quote("@$value[$i]%"); - if (@$tags[$i]) { - $sql_where1 .=" and m1.tag+m1.subfieldcode in (@$tags[$i])"; - } - $sql_where1.=")"; - } elsif (@$operator[$i] eq "contains") { - $sql_tables .= "auth_word as m$nb_table,"; - $sql_where1 .= "(m1.word like ".$dbh->quote("@$value[$i]%"); - if (@$tags[$i]) { - $sql_where1 .=" and m1.tagsubfield in (@$tags[$i])"; - } - $sql_where1.=")"; - } else { - - $sql_tables .= "auth_subfield_table as m$nb_table,"; - $sql_where1 .= "(m1.subfieldvalue @$operator[$i] ".$dbh->quote("@$value[$i]"); - if (@$tags[$i]) { - $sql_where1 .=" and m1.tag+m1.subfieldcode in (@$tags[$i])"; - } - $sql_where1.=")"; - } - } else { - if (@$operator[$i] eq "start") { - $nb_table++; - $sql_tables .= "auth_subfield_table as m$nb_table,"; - $sql_where1 .= "@$and_or[$i] (m$nb_table.subfieldvalue like ".$dbh->quote("@$value[$i]%"); - if (@$tags[$i]) { - $sql_where1 .=" and m$nb_table.tag+m$nb_table.subfieldcode in (@$tags[$i])"; - } - $sql_where1.=")"; - $sql_where2 .= "m1.authid=m$nb_table.authid and "; - } elsif (@$operator[$i] eq "contains") { - if (@$and_or[$i] eq 'and') { - $nb_table++; - $sql_tables .= "auth_word as m$nb_table,"; - $sql_where1 .= "@$and_or[$i] (m$nb_table.word like ".$dbh->quote("@$value[$i]%"); - if (@$tags[$i]) { - $sql_where1 .=" and m$nb_table.tagsubfield in(@$tags[$i])"; - } - $sql_where1.=")"; - $sql_where2 .= "m1.authid=m$nb_table.authid and "; - } else { - $sql_where1 .= "@$and_or[$i] (m$nb_table.word like ".$dbh->quote("@$value[$i]%"); - if (@$tags[$i]) { - $sql_where1 .=" and m$nb_table.tag+m$nb_table.subfieldid in (@$tags[$i])"; - } - $sql_where1.=")"; - $sql_where2 .= "m1.authid=m$nb_table.authid and "; - } - } else { - $nb_table++; - $sql_tables .= "auth_subfield_table as m$nb_table,"; - $sql_where1 .= "@$and_or[$i] (m$nb_table.subfieldvalue @$operator[$i] ".$dbh->quote(@$value[$i]); - if (@$tags[$i]) { - $sql_where1 .=" and m$nb_table.tag+m$nb_table.subfieldcode in (@$tags[$i])"; - } - $sql_where2 .= "m1.authid=m$nb_table.authid and "; - $sql_where1.=")"; - } - } +=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) = @_; +# warn "CALL : $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 $n=0; + my @authtypecode; + my @auths=split / /,$authtypecode ; + my @queries; + foreach my $auth (@auths){ + push @queries, " \@attr 1=authtype \@attr 5=100 ".$auth; ##No truncation on authtype + push @authtypecode ,$auth; + $n++; + } + if ($n>1){ + while ($n>1){$query= "\@or ".$query;$n--;} + } + + my $dosearch; + my $and=" \@and " ; + for(my $i = 0 ; $i <= $#{$value} ; $i++) + { + if (@$value[$i]){ + ##If mainentry search $a tag + if (@$tags[$i] eq "mainmainentry") { + + $attr =" \@attr 1=Heading-Main "; +# $attr =" \@attr 1=Heading "; + + }elsif (@$tags[$i] eq "mainentry") { + $attr =" \@attr 1=Heading "; + }else{ + $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 + } else { + $attr .=" \@attr 5=1 \@attr 4=6 ";## Word list, right truncated, anywhere + } + $attr =$attr."\"".@$value[$i]."\""; + push @queries, "$attr"; + $dosearch=1; + }#if value + } + ##Add how many queries generated + my $query; + foreach my $query_part (@queries){ + $query=($query?$and.$query_part.$query:$query_part); } - } + ## Adding order + #$query=' @or @attr 7=2 @attr 1=Heading 0 @or @attr 7=1 @attr 1=Heading 1'.$query if ($sortby eq "HeadingDsc"); + my $orderstring= ($sortby eq "HeadingAsc"? + '@attr 7=1 @attr 1=Heading 0' + : + $sortby eq "HeadingDsc"? + '@attr 7=2 @attr 1=Heading 0' + :'' + ); + $query=($dosearch?"\@or $orderstring $query":"\@or ".($query?"$and $query":"")." \@attr 1=_ALLRECORDS \@attr 2=103 '' $orderstring "); + $debug && warn $query; + + $offset=0 unless $offset; + my $counter = $offset; + $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))) { + + ##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 $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 $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 + ### + 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); + } +} - if($sql_where2 ne "(") # some datas added to sql_where2, processing - { - $sql_where2 = substr($sql_where2, 0, (length($sql_where2)-5)); # deletes the trailing ' and ' - $sql_where2 .= ")"; - } - else # no sql_where2 statement, deleting '(' - { - $sql_where2 = ""; - } - chop $sql_tables; # deletes the trailing ',' - - return ($sql_tables, $sql_where1, $sql_where2); +=head2 CountUsage + +=over 4 + +$count= &CountUsage($authid) +counts Usage of Authid in bibliorecords. + +=back + +=cut + +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 $oConnection=C4::Context->Zconn("biblioserver",1); + my $query; + $query= "an=".$authid; + my $oResult = $oConnection->search(new ZOOM::Query::CCL2RPN( $query, $oConnection )); + my $result; + while ((my $i = ZOOM::event([ $oConnection ])) != 0) { + my $ev = $oConnection->last_event(); + if ($ev == ZOOM::Event::ZEND) { + $result = $oResult->size(); + } + } + return ($result); + } } +=head2 CountUsageChildren -sub AUTHcount_usage { - my ($authid) = @_; - my $dbh = C4::Context->dbh; - # find MARC fields using this authtype - my $authtypecode = AUTHfind_authtypecode($dbh,$authid); - my $sth = $dbh->prepare("select distinct tagfield from marc_subfield_structure where authtypecode=?"); - $sth->execute($authtypecode); - my $tags_using_authtype; - while (my ($tagfield) = $sth->fetchrow) { -# warn "TAG : $tagfield"; - $tags_using_authtype.= "'".$tagfield."9',"; - } - chop $tags_using_authtype; - $sth = $dbh->prepare("select count(*) from marc_subfield_table where concat(tag,subfieldcode) in ($tags_using_authtype) and subfieldvalue=?"); -# warn "Q : select count(*) from marc_subfield_table where concat(tag,subfieldcode) in ($tags_using_authtype) and subfieldvalue=$authid"; - $sth->execute($authid); - my ($result) = $sth->fetchrow; -# warn "Authority $authid TOTAL USED : $result"; - return $result; +=over 4 + +$count= &CountUsageChildren($authid) +counts Usage of narrower terms of Authid in bibliorecords. + +=back + +=cut + +sub CountUsageChildren { + my ($authid) = @_; } -# merging 2 authority entries. After a merge, the "from" can be deleted. -# sub AUTHmerge { -# my ($auth_merge_from,$auth_merge_to) = @_; -# my $dbh = C4::Context->dbh; -# # find MARC fields using this authtype -# my $authtypecode = AUTHfind_authtypecode($dbh,$authid); -# # retrieve records -# my $record_from = AUTHgetauthority($dbh,$auth_merge_from); -# my $record_to = AUTHgetauthority($dbh,$auth_merge_to); -# my $sth = $dbh->prepare("select distinct tagfield from marc_subfield_structure where authtypecode=?"); -# $sth->execute($authtypecode); -# my $tags_using_authtype; -# while (my ($tagfield) = $sth->fetchrow) { -# warn "TAG : $tagfield"; -# $tags_using_authtype.= "'".$tagfield."9',"; -# } -# chop $tags_using_authtype; -# # now, find every biblio using this authority -# $sth = $dbh->prepare("select bibid,tag,tag_indicator,tagorder from marc_subfield_table where tag+subfieldid in ($tags_using_authtype) and subfieldvalue=?"); -# $sth->execute($authid); -# # and delete entries before recreating them -# while (my ($bibid,$tag,$tag_indicator,$tagorder) = $sth->fetchrow) { -# &MARCdelsubfield($dbh,$bibid,$tag); -# -# } -# -# } - -sub AUTHfind_authtypecode { - my ($dbh,$authid) = @_; - my $sth = $dbh->prepare("select authtypecode from auth_header where authid=?"); - $sth->execute($authid); - my ($authtypecode) = $sth->fetchrow; - return $authtypecode; +=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=?"); + $sth->execute($authid); + my $authtypecode = $sth->fetchrow; + return $authtypecode; } +=head2 GetTagsLabels -sub AUTHgettagslib { - my ($dbh,$forlibrarian,$authtypecode)= @_; - $authtypecode="" unless $authtypecode; - my $sth; - my $libfield = ($forlibrarian eq 1)? 'liblibrarian' : 'libopac'; - # check that framework exists - $sth=$dbh->prepare("select count(*) from auth_tag_structure where authtypecode=?"); - $sth->execute($authtypecode); - my ($total) = $sth->fetchrow; - $authtypecode="" unless ($total >0); - $sth=$dbh->prepare("select tagfield,$libfield as lib,mandatory,repeatable from auth_tag_structure where authtypecode=? order by tagfield"); - $sth->execute($authtypecode); - my ($lib,$tag,$res,$tab,$mandatory,$repeatable); - while ( ($tag,$lib,$mandatory,$repeatable) = $sth->fetchrow) { - $res->{$tag}->{lib}=$lib; - $res->{$tab}->{tab}=""; # XXX - $res->{$tag}->{mandatory}=$mandatory; - $res->{$tag}->{repeatable}=$repeatable; - } +=over 4 - $sth=$dbh->prepare("select tagfield,tagsubfield,$libfield as lib,tab, mandatory, repeatable,authorised_value,value_builder,seealso from auth_subfield_structure where authtypecode=? order by tagfield,tagsubfield"); - $sth->execute($authtypecode); - - my $subfield; - my $authorised_value; - my $thesaurus_category; - my $value_builder; - my $kohafield; - my $seealso; - my $hidden; - my $isurl; - while ( ($tag, $subfield, $lib, $tab, $mandatory, $repeatable,$authorised_value,$value_builder,$seealso) = $sth->fetchrow) { - $res->{$tag}->{$subfield}->{lib}=$lib; - $res->{$tag}->{$subfield}->{tab}=$tab; - $res->{$tag}->{$subfield}->{mandatory}=$mandatory; - $res->{$tag}->{$subfield}->{repeatable}=$repeatable; - $res->{$tag}->{$subfield}->{authorised_value}=$authorised_value; - $res->{$tag}->{$subfield}->{thesaurus_category}=$thesaurus_category; - $res->{$tag}->{$subfield}->{value_builder}=$value_builder; - $res->{$tag}->{$subfield}->{seealso}=$seealso; - $res->{$tag}->{$subfield}->{hidden}=$hidden; - $res->{$tag}->{$subfield}->{isurl}=$isurl; - } - return $res; +$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; + my $sth; + my $libfield = ($forlibrarian eq 1)? 'liblibrarian' : 'libopac'; + + + # check that authority exists + $sth=$dbh->prepare("SELECT count(*) FROM auth_tag_structure WHERE authtypecode=?"); + $sth->execute($authtypecode); + my ($total) = $sth->fetchrow; + $authtypecode="" unless ($total >0); + $sth= $dbh->prepare( +"SELECT auth_tag_structure.tagfield,auth_tag_structure.liblibrarian,auth_tag_structure.libopac,auth_tag_structure.mandatory,auth_tag_structure.repeatable + FROM auth_tag_structure + WHERE authtypecode=? + ORDER BY tagfield" + ); + + $sth->execute($authtypecode); + my ( $liblibrarian, $libopac, $tag, $res, $tab, $mandatory, $repeatable ); + + while ( ( $tag, $liblibrarian, $libopac, $mandatory, $repeatable ) = $sth->fetchrow ) { + $res->{$tag}->{lib} = ($forlibrarian or !$libopac)?$liblibrarian:$libopac; + $res->{$tag}->{tab} = " "; # XXX + $res->{$tag}->{mandatory} = $mandatory; + $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 +FROM auth_subfield_structure +WHERE authtypecode=? +ORDER BY tagfield,tagsubfield" + ); + $sth->execute($authtypecode); + + my $subfield; + my $authorised_value; + my $value_builder; + my $kohafield; + my $seealso; + my $hidden; + my $isurl; + my $link; + + while ( + ( $tag, $subfield, $liblibrarian, , $libopac, $tab, + $mandatory, $repeatable, $authorised_value, $authtypecode, + $value_builder, $kohafield, $seealso, $hidden, + $isurl, $link ) + = $sth->fetchrow + ) + { + $res->{$tag}->{$subfield}->{lib} = ($forlibrarian or !$libopac)?$liblibrarian:$libopac; + $res->{$tag}->{$subfield}->{tab} = $tab; + $res->{$tag}->{$subfield}->{mandatory} = $mandatory; + $res->{$tag}->{$subfield}->{repeatable} = $repeatable; + $res->{$tag}->{$subfield}->{authorised_value} = $authorised_value; + $res->{$tag}->{$subfield}->{authtypecode} = $authtypecode; + $res->{$tag}->{$subfield}->{value_builder} = $value_builder; + $res->{$tag}->{$subfield}->{kohafield} = $kohafield; + $res->{$tag}->{$subfield}->{seealso} = $seealso; + $res->{$tag}->{$subfield}->{hidden} = $hidden; + $res->{$tag}->{$subfield}->{isurl} = $isurl; + $res->{$tag}->{$subfield}->{link} = $link; + } + return $res; } -sub AUTHaddauthority { -# pass the MARC::Record to this function, and it will create the records in the marc tables - my ($dbh,$record,$authid,$authtypecode) = @_; - my @fields=$record->fields(); -# warn "IN AUTHaddauthority $authid => ".$record->as_formatted; -# adding main table, and retrieving authid -# if authid is sent, then it's not a true add, it's only a re-add, after a delete (ie, a mod) +=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=' nz a22 o 4500';#Leader for incomplete MARC21 record + # if authid empty => true add, find a new authid number - unless ($authid) { - $dbh->do("lock tables auth_header WRITE,auth_subfield_table WRITE, auth_word WRITE, stopwords READ"); - my $sth=$dbh->prepare("insert into auth_header (datecreated,authtypecode) values (now(),?)"); - $sth->execute($authtypecode); - $sth=$dbh->prepare("select max(authid) from auth_header"); - $sth->execute; - ($authid)=$sth->fetchrow; - $sth->finish; - } - my $fieldcount=0; - # now, add subfields... - foreach my $field (@fields) { - $fieldcount++; - if ($field->tag() <10) { - &AUTHaddsubfield($dbh,$authid, - $field->tag(), - '', - $fieldcount, - '', - 1, - $field->data() - ); - } else { - my @subfields=$field->subfields(); - foreach my $subfieldcount (0..$#subfields) { - &AUTHaddsubfield($dbh,$authid, - $field->tag(), - $field->indicator(1).$field->indicator(2), - $fieldcount, - $subfields[$subfieldcount][0], - $subfieldcount+1, - $subfields[$subfieldcount][1] - ); - } + my $format= 'UNIMARCAUTH' if (uc(C4::Context->preference('marcflavour')) eq 'UNIMARC'); + $format= 'MARC21' if (uc(C4::Context->preference('marcflavour')) ne 'UNIMARC'); + + if ($format eq "MARC21") { + if (!$record->leader) { + $record->leader($leader); + } + if (!$record->field('003')) { + $record->insert_fields_ordered( + MARC::Field->new('003',C4::Context->preference('MARCOrgCode')) + ); } + my $time=POSIX::strftime("%Y%m%d%H%M%S",localtime); + if (!$record->field('005')) { + $record->insert_fields_ordered( + MARC::Field->new('005',$time.".0") + ); + } + my $date=POSIX::strftime("%y%m%d",localtime); + if (!$record->field('008')) { + $record->insert_fields_ordered( + MARC::Field->new('008',$date."|||a|||||| | ||| d") + ); + } + if (!$record->field('040')) { + $record->insert_fields_ordered( + MARC::Field->new('040','','', + 'a' => C4::Context->preference('MARCOrgCode'), + 'c' => C4::Context->preference('MARCOrgCode') + ) + ); + } } - $dbh->do("unlock tables"); - return $authid; -} + 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); + } -sub AUTHaddsubfield { -# Add a new subfield to a tag into the DB. - my ($dbh,$authid,$tagid,$tag_indicator,$tagorder,$subfieldcode,$subfieldorder,$subfieldvalues) = @_; - # if not value, end of job, we do nothing - if (length($subfieldvalues) ==0) { - return; - } - if (not($subfieldcode)) { - $subfieldcode=' '; - } - my @subfieldvalues = split /\|/,$subfieldvalues; - foreach my $subfieldvalue (@subfieldvalues) { - my $sth=$dbh->prepare("insert into auth_subfield_table (authid,tag,tagorder,tag_indicator,subfieldcode,subfieldorder,subfieldvalue) values (?,?,?,?,?,?,?)"); - $sth->execute($authid,(sprintf "%03s",$tagid),$tagorder,$tag_indicator,$subfieldcode,$subfieldorder,$subfieldvalue); - if ($sth->errstr) { - warn "ERROR ==> insert into auth_subfield_table (authid,tag,tagorder,tag_indicator,subfieldcode,subfieldorder,subfieldvalue) values ($authid,$tagid,$tagorder,$tag_indicator,$subfieldcode,$subfieldorder,$subfieldvalue)\n"; - } - &AUTHaddword($dbh,$authid,$tagid,$tagorder,$subfieldcode,$subfieldorder,$subfieldvalue); - } + 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 + 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')); +# 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; + } + 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); } -sub AUTHgetauthority { -# Returns MARC::Record of the biblio passed in parameter. - my ($dbh,$authid)=@_; - my $record = MARC::Record->new(); -#---- TODO : the leader is missing - $record->leader(' '); - my $sth=$dbh->prepare("select authid,subfieldid,tag,tagorder,tag_indicator,subfieldcode,subfieldorder,subfieldvalue - from auth_subfield_table - where authid=? order by tag,tagorder,subfieldcode - "); - $sth->execute($authid); - my $prevtagorder=1; - my $prevtag='XXX'; - my $previndicator; - my $field; # for >=10 tags - my $prevvalue; # for <10 tags - while (my $row=$sth->fetchrow_hashref) { - if ($row->{tagorder} ne $prevtagorder || $row->{tag} ne $prevtag) { - $previndicator.=" "; - if ($prevtag <10) { - $record->add_fields((sprintf "%03s",$prevtag),$prevvalue) unless $prevtag eq "XXX"; # ignore the 1st loop - } else { - $record->add_fields($field) unless $prevtag eq "XXX"; - } - undef $field; - $prevtagorder=$row->{tagorder}; - $prevtag = $row->{tag}; - $previndicator=$row->{tag_indicator}; - if ($row->{tag}<10) { - $prevvalue = $row->{subfieldvalue}; - } else { - $field = MARC::Field->new((sprintf "%03s",$prevtag), substr($row->{tag_indicator}.' ',0,1), substr($row->{tag_indicator}.' ',1,1), $row->{'subfieldcode'}, $row->{'subfieldvalue'} ); - } - } else { - if ($row->{tag} <10) { - $record->add_fields((sprintf "%03s",$row->{tag}), $row->{'subfieldvalue'}); - } else { - $field->add_subfields($row->{'subfieldcode'}, $row->{'subfieldvalue'} ); - } - $prevtag= $row->{tag}; - $previndicator=$row->{tag_indicator}; - } - } - # the last has not been included inside the loop... do it now ! - if ($prevtag ne "XXX") { # check that we have found something. Otherwise, prevtag is still XXX and we - # must return an empty record, not make MARC::Record fail because we try to - # create a record with XXX as field :-( - if ($prevtag <10) { - $record->add_fields($prevtag,$prevvalue); - } else { - # my $field = MARC::Field->new( $prevtag, "", "", %subfieldlist); - $record->add_fields($field); - } - } - return $record; + +=head2 DelAuthority + +=over 4 + +$authid= &DelAuthority($authid) +Deletes $authid + +=back + +=cut + + +sub DelAuthority { + my ($authid) = @_; + my $dbh=C4::Context->dbh; + + ModZebra($authid,"recordDelete","authorityserver",GetAuthority($authid),undef); + $dbh->do("delete from auth_header where authid=$authid") ; + } -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; +sub ModAuthority { + my ($authid,$record,$authtypecode,$merge)=@_; + my $dbh=C4::Context->dbh; + #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('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."/tmp/modified_authorities/$authid.authid"; + open AUTH, "> $filename"; + print AUTH $authid; + close AUTH; + } + return $authid; } -sub AUTHmodauthority { - my ($dbh,$authid,$record,$delete)=@_; - my $oldrecord=&AUTHgetauthority($dbh,$authid); - if ($oldrecord eq $record) { - return; - } -# 1st delete the authority, -# 2nd recreate it - &AUTHdelauthority($dbh,$authid,1); - &AUTHaddauthority($dbh,$record,$authid); - # FIXME : modify the authority in biblio too. + +=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 ) = @_; + if (uc(C4::Context->preference('marcflavour')) eq 'UNIMARC') { + my $dbh=C4::Context->dbh; + my $sth = $dbh->prepare("select marcxml from auth_header where authid=? " ); + $sth->execute($authid); + my ($marcxml)=$sth->fetchrow; + return $marcxml; + } + else { + # for MARC21, call GetAuthority instead of + # getting the XML directly since we may + # need to fix up the location of the authority + # code -- note that this is reasonably safe + # because GetAuthorityXML is used only by the + # indexing processes like zebraqueue_start.pl + my $record = GetAuthority($authid); + return $record->as_xml_record('MARC21'); + } } -sub AUTHdelauthority { - my ($dbh,$authid,$keep_biblio) = @_; -# if the keep_biblio is set to 1, then authority entries in biblio are preserved. -# This flag is set when the delauthority is called by modauthority -# due to a too complex structure of MARC (repeatable fields and subfields), -# the best solution for a modif is to delete / recreate the record. - - my $record = AUTHgetauthority($dbh,$authid); - $dbh->do("delete from auth_header where authid=$authid"); - $dbh->do("delete from auth_subfield_table where authid=$authid"); - $dbh->do("delete from auth_word where authid=$authid"); -# FIXME : delete or not in biblio tables (depending on $keep_biblio flag) +=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 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); } -sub AUTHmodsubfield { -# Subroutine changes a subfield value given a subfieldid. - my ($dbh, $subfieldid, $subfieldvalue )=@_; - $dbh->do("lock tables auth_subfield_table WRITE"); - my $sth=$dbh->prepare("update auth_subfield_table set subfieldvalue=? where subfieldid=?"); - $sth->execute($subfieldvalue, $subfieldid); - $dbh->do("unlock tables"); - $sth->finish; - $sth=$dbh->prepare("select authid,tag,tagorder,subfieldcode,subfieldid,subfieldorder from auth_subfield_table where subfieldid=?"); - $sth->execute($subfieldid); - my ($authid,$tagid,$tagorder,$subfieldcode,$x,$subfieldorder) = $sth->fetchrow; - $subfieldid=$x; - &AUTHdelword($dbh,$authid,$tagid,$tagorder,$subfieldcode,$subfieldorder); - &AUTHaddword($dbh,$authid,$tagid,$tagorder,$subfieldcode,$subfieldorder,$subfieldvalue); - return($subfieldid, $subfieldvalue); +=head2 GetAuthType + +=over 4 + +$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 (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; } -sub AUTHfindsubfield { - my ($dbh,$authid,$tag,$subfieldcode,$subfieldorder,$subfieldvalue) = @_; - my $resultcounter=0; - my $subfieldid; - my $lastsubfieldid; - my $query="select subfieldid from auth_subfield_table where authid=? and tag=? and subfieldcode=?"; - my @bind_values = ($authid,$tag, $subfieldcode); - if ($subfieldvalue) { - $query .= " and subfieldvalue=?"; - push(@bind_values,$subfieldvalue); - } else { - if ($subfieldorder<1) { - $subfieldorder=1; - } - $query .= " and subfieldorder=?"; - push(@bind_values,$subfieldorder); + +sub AUTHhtml2marc { + my ($rtags,$rsubfields,$rvalues,%indicators) = @_; + my $dbh=C4::Context->dbh; + my $prevtag = -1; + my $record = MARC::Record->new(); +#---- TODO : the leader is missing + +# my %subfieldlist=(); + my $prevvalue; # if tag <10 + my $field; # if tag >=10 + for (my $i=0; $i< @$rtags; $i++) { + # rebuild MARC::Record + if (@$rtags[$i] ne $prevtag) { + if ($prevtag < 10) { + if ($prevvalue) { + $record->add_fields((sprintf "%03s",$prevtag),$prevvalue); + } + } else { + if ($field) { + $record->add_fields($field); + } + } + $indicators{@$rtags[$i]}.=' '; + if (@$rtags[$i] <10) { + $prevvalue= @$rvalues[$i]; + undef $field; + } else { + undef $prevvalue; + $field = MARC::Field->new( (sprintf "%03s",@$rtags[$i]), substr($indicators{@$rtags[$i]},0,1),substr($indicators{@$rtags[$i]},1,1), @$rsubfields[$i] => @$rvalues[$i]); + } + $prevtag = @$rtags[$i]; + } else { + if (@$rtags[$i] <10) { + $prevvalue=@$rvalues[$i]; + } else { + if (length(@$rvalues[$i])>0) { + $field->add_subfields(@$rsubfields[$i] => @$rvalues[$i]); + } + } + $prevtag= @$rtags[$i]; + } } - my $sti=$dbh->prepare($query); - $sti->execute(@bind_values); - while (($subfieldid) = $sti->fetchrow) { - $resultcounter++; - $lastsubfieldid=$subfieldid; + # the last has not been included inside the loop... do it now ! + $record->add_fields($field) if $field; + 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. + +=back + +=cut + +sub FindDuplicateAuthority { + + my ($record,$authtypecode)=@_; +# warn "IN for ".$record->as_formatted; + my $dbh = C4::Context->dbh; +# warn "".$record->as_formatted; + my $sth = $dbh->prepare("select auth_tag_to_report from auth_types where authtypecode=?"); + $sth->execute($authtypecode); + my ($auth_tag_to_report) = $sth->fetchrow; + $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 $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]/); + } } - if ($resultcounter>1) { - # Error condition. Values given did not resolve into a unique record. Don't know what to edit - # should rarely occur (only if we use subfieldvalue with a value that exists twice, which is strange) - return -1; - } else { - return $lastsubfieldid; + 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]); + return $marcrecord->field('001')->data,BuildSummary($marcrecord,$marcrecord->field('001')->data,$authtypecode); } + # no result, returns nothing + return; } -sub AUTHfindsubfieldid { - my ($dbh,$authid,$tag,$tagorder,$subfield,$subfieldorder) = @_; - my $sth=$dbh->prepare("select subfieldid from auth_subfield_table - where authid=? and tag=? and tagorder=? - and subfieldcode=? and subfieldorder=?"); - $sth->execute($authid,$tag,$tagorder,$subfield,$subfieldorder); - my ($res) = $sth->fetchrow; - unless ($res) { - $sth=$dbh->prepare("select subfieldid from auth_subfield_table - where authid=? and tag=? and tagorder=? - and subfieldcode=?"); - $sth->execute($authid,$tag,$tagorder,$subfield); - ($res) = $sth->fetchrow; - } - return $res; -} +=head2 BuildSummary -sub AUTHfind_authtypecode { - my ($dbh,$authid) = @_; - my $sth = $dbh->prepare("select authtypecode from auth_header where authid=?"); - $sth->execute($authid); - my ($authtypecode) = $sth->fetchrow; - return $authtypecode; -} +=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. -sub AUTHdelsubfield { -# delete a subfield for $authid / tag / tagorder / subfield / subfieldorder - my ($dbh,$authid,$tag,$tagorder,$subfield,$subfieldorder) = @_; - $dbh->do("delete from auth_subfield_table where authid='$authid' and - tag='$tag' and tagorder='$tagorder' - and subfieldcode='$subfield' and subfieldorder='$subfieldorder' - "); +=back + +=cut + +sub BuildSummary{ +## give this a Marc record to return summary + my ($record,$authid,$authtypecode)=@_; + my $dbh=C4::Context->dbh; + 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"; + $language{'ger'}="Allemand"; + $language{'ita'}="Italien"; + $language{'spa'}="Espagnol"; + my %thesaurus; + $thesaurus{'1'}="Peuples"; + $thesaurus{'2'}="Anthroponymes"; + $thesaurus{'3'}="Oeuvres"; + $thesaurus{'4'}="Chronologie"; + $thesaurus{'5'}="Lieux"; + $thesaurus{'6'}="Sujets"; + #thesaurus a remplir + my @fields = $record->fields(); + my $reported_tag; + # if the library has a summary defined, use it. Otherwise, build a standard one + # 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) { + 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/
/g; + } else { + my $heading; + my $authid; + my $altheading; + my $seealso; + my $broaderterms; + my $narrowerterms; + my $see; + my $seeheading; + my $notes; + 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->subfield('a'); + $authid=$field->subfield('3'); + } + # rejected form(s) + foreach my $field ($record->field('3..')) { + $notes.= ''.$field->subfield('a')."\n"; + } + foreach my $field ($record->field('4..')) { + if ($field->subfield('2')) { + my $thesaurus = "thes. : ".$thesaurus{"$field->subfield('2')"}." : "; + $see.= ''.$thesaurus.$field->subfield('a')." -- \n"; + } + } + # see : + foreach my $field ($record->field('5..')) { + + if (($field->subfield('5')) && ($field->subfield('a')) && ($field->subfield('5') eq 'g')) { + $broaderterms.= ' '.$field->subfield('a')." -- \n"; + } elsif (($field->subfield('5')) && ($field->subfield('a')) && ($field->subfield('5') eq 'h')){ + $narrowerterms.= ''.$field->subfield('a')." -- \n"; + } elsif ($field->subfield('a')) { + $seealso.= ''.$field->subfield('a')." -- \n"; + } + } + # // form + foreach my $field ($record->field('7..')) { + my $lang = substr($field->subfield('8'),3,3); + $seeheading.= ' En '.$language{$lang}.' : '.$field->subfield('a')."
\n"; + } + $broaderterms =~s/-- \n$//; + $narrowerterms =~s/-- \n$//; + $seealso =~s/-- \n$//; + $see =~s/-- \n$//; + $summary = "".$heading."
".($notes?"$notes
":""); + $summary.= '

TG : '.$broaderterms.'

' if ($broaderterms); + $summary.= '

TS : '.$narrowerterms.'

' if ($narrowerterms); + $summary.= '

TA : '.$seealso.'

' if ($seealso); + $summary.= '

EP : '.$see.'

' if ($see); + $summary.= '

'.$seeheading.'

' if ($seeheading); + } else { + # construct MARC21 summary + # FIXME - looping over 1XX is questionable + # since MARC21 authority should have only one 1XX + foreach my $field ($record->field('1..')) { + next if "152" eq $field->tag(); # FIXME - 152 is not a good tag to use + # in MARC21 -- purely local tags really ought to be + # 9XX + 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.= "
      used for/see from: ".$field->as_string(); + } #See Also + foreach my $field ($record->field('5..')) { + $altheading.= "
      see also: ".$field->as_string(); + } + $summary .= ": " if $summary; + $summary.=$heading.$seeheading.$altheading; + } + } + return $summary; } -sub AUTHhtml2marc { - my ($dbh,$rtags,$rsubfields,$rvalues,%indicators) = @_; - my $prevtag = -1; - my $record = MARC::Record->new(); -# my %subfieldlist=(); - my $prevvalue; # if tag <10 - my $field; # if tag >=10 - for (my $i=0; $i< @$rtags; $i++) { - # rebuild MARC::Record - if (@$rtags[$i] ne $prevtag) { - if ($prevtag < 10) { - if ($prevvalue) { - $record->add_fields((sprintf "%03s",$prevtag),$prevvalue); - } - } else { - if ($field) { - $record->add_fields($field); - } - } - $indicators{@$rtags[$i]}.=' '; - if (@$rtags[$i] <10) { - $prevvalue= @$rvalues[$i]; - } else { - $field = MARC::Field->new( (sprintf "%03s",@$rtags[$i]), substr($indicators{@$rtags[$i]},0,1),substr($indicators{@$rtags[$i]},1,1), @$rsubfields[$i] => @$rvalues[$i]); - } - $prevtag = @$rtags[$i]; - } else { - if (@$rtags[$i] <10) { - $prevvalue=@$rvalues[$i]; - } else { - if (@$rvalues[$i]) { - $field->add_subfields(@$rsubfields[$i] => @$rvalues[$i]); - } - } - $prevtag= @$rtags[$i]; - } - } - # the last has not been included inside the loop... do it now ! - $record->add_fields($field); -# warn $record->as_formatted; - return $record; +=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 $force = shift @_; + 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; + foreach my $field ($record->field('550')){ + if ($field->subfield('5') && $field->subfield('5') eq 'g'){ + my $parentrecord = GetAuthority($field->subfield('3')); + my $localresult=$hierarchies; + my $trees; + $trees = BuildUnimarcHierarchies($field->subfield('3')); + my @trees; + if ($trees=~/;/){ + @trees = split(/;/,$trees); + } else { + push @trees, $trees; + } + foreach (@trees){ + $_.= ",$authid"; + } + @globalresult = (@globalresult,@trees); + $found=1; + } + $hierarchies=join(";",@globalresult); + } + #Unless there is no ancestor, I am alone. + $hierarchies="$authid" unless ($hierarchies); + } + AddAuthorityTrees($authid,$hierarchies); + return $hierarchies; } -sub AUTHaddword { -# split a subfield string and adds it into the word table. -# removes stopwords - my ($dbh,$authid,$tag,$tagorder,$subfieldid,$subfieldorder,$sentence) =@_; - $sentence =~ s/(\.|\?|\:|\!|\'|,|\-|\"|\(|\)|\[|\]|\{|\})/ /g; - my @words = split / /,$sentence; - my $stopwords= C4::Context->stopwords; - my $sth=$dbh->prepare("insert into auth_word (authid, tagsubfield, tagorder, subfieldorder, word, sndx_word) - values (?,concat(?,?),?,?,?,soundex(?))"); - foreach my $word (@words) { -# we record only words longer than 2 car and not in stopwords hash - if (length($word)>2 and !($stopwords->{uc($word)})) { - $sth->execute($authid,$tag,$subfieldid,$tagorder,$subfieldorder,$word,$word); - if ($sth->err()) { - warn "ERROR ==> insert into auth_word (authid, tagsubfield, tagorder, subfieldorder, word, sndx_word) values ($authid,concat($tag,$subfieldid),$tagorder,$subfieldorder,$word,soundex($word))\n"; - } - } +=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->field('001')->data(); + 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('2..',"a"); + return \%cell; } -sub AUTHdelword { -# delete words. this sub deletes all the words from a sentence. a subfield modif is done by a delete then a add - my ($dbh,$authid,$tag,$tagorder,$subfield,$subfieldorder) = @_; - my $sth=$dbh->prepare("delete from auth_word where authid=? and tagsubfield=concat(?,?) and tagorder=? and subfieldorder=?"); - $sth->execute($authid,$tag,$subfield,$tagorder,$subfieldorder); +=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 char_decode { - # converts ISO 5426 coded string to ISO 8859-1 - # sloppy code : should be improved in next issue - my ($string,$encoding) = @_ ; - $_ = $string ; -# $encoding = C4::Context->preference("marcflavour") unless $encoding; - if ($encoding eq "UNIMARC") { - s/\xe1/Æ/gm ; - s/\xe2/Ð/gm ; - s/\xe9/Ø/gm ; - s/\xec/þ/gm ; - s/\xf1/æ/gm ; - s/\xf3/ð/gm ; - s/\xf9/ø/gm ; - s/\xfb/ß/gm ; - s/\xc1\x61/à/gm ; - s/\xc1\x65/è/gm ; - s/\xc1\x69/ì/gm ; - s/\xc1\x6f/ò/gm ; - s/\xc1\x75/ù/gm ; - s/\xc1\x41/À/gm ; - s/\xc1\x45/È/gm ; - s/\xc1\x49/Ì/gm ; - s/\xc1\x4f/Ò/gm ; - s/\xc1\x55/Ù/gm ; - s/\xc2\x41/Á/gm ; - s/\xc2\x45/É/gm ; - s/\xc2\x49/Í/gm ; - s/\xc2\x4f/Ó/gm ; - s/\xc2\x55/Ú/gm ; - s/\xc2\x59/Ý/gm ; - s/\xc2\x61/á/gm ; - s/\xc2\x65/é/gm ; - s/\xc2\x69/í/gm ; - s/\xc2\x6f/ó/gm ; - s/\xc2\x75/ú/gm ; - s/\xc2\x79/ý/gm ; - s/\xc3\x41/Â/gm ; - s/\xc3\x45/Ê/gm ; - s/\xc3\x49/Î/gm ; - s/\xc3\x4f/Ô/gm ; - s/\xc3\x55/Û/gm ; - s/\xc3\x61/â/gm ; - s/\xc3\x65/ê/gm ; - s/\xc3\x69/î/gm ; - s/\xc3\x6f/ô/gm ; - s/\xc3\x75/û/gm ; - s/\xc4\x41/Ã/gm ; - s/\xc4\x4e/Ñ/gm ; - s/\xc4\x4f/Õ/gm ; - s/\xc4\x61/ã/gm ; - s/\xc4\x6e/ñ/gm ; - s/\xc4\x6f/õ/gm ; - s/\xc8\x45/Ë/gm ; - s/\xc8\x49/Ï/gm ; - s/\xc8\x65/ë/gm ; - s/\xc8\x69/ï/gm ; - s/\xc8\x76/ÿ/gm ; - s/\xc9\x41/Ä/gm ; - s/\xc9\x4f/Ö/gm ; - s/\xc9\x55/Ü/gm ; - s/\xc9\x61/ä/gm ; - s/\xc9\x6f/ö/gm ; - s/\xc9\x75/ü/gm ; - s/\xca\x41/Å/gm ; - s/\xca\x61/å/gm ; - s/\xd0\x43/Ç/gm ; - s/\xd0\x63/ç/gm ; - # this handles non-sorting blocks (if implementation requires this) - $string = nsb_clean($_) ; - } elsif ($encoding eq "USMARC" || $encoding eq "MARC21") { - if(/[\xc1-\xff]/) { - s/\xe1\x61/à/gm ; - s/\xe1\x65/è/gm ; - s/\xe1\x69/ì/gm ; - s/\xe1\x6f/ò/gm ; - s/\xe1\x75/ù/gm ; - s/\xe1\x41/À/gm ; - s/\xe1\x45/È/gm ; - s/\xe1\x49/Ì/gm ; - s/\xe1\x4f/Ò/gm ; - s/\xe1\x55/Ù/gm ; - s/\xe2\x41/Á/gm ; - s/\xe2\x45/É/gm ; - s/\xe2\x49/Í/gm ; - s/\xe2\x4f/Ó/gm ; - s/\xe2\x55/Ú/gm ; - s/\xe2\x59/Ý/gm ; - s/\xe2\x61/á/gm ; - s/\xe2\x65/é/gm ; - s/\xe2\x69/í/gm ; - s/\xe2\x6f/ó/gm ; - s/\xe2\x75/ú/gm ; - s/\xe2\x79/ý/gm ; - s/\xe3\x41/Â/gm ; - s/\xe3\x45/Ê/gm ; - s/\xe3\x49/Î/gm ; - s/\xe3\x4f/Ô/gm ; - s/\xe3\x55/Û/gm ; - s/\xe3\x61/â/gm ; - s/\xe3\x65/ê/gm ; - s/\xe3\x69/î/gm ; - s/\xe3\x6f/ô/gm ; - s/\xe3\x75/û/gm ; - s/\xe4\x41/Ã/gm ; - s/\xe4\x4e/Ñ/gm ; - s/\xe4\x4f/Õ/gm ; - s/\xe4\x61/ã/gm ; - s/\xe4\x6e/ñ/gm ; - s/\xe4\x6f/õ/gm ; - s/\xe8\x45/Ë/gm ; - s/\xe8\x49/Ï/gm ; - s/\xe8\x65/ë/gm ; - s/\xe8\x69/ï/gm ; - s/\xe8\x76/ÿ/gm ; - s/\xe9\x41/Ä/gm ; - s/\xe9\x4f/Ö/gm ; - s/\xe9\x55/Ü/gm ; - s/\xe9\x61/ä/gm ; - s/\xe9\x6f/ö/gm ; - s/\xe9\x75/ü/gm ; - s/\xea\x41/Å/gm ; - s/\xea\x61/å/gm ; - # this handles non-sorting blocks (if implementation requires this) - $string = nsb_clean($_) ; - } - } - return($string) ; +=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); } -sub nsb_clean { - my $NSB = '\x88' ; # NSB : begin Non Sorting Block - my $NSE = '\x89' ; # NSE : Non Sorting Block end - # handles non sorting blocks - my ($string) = @_ ; - $_ = $string ; - s/$NSB/(/gm ; - s/[ ]{0,1}$NSE/) /gm ; - $string = $_ ; - return($string) ; +=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 ($counteditedbiblio,$countunmodifiedbiblio,$counterrors)=(0,0,0); + my $dbh=C4::Context->dbh; + my $authtypecodefrom = GetAuthTypeCode($mergefrom); + my $authtypecodeto = GetAuthTypeCode($mergeto); +# warn "mergefrom : $authtypecodefrom $mergefrom mergeto : $authtypecodeto $mergeto "; + # return if authority does not exist + return "error MARCFROM not a marcrecord ".Data::Dumper::Dumper($MARCfrom) if scalar($MARCfrom->fields()) == 0; + return "error MARCTO not a marcrecord".Data::Dumper::Dumper($MARCto) if scalar($MARCto->fields()) == 0; + # search the tag to report + my $sth = $dbh->prepare("select auth_tag_to_report from auth_types where authtypecode=?"); + $sth->execute($authtypecodefrom); + my ($auth_tag_to_report_from) = $sth->fetchrow; + $sth->execute($authtypecodeto); + my ($auth_tag_to_report_to) = $sth->fetchrow; + + my @record_to; + @record_to = $MARCto->field($auth_tag_to_report_to)->subfields() if $MARCto->field($auth_tag_to_report_to); + my @record_from; + @record_from = $MARCfrom->field($auth_tag_to_report_from)->subfields() if $MARCfrom->field($auth_tag_to_report_from); + + my @reccache; + # search all biblio tags using this authority. + #Getting marcbiblios impacted by the change. + if (C4::Context->preference('NoZebra')) { + #nozebra way + my $dbh=C4::Context->dbh; + my $rq=$dbh->prepare(qq(SELECT biblionumbers from nozebra where indexname="an" and server="biblioserver" and value="$mergefrom" )); + $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); + $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(); + push @reccache, $marcdata; + $z++; + } + $oConnection->destroy(); + } + #warn scalar(@reccache)." biblios to update"; + # Get All candidate Tags for the change + # (This will reduce the search scope in marc records). + $sth = $dbh->prepare("select distinct tagfield from marc_subfield_structure where authtypecode=?"); + $sth->execute($authtypecodefrom); + my @tags_using_authtype; + while (my ($tagfield) = $sth->fetchrow) { + push @tags_using_authtype,$tagfield ; + } + my $tag_to=0; + if ($authtypecodeto ne $authtypecodefrom){ + # If many tags, take the first + $sth->execute($authtypecodeto); + $tag_to=$sth->fetchrow; + #warn $tag_to; + } + # BulkEdit marc records + # May be used as a template for a bulkedit field + foreach my $marcrecord(@reccache){ + my $update; + $marcrecord= MARC::Record->new_from_xml($marcrecord,"utf8",C4::Context->preference("marcflavour")) unless(C4::Context->preference('NoZebra')); + foreach my $tagfield (@tags_using_authtype){ +# warn "tagfield : $tagfield "; + foreach my $field ($marcrecord->field($tagfield)){ + my $auth_number=$field->subfield("9"); + my $tag=$field->tag(); + if ($auth_number==$mergefrom) { + my $field_to=MARC::Field->new(($tag_to?$tag_to:$tag),$field->indicator(1),$field->indicator(2),"9"=>$mergeto); + foreach my $subfield (@record_to) { + $field_to->add_subfields($subfield->[0] =>$subfield->[1]); + } + $marcrecord->delete_field($field); + $marcrecord->insert_grouped_field($field_to); + $update=1; + } + }#for each tag + }#foreach tagfield + my ($bibliotag,$bibliosubf) = GetMarcFromKohaField("biblio.biblionumber","") ; + my $biblionumber; + if ($bibliotag<10){ + $biblionumber=$marcrecord->field($bibliotag)->data; + } + else { + $biblionumber=$marcrecord->subfield($bibliotag,$bibliosubf); + } + unless ($biblionumber){ + warn "pas de numéro de notice bibliographique dans : ".$marcrecord->as_formatted; + next; + } + if ($update==1){ + &ModBiblio($marcrecord,$biblionumber,GetFrameworkCode($biblionumber)) ; + $counteditedbiblio++; + warn $counteditedbiblio if (($counteditedbiblio % 10) and $ENV{DEBUG}); + } + }#foreach $marc + return $counteditedbiblio; + # now, find every other authority linked with this authority + # now, find every other authority linked with this authority +# my $oConnection=C4::Context->Zconn("authorityserver"); +# my $query; +# # 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 + +=head2 get_auth_type_location + +=over 4 + +my ($tag, $subfield) = get_auth_type_location($auth_type_code); + +=back + +Get the tag and subfield used to store the heading type +for indexing purposes. The C<$auth_type> parameter is +optional; if it is not supplied, assume ''. + +This routine searches the MARC authority framework +for the tag and subfield whose kohafield is +C; if no such field is +defined in the framework, default to the hardcoded value +specific to the MARC format. + +=cut + +sub get_auth_type_location { + my $auth_type_code = @_ ? shift : ''; + + my ($tag, $subfield) = GetAuthMARCFromKohaField('auth_header.authtypecode', $auth_type_code); + if (defined $tag and defined $subfield and $tag != 0 and $subfield != 0) { + return ($tag, $subfield); + } else { + if (C4::Context->preference('marcflavour') eq "MARC21") { + return C4::AuthoritiesMarc::MARC21::default_auth_type_location(); + } else { + return C4::AuthoritiesMarc::UNIMARC::default_auth_type_location(); + } + } } END { } # module clean-up code here (global destructor) -=back +1; +__END__ =head1 AUTHOR @@ -830,23 +1402,3 @@ Paul POULAIN paul.poulain@free.fr =cut -# $Id$ -# $Log$ -# Revision 1.6 2004/08/18 16:00:24 tipaul -# fixes for authorities management -# -# Revision 1.5 2004/07/05 13:37:22 doxulting -# First step for working authorities -# -# Revision 1.4 2004/06/22 11:35:37 tipaul -# removing % at the beginning of a string to avoid loooonnnngggg searchs -# -# Revision 1.3 2004/06/17 08:02:13 tipaul -# merging tag & subfield in auth_word for better perfs -# -# Revision 1.2 2004/06/10 08:29:01 tipaul -# MARC authority management (continued) -# -# Revision 1.1 2004/06/07 07:35:01 tipaul -# MARC authority management package -#