[Koha-cvs] koha/C4 AuthoritiesMarc.pm
Tumer Garip
tgarip at neu.edu.tr
Fri May 19 20:09:39 CEST 2006
CVSROOT: /sources/koha
Module name: koha
Branch:
Changes by: Tumer Garip <tgarip1957 at savannah.gnu.org> 06/05/19 18:09:39
Modified files:
C4 : AuthoritiesMarc.pm
Log message:
All support for auth_subfield_tables is removed. All search is now with zebra authorities. New authority structure allows multiple linking of authorities of differnet types to one another.
Authority tables are modified to be compatible with new MARC frameworks. This change is part of Authority Linking & Zebra authorities. Requires change in Mysql database. It will break head unless all changes regarding this is implemented. This warning will take place on all commits regarding this
CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/koha/koha/C4/AuthoritiesMarc.pm.diff?tr1=1.24&tr2=1.25&r1=text&r2=text
Patches:
Index: koha/C4/AuthoritiesMarc.pm
diff -u koha/C4/AuthoritiesMarc.pm:1.24 koha/C4/AuthoritiesMarc.pm:1.25
--- koha/C4/AuthoritiesMarc.pm:1.24 Thu Feb 9 01:56:20 2006
+++ koha/C4/AuthoritiesMarc.pm Fri May 19 18:09:39 2006
@@ -23,7 +23,7 @@
use C4::Koha;
use MARC::Record;
use C4::Biblio;
-
+#use ZOOM;
use vars qw($VERSION @ISA @EXPORT);
# set the version for version checking
@@ -40,163 +40,188 @@
&AUTHdelauthority
&AUTHaddsubfield
&AUTHgetauthority
-
+ &AUTHfind_marc_from_kohafield
&AUTHgetauth_type
&AUTHcount_usage
-
+ &getsummary
&authoritysearch
- &MARCmodsubfield
+
&AUTHhtml2marc
- &AUTHaddword
- &MARCaddword &MARCdelword
- &char_decode
+
+ &merge
&FindDuplicate
);
+sub AUTHfind_marc_from_kohafield {
+ my ( $dbh, $kohafield,$authtypecode ) = @_;
+ 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);
+}
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%")
-
+ 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;
- my $sth = $dbh->prepare("select auth_tag_to_report from auth_types where authtypecode=?");
- $sth->execute($authtypecode);
- my ($tag_to_report) = $sth->fetchrow;
- $mainentrytag = $tag_to_report;
- for (my $i=0;$i<$#{$tags};$i++) {
- if (@$tags[$i] eq "mainentry") {
- @$tags[$i] = $tag_to_report."a";
- }
- }
-
- # "Normal" statements
- # quote marc fields/subfields
- for (my $i=0;$i<=$#{$tags};$i++) {
- if (@$tags[$i]) {
- @$tags[$i] = $dbh->quote(@$tags[$i]);
- }
- }
- my @normal_tags = ();
- my @normal_and_or = ();
- my @normal_operator = ();
- my @normal_value = ();
- # Extracts the NOT statements from the list of statements
+ ##first set the authtype search
+ $query="\@attr 1=1013 \@attr 5=100 ".$authtypecode; ##No truncation on authtype
+ my $dosearch;
+ my $and;
+ my $q2;
for(my $i = 0 ; $i <= $#{$value} ; $i++)
{
- # replace * by %
- @$value[$i] =~ s/\*/%/g;
- # remove % at the beginning
- @$value[$i] =~ s/^%//g;
- @$value[$i] =~ s/(\.|\?|\:|\!|\'|,|\-|\"|\(|\)|\[|\]|\{|\}|\/)/ /g if @$operator[$i] eq "contains";
- 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];
- }
- }
- # 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);
+ if (@$value[$i]){
+ ##If mainentry search $a tag
+ if (@$tags[$i] eq "mainentry") {
+ $attr =" \@attr 1=21 ";
+ }else{
+ $attr =" \@attr 1=47 ";
+ }
+
+
+
+ if (@$operator[$i] eq 'phrase') {
+ $attr.=" \@attr 4=1 \@attr 5=100 \@attr 3=1 ";##Phrase, No truncation, first in field###It seems not implemented by indexdata
+
+ } else {
+
+ $attr .=" \@attr 4=6 \@attr 5=1 ";## Word list, right truncated, anywhere
+ }
+
+
+ $and .=" \@and " ;
+ $attr =$attr."\"".@$value[$i]."\"";
+ $q2 .=$attr;
+ $dosearch=1;
+ }#if value
+
+ }
+##Add how many queries generated
+$query= $and.$query.$q2;
+warn $query;
+
+$offset=0 unless $offset;
+my $counter = $offset;
+$length=10 unless $length;
+
+my $oAuth=C4::Context->Zconnauth("authorityserver");
+if ($oAuth eq "error"){
+warn "Error/CONNECTING \n";
+ return("error",undef);
+ }
+
+my $oAResult;
+my $Anewq= new ZOOM::Query::PQF($query);
+$Anewq->sortby("1=21 i< 1=47 i<");
+
+eval {
+$oAResult= $oAuth->search($Anewq) ;
+};
+if($@){
+warn " /CODE:", $@->code()," /MSG:",$@->message(),"\n";
+ return("error",undef);
+ }
- 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 $nbresults=0;
+ $nbresults=$oAResult->size() if ($oAResult);
+
my @result = ();
- while (my ($authid) = $sth->fetchrow) {
- push @result,$authid;
- }
- # 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))) {
- # retrieve everything
- for (my $counter=0;$counter <=$#result;$counter++) {
-# 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$2\[$1$tagsubf$2]/g;
- }
- }
- }
- $summary =~ s/\[(.*?)]//g;
- $summary =~ s/\n/<br>/g;
+if ($nbresults>0){
+##fIND tags using authority
- # find biblio MARC field using this authtypecode (to jump to biblio)
- $authtypecode = AUTHfind_authtypecode($dbh,$result[$counter]);
- my $sth = $dbh->prepare("select distinct tagfield from marc_subfield_structure where authtypecode=?");
- $sth->execute($authtypecode);
+ my $newsth = $dbh->prepare("select distinct tagfield from marc_subfield_structure where authtypecode=?");
+ $newsth->execute($authtypecode);
my $tags_using_authtype;
- while (my ($tagfield) = $sth->fetchrow) {
-# warn "TAG : $tagfield";
- $tags_using_authtype.= $tagfield."9,";
+ while (my ($tagfield) = $newsth->fetchrow) {
+ $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;
- $newline{even} = $counter % 2;
- $newline{mainentry} = $record->field($mainentrytag)->subfield('a')." ".$record->field($mainentrytag)->subfield('b') if $record->field($mainentrytag);
- push @finalresult, \%newline;
- }
- # sort everything
- my @finalresult3= sort {$a->{summary} cmp $b->{summary}} @finalresult;
- # cut from $offset to $offset+$length;
- my @finalresult2;
- for (my $i=$offset;$i<=$offset+$length;$i++) {
- push @finalresult2,$finalresult3[$i] if $finalresult3[$i];
- }
- my $nbresults = $#result + 1;
+##Find authid and linkid fields
+my ($authidfield,$authidsubfield)=AUTHfind_marc_from_kohafield($dbh,"auth_header.authid",$authtypecode);
+my ($linkidfield,$linkidsubfield)=AUTHfind_marc_from_kohafield($dbh,"auth_header.linkid",$authtypecode);
+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);
+my $authid=$authrecord->field($authidfield)->subfield($authidsubfield); ## we could have these defined in system pref.
+ 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.=getsummary($dbh,$linkrecord,$linkid,$linktype).$separator;
+ }
+ }
+ }#
- return (\@finalresult2, $nbresults);
+my $summary=getsummary($dbh,$authrecord,$authid,$authtypecode);
+if ($linkid && $linksummary ne " ".$separator){
+$summary="<b>".$summary."</b>".$linksummary;
+}
+## Fix Async search and move Zconn to here
+ my %newline;
+ $newline{summary} = $summary;
+ $newline{authid} = $authid;
+ $newline{linkid} = $linkid;
+# $newline{used} =$count;
+ $newline{biblio_fields} = $tags_using_authtype;
+ $newline{even} = $counter % 2;
+ $counter++;
+ push @finalresult, \%newline;
+ }## while counter
+$oAResult->destroy();
+#$oAuth->destroy();
+
+###
+my $oConnection=C4::Context->Zconn("biblioserver");
+ if ($oConnection eq "error"){
+ warn "Error/CONNECTING \n";
+ }
+my $oResult;
+for (my $z=0; $z<@finalresult; $z++){
+ my $nquery;
+
+ $nquery= "\@attr GILS 1=2057 ".$finalresult[$z]{authid};
+ $nquery="\@or ".$nquery." \@attr GILS 1=2057 ".$finalresult[$z]{linkid} if $finalresult[$z]{linkid};
+
+ eval{
+ $oResult = $oConnection->search_pqf($nquery);
+ };
+ if($@){
+ warn " /CODE:", $@->code()," /MSG:",$@->message(),"\n";
+ }
+ my $count=$oResult->size() if ($oResult);
+ $finalresult[$z]{used}=$count;
+}##for Zconn
+ $oResult->destroy();
+# $oConnection->destroy();
+}## if nbresult
+ return (\@finalresult, $nbresults);
}
# Creates the SQL Request
@@ -214,72 +239,33 @@
for(my $i=0; $i<=@$value;$i++) {
if (@$value[$i]) {
$nb_active++;
-# warn " @$tags[$i]";
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]%");
+
+ $sql_tables = "auth_subfield_table as m$nb_table,";
+ $sql_where1 .= "( m$nb_table.subfieldvalue like '@$value[$i]' ";
if (@$tags[$i]) {
- $sql_where1 .=" and m1.tag+m1.subfieldcode in (@$tags[$i])";
- }
+ $sql_where1 .=" and concat(m$nb_table.tag,m$nb_table.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]);
+ $sql_where1 .= "@$and_or[$i] (m$nb_table.subfieldvalue like '@$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 .=" and concat(m$nb_table.tag,m$nb_table.subfieldcode) IN (@$tags[$i])";
+ }
$sql_where1.=")";
+ $sql_where2.="m1.authid=m$nb_table.authid and ";
+
+
+ }
}
- }
}
- }
if($sql_where2 ne "(") # some datas added to sql_where2, processing
{
@@ -302,52 +288,41 @@
# 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_used=$sth->execute($authtypecode);
my $tags_using_authtype;
- while (my ($tagfield) = $sth->fetchrow) {
+
+ while (my($tagfield) = $sth->fetchrow){
# warn "TAG : $tagfield";
$tags_using_authtype.= "'".$tagfield."9',";
+
}
+
chop $tags_using_authtype;
- if ($tags_using_authtype) {
- $sth = $dbh->prepare("select count(*) from marc_subfield_table where concat(tag,subfieldcode) in ($tags_using_authtype) and subfieldvalue=?");
-# } else {
-# $sth = $dbh->prepare("select count(*) from marc_subfield_table where 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;
+### try ZOOM search here
+my $oConnection=C4::Context->Zconn("biblioserver");
+my $query;
+
+$query= "\@attr GILS 1=2057 ".$authid;
+
+my $oResult = $oConnection->search_pqf($query);
+
+my $result=$oResult->size() if ($oResult);
+
+### OLD API
+# if ($tags_using_authtype) {
+# $sth = $dbh->prepare("select count(*) from marc_subfield_table where concat(tag,subfieldcode) in ($tags_using_authtype) and MATCH(subfieldvalue) AGAINST(? IN BOOLEAN MODE)");
+# } else {
+# $sth = $dbh->prepare("select count(*) from marc_subfield_table where subfieldvalue=?");
+# }
+# warn "Q : select count(*) from marc_subfield_table where concat(tag,subfieldcode) in ($tags_using_authtype) and d MATCH(subfieldvalue) AGAINST($authid IN BOOLEAN MODE) ";
+# $sth->execute($authid);
+# my ($result) = $sth->fetchrow;
# warn "Authority $authid TOTAL USED : $result";
- return $result;
+
+ return ($result);
}
-# 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) = @_;
@@ -363,176 +338,231 @@
$authtypecode="" unless $authtypecode;
my $sth;
my $libfield = ($forlibrarian eq 1)? 'liblibrarian' : 'libopac';
- # check that framework exists
+
+
+ # 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 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;
- }
-
- $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= $dbh->prepare(
+"select tagfield,liblibrarian,libopac,mandatory,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->{$tab}->{tab} = ""; # XXX
+ $res->{$tag}->{mandatory} = $mandatory;
+ $res->{$tag}->{repeatable} = $repeatable;
+ }
+ $sth= $dbh->prepare("select tagfield,tagsubfield,liblibrarian,libopac,tab, mandatory, repeatable,authorised_value,authtypecode,value_builder,kohafield,seealso,hidden,isurl,link 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;
+ my $subfield;
+ my $authorised_value;
+ my $authtypecode;
+ 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
+# pass the MARC::Record to this function, and it will create the records in the authority table
my ($dbh,$record,$authid,$authtypecode) = @_;
- my @fields=$record->fields();
-# 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)
+
+#my $leadercode=AUTHfind_leader($dbh,$authtypecode);
+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
- 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");
+ if (!$authid) {
+ my $sth=$dbh->prepare("select max(authid) from auth_header");
$sth->execute;
($authid)=$sth->fetchrow;
+ $authid=$authid+1;
+
+##Insert the recordID in MARC record
+
+##Both authid and authtypecode is expected to be in the same field. Modify if other requirements arise
+ $record->add_fields($authfield,'','',$authidsubfield=>$authid,$authtypesubfield=>$authtypecode);
+
+ $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;
- }
- 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();
- my $subfieldorder;
- foreach my $subfield (@subfields) {
- foreach (split /\|/,@$subfield[1]) {
- $subfieldorder++;
- &AUTHaddsubfield($dbh,$authid,
- $field->tag(),
- $field->indicator(1).$field->indicator(2),
- $fieldcount,
- @$subfield[0],
- $subfieldorder,
- $_
- );
- }
- }
- }
+
+ }else{
+##Modified record reinsertid
+$record->delete_field($authfield);
+$record->add_fields($authfield,'','',$authidsubfield=>$authid,$authtypesubfield=>$authtypecode);
+
+ $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");
- return $authid;
-}
+ zebraopauth($dbh,$authid,'specialUpdate');
+if ($record->field($linkidfield)){
+my @fields=$record->field($linkidfield);
-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;
+ foreach my $field (@fields){
+my $linkid=$field->subfield($linkidsubfield) ;
+ if ($linkid){
+ ##Modify the record of linked
+ AUTHaddlink($dbh,$linkid,$authid);
}
- 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 (?,?,?,?,?,?,?)");
-# warn "==> $authid,".(sprintf "%03s",$tagid).",TAG : $tagorder,$tag_indicator,$subfieldcode,$subfieldorder,$subfieldvalue";
- $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";
+}
+ return ($authid);
+}
+
+sub AUTHaddlink{
+my ($dbh,$linkid,$authid)=@_;
+my $record=AUTHgetauthority($dbh,$linkid);
+my $authtypecode=AUTHfind_authtypecode($dbh,$linkid);
+#warn "adding l:$linkid,a:$authid,auth:$authtypecode";
+$record=AUTH2marcOnefieldlink($dbh,$record,"auth_header.linkid",$authid,$authtypecode);
+$dbh->do("lock tables auth_header WRITE");
+ my $sth=$dbh->prepare("update auth_header set marc=? where authid=?");
+ $sth->execute($record->as_usmarc,$linkid);
+ $sth->finish;
+ $dbh->do("unlock tables");
+ zebraopauth($dbh,$linkid,'specialUpdate');
+}
+
+sub AUTH2marcOnefieldlink {
+ my ( $dbh, $record, $kohafieldname, $newvalue,$authtypecode ) = @_;
+my $sth = $dbh->prepare(
+"select tagfield,tagsubfield from auth_subfield_structure where authtypecode=? and kohafield=?"
+ );
+ $sth->execute($authtypecode,$kohafieldname);
+my ($tagfield,$tagsubfield)=$sth->fetchrow;
+ $record->add_fields( $tagfield, " ", " ", $tagsubfield => $newvalue );
+ return $record;
+}
+sub zebraopauth{
+
+my ($dbh,$authid,$op)=@_;
+my $Zconnauthority;
+my $tried=0;
+my $recon=0;
+reconnect:
+$Zconnauthority=C4::Context->Zconnauth("authorityserver");
+if ($Zconnauthority ne "error"){
+my $record = AUTHgetauthority($dbh,$authid);
+my $Zpackage = $Zconnauthority->package();
+$Zpackage->option(action => $op);
+ $Zpackage->option(record => $record->as_xml_record);
+retry:
+ eval {
+ $Zpackage->send("update");
+ };
+ if ($@) {
+ if($@->code()==10007 && $tried==0){ ##Timedout -retry
+ $tried=1;
+ goto "retry";
+ }elsif($@->code()==10004 && $recon==0){##Lost connection -reconnect
+ $recon=1;
+ goto "reconnect";
+ }else{
+ warn "Error-authority updating $authid $op /CODE:", $@->code()," /MSG:",$@->message(),"\n";
+ zebrafiles($dbh,$authid,$op);
+ return;
}
- &AUTHaddword($dbh,$authid,$tagid,$tagorder,$subfieldcode,$subfieldorder,$subfieldvalue);
}
+$Zpackage->("commit") if (C4::Context->shadow);
+$Zpackage->destroy;
+}else{
+zebrafiles($dbh,$authid,$op);
+}
+}
+
+sub zebrafiles{
+
+my ($dbh,$authid,$folder)=@_;
+my $record=AUTHgetauthority($dbh,$authid);
+my $zebradir = C4::Context->zebraconfig("authorityserver")->{directory}."/".$folder."/";
+
+#my $zebradir = C4::Context->authoritydir."/".$folder."/";
+ unless (opendir(DIR, "$zebradir")) {
+warn "$zebradir not found";
+ return;
+ }
+ closedir DIR;
+ my $filename = $zebradir.$authid;
+if ($record){
+ open (OUTPUT,">", $filename.".xml");
+ print OUTPUT $record->as_xml_record;
+
+ close OUTPUT;
+}
+
+
+}
+
+
+sub AUTHfind_leader{
+##Hard coded for NEU auth types
+my($dbh,$authtypecode)=@_;
+
+my $leadercode;
+if ($authtypecode eq "AUTH"){
+$leadercode="a";
+}elsif ($authtypecode eq "ESUB"){
+$leadercode="b";
+}elsif ($authtypecode eq "TSUB"){
+$leadercode="c";
+}else{
+$leadercode=" ";
+}
+return $leadercode;
}
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,subfieldorder
- ");
- $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;
+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 {
@@ -543,128 +573,72 @@
return $sth->fetchrow_hashref;
}
sub AUTHmodauthority {
- my ($dbh,$authid,$record,$delete)=@_;
- my $oldrecord=&AUTHgetauthority($dbh,$authid);
+
+ my ($dbh,$authid,$record,$authtypecode,$merge)=@_;
+ 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,AUTHfind_authtypecode($dbh,$authid));
- # save the file in localfile/modified_authorities
- my $cgidir = C4::Context->intranetdir ."/cgi-bin";
- unless (opendir(DIR, "$cgidir")) {
- $cgidir = C4::Context->intranetdir."/";
- }
+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($dbh,"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($dbh,$linkid);
+ my $linktypecode=AUTHfind_authtypecode($dbh,$linkid);
+ my ( $linkidfield2,$linkidsubfield2)=AUTHfind_marc_from_kohafield($dbh,"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);
+ zebraopauth($dbh,$linkid,'specialUpdate');
+ }
+ }#foreach linkfield
+ }
+ }#foreach linkid
+}
+#Now rewrite the $record to table with an add
+$authid=AUTHaddauthority($dbh,$record,$authid,$authtypecode);
- my $filename = $cgidir."/localfile/modified_authorities/$authid.authid";
- open AUTH, "> $filename";
- print AUTH $authid;
- close AUTH;
+##Uncomment below and all biblios will get updated with modified authority-- To be used with $merge flag
+# &merge($dbh,$authid,$record,$authid,$record);
+return $authid;
}
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") unless $keep_biblio;
- $dbh->do("delete from auth_subfield_table where authid=$authid");
- $dbh->do("delete from auth_word where authid=$authid");
+
+zebraopauth($dbh,$authid,"recordDelete");
+ $dbh->do("delete from auth_header where authid=$authid") ;
+
# FIXME : delete or not in biblio tables (depending on $keep_biblio flag)
}
-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);
-}
-
-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);
- }
- my $sti=$dbh->prepare($query);
- $sti->execute(@bind_values);
- while (($subfieldid) = $sti->fetchrow) {
- $resultcounter++;
- $lastsubfieldid=$subfieldid;
- }
- 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;
- }
-}
-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;
-}
-# 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;
-# }
-
-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'
- ");
+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;
}
+
+
sub AUTHhtml2marc {
my ($dbh,$rtags,$rsubfields,$rvalues,%indicators) = @_;
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
@@ -705,226 +679,227 @@
return $record;
}
-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";
- }
- }
- }
-}
-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);
-}
-
-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) ;
-}
-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) ;
-}
sub FindDuplicate {
+
my ($record,$authtypecode)=@_;
- warn "IN for ".$record->as_formatted;
+# warn "IN for ".$record->as_formatted;
my $dbh = C4::Context->dbh;
-
# warn "".$record->as_formatted;
- my $sth = $dbh->prepare("select auth_tag_to_report,summary from auth_types where authtypecode=?");
+ my $sth = $dbh->prepare("select auth_tag_to_report from auth_types where authtypecode=?");
$sth->execute($authtypecode);
- my ($auth_tag_to_report,$taglist) = $sth->fetchrow;
+ my ($auth_tag_to_report) = $sth->fetchrow;
$sth->finish;
# build a request for authoritysearch
my (@tags, @and_or, @excluding, @operator, @value, $offset, $length);
- # search on biblio.title
-# warn " tag a reporter : $auth_tag_to_report";
-# warn "taglist ".$taglist;
- my @subfield = split /\[/, $taglist;
- my $max = @subfield;
- for (my $i=1; $i<$max;$i++){
- warn " ".$subfield[$i];
- $subfield[$i]=substr($subfield[$i],3,1);
-# warn " ".$subfield[$i];
- }
-
- if ($record->fields($auth_tag_to_report)) {
- my $sth = $dbh->prepare("select tagfield,tagsubfield from auth_subfield_structure where tagfield=? and authtypecode=? ");
- $sth->execute($auth_tag_to_report,$authtypecode);
-# warn " field $auth_tag_to_report exists";
- while (my ($tag,$subfield) = $sth->fetchrow){
- if ($record->field($tag)->subfield($subfield)) {
- warn "tag :".$tag." subfield: $subfield value : ".$record->field($tag)->subfield($subfield);
- push @tags, $tag.$subfield;
-# warn "'".$tag.$subfield."' value :". $record->field($tag)->subfield($subfield);
- push @and_or, "and";
+ if ($record->field($auth_tag_to_report)) {
+ push @tags, $auth_tag_to_report;
+ push @and_or, "";
push @excluding, "";
- push @operator, "=";
- push @value, $record->field($tag)->subfield($subfield);
- }
- }
- }
+ push @operator, "all";
+ push @value, $record->field($auth_tag_to_report)->as_string();
+ }
my ($finalresult,$nbresult) = authoritysearch($dbh,\@tags,\@and_or,\@excluding,\@operator,\@value,0,10,$authtypecode);
# there is at least 1 result => return the 1st one
- if ($nbresult) {
- warn "XXXXX $nbresult => ".@$finalresult[0]->{authid},@$finalresult[0]->{summary};
+ if ($nbresult>0) {
return @$finalresult[0]->{authid},@$finalresult[0]->{summary};
}
# no result, returns nothing
return;
}
+sub getsummary{
+## give this a Marc record to return summary
+my ($dbh,$record,$authid,$authtypecode)=@_;
+# my $authtypecode = AUTHfind_authtypecode($dbh,$authid);
+ my $authref = getauthtype($authtypecode);
+ my $summary = $authref->{summary};
+ my @fields = $record->fields();
+# chop $tags_using_authtype;
+ # if the library has a summary defined, use it. Otherwise, build a standard one
+ if ($summary) {
+ my @fields = $record->fields();
+ 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) {
+ } 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');
+ } 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;
+}
+sub merge {
+ my ($dbh,$mergefrom,$MARCfrom,$mergeto,$MARCto) = @_;
+ my $authtypecodefrom = AUTHfind_authtypecode($dbh,$mergefrom);
+ my $authtypecodeto = AUTHfind_authtypecode($dbh,$mergeto);
+ # return if authority does not exist
+ my @X = $MARCfrom->fields();
+ return if $#X == -1;
+ my @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;
+ @record_from = $MARCfrom->field($auth_tag_to_report)->subfields() if $MARCfrom->field($auth_tag_to_report);
+
+ # search all biblio tags using this authority.
+ $sth = $dbh->prepare("select distinct tagfield from marc_subfield_structure where authtypecode=?");
+ $sth->execute($authtypecodefrom);
+my @tags_using_authtype;
+ while (my ($tagfield) = $sth->fetchrow) {
+ push @tags_using_authtype,$tagfield."9" ;
+ }
+
+ # now, find every biblio using this authority
+### try ZOOM search here
+my $oConnection=C4::Context->Zconn("biblioserver");
+
+
+my $query;
+
+$query= "\@attr GILS 1=2057 ".$mergefrom;
+
+my $oResult = $oConnection->search_pqf($query);
+
+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 $oldbiblio = MARCmarc2koha($dbh,$marcrecord,"") ;
+ if ($update==1){
+ &NEWmodbiblio($dbh,$marcrecord,$oldbiblio->{'biblionumber'},undef,"0000") ;
+ }
+
+}#foreach $marc
+}#sub
END { } # module clean-up code here (global destructor)
=back
@@ -937,35 +912,11 @@
=cut
-# $Id: AuthoritiesMarc.pm,v 1.24 2006/02/09 01:56:20 rangi Exp $
+# $Id: AuthoritiesMarc.pm,v 1.25 2006/05/19 18:09:39 tgarip1957 Exp $
# $Log: AuthoritiesMarc.pm,v $
-# Revision 1.24 2006/02/09 01:56:20 rangi
-# Hmm there seem to be quite a few subroutines twice in this module....
-#
-# Paul could you take a look and remove the ones that shouldnt be there please
-#
-# Revision 1.23 2006/02/09 01:52:14 rangi
-# Cleaning up some unessecary my statements
-#
-# Revision 1.22 2006/01/06 16:39:37 tipaul
-# synch'ing head and rel_2_2 (from 2.2.5, including npl templates)
-# Seems not to break too many things, but i'm probably wrong here.
-# at least, new features/bugfixes from 2.2.5 are here (tested on some features on my head local copy)
-#
-# - removing useless directories (koha-html and koha-plucene)
-#
-# Revision 1.21 2005/10/26 09:12:33 tipaul
-# big commit, still breaking things...
-#
-# * synch with rel_2_2. Probably the last non manual synch, as rel_2_2 should not be modified deeply.
-# * code cleaning (cleaning warnings from perl -w) continued
-#
-# Revision 1.9.2.8 2005/10/25 12:38:59 tipaul
-# * fixing bug in summary (separator before subfield was in fact after)
-# * fixing bug in authority order : authorities are not ordered alphabetically instead of no order. Requires all the dataset to be retrieved, but the benefits is important !
-#
-# Revision 1.9.2.7 2005/08/01 15:14:50 tipaul
-# minor change in summary handling (accepting 4 digits before the field)
+# Revision 1.25 2006/05/19 18:09:39 tgarip1957
+# All support for auth_subfield_tables is removed. All search is now with zebra authorities. New authority structure allows multiple linking of authorities of differnet types to one another.
+# Authority tables are modified to be compatible with new MARC frameworks. This change is part of Authority Linking & Zebra authorities. Requires change in Mysql database. It will break head unless all changes regarding this is implemented. This warning will take place on all commits regarding this
#
# Revision 1.9.2.6 2005/06/07 10:02:00 tipaul
# porting dictionnary search from head to 2.2. there is now a ... facing titles, author & subject, to search in biblio & authorities existing values.
More information about the Koha-cvs
mailing list