[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Koha-cvs] koha/C4 AuthoritiesMarc.pm
|
From: |
Tumer Garip |
|
Subject: |
[Koha-cvs] koha/C4 AuthoritiesMarc.pm |
|
Date: |
Fri, 19 May 2006 18:09:39 +0000 |
CVSROOT: /sources/koha
Module name: koha
Branch:
Changes by: Tumer Garip <address@hidden> 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="address@hidden 1=1013 address@hidden 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,address@hidden, address@hidden, address@hidden,
address@hidden);
+ if (@$value[$i]){
+ ##If mainentry search $a tag
+ if (@$tags[$i] eq "mainentry") {
+ $attr =" address@hidden 1=21 ";
+ }else{
+ $attr =" address@hidden 1=47 ";
+ }
+
+
+
+ if (@$operator[$i] eq 'phrase') {
+ $attr.=" address@hidden 4=1 address@hidden 5=100
address@hidden 3=1 ";##Phrase, No truncation, first in field###It seems not
implemented by indexdata
+
+ } else {
+
+ $attr .=" address@hidden 4=6 address@hidden 5=1 ";##
Word list, right truncated, anywhere
+ }
+
+
+ $and .=" address@hidden " ;
+ $attr =$attr."\""address@hidden"\"";
+ $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:", address@hidden>code()," /MSG:",address@hidden>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 (address@hidden, $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= "address@hidden GILS 1=2057 ".$finalresult[$z]{authid};
+ $nquery="address@hidden ".$nquery." address@hidden GILS 1=2057
".$finalresult[$z]{linkid} if $finalresult[$z]{linkid};
+
+ eval{
+ $oResult = $oConnection->search_pqf($nquery);
+ };
+ if($@){
+ warn " /CODE:", address@hidden>code(),"
/MSG:",address@hidden>message(),"\n";
+ }
+ my $count=$oResult->size() if ($oResult);
+ $finalresult[$z]{used}=$count;
+}##for Zconn
+ $oResult->destroy();
+# $oConnection->destroy();
+}## if nbresult
+ return (address@hidden, $nbresults);
}
# Creates the SQL Request
@@ -214,72 +239,33 @@
for(my $i=0; $i<address@hidden;$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= "address@hidden 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)address@hidden;
+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)address@hidden;
+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(address@hidden>code()==10007 && $tried==0){ ##Timedout -retry
+ $tried=1;
+ goto "retry";
+ }elsif(address@hidden>code()==10004 && $recon==0){##Lost
connection -reconnect
+ $recon=1;
+ goto "reconnect";
+ }else{
+ warn "Error-authority updating $authid $op /CODE:",
address@hidden>code()," /MSG:",address@hidden>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)address@hidden;
+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)address@hidden;
+
+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)address@hidden;
- 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)address@hidden;
- my $oldrecord=&AUTHgetauthority($dbh,$authid);
+
+ my ($dbh,$authid,$record,$authtypecode,$merge)address@hidden;
+ 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 )address@hidden;
- $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)
address@hidden;
- $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)address@hidden;
- 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,address@hidden,address@hidden,address@hidden,address@hidden,address@hidden,0,10,$authtypecode);
# there is at least 1 result => return the 1st one
- if ($nbresult) {
- warn "XXXXX $nbresult =>
"address@hidden>{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)address@hidden;
+# 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= "address@hidden 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.
- [Koha-cvs] koha/C4 AuthoritiesMarc.pm,
Tumer Garip <=