[Koha-cvs] CVS: koha/C4 AuthoritiesMarc.pm,1.2,1.3
Paul POULAIN
tipaul at users.sourceforge.net
Thu Jun 17 10:02:15 CEST 2004
Update of /cvsroot/koha/koha/C4
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv3056/C4
Modified Files:
AuthoritiesMarc.pm
Log Message:
merging tag & subfield in auth_word for better perfs
Index: AuthoritiesMarc.pm
===================================================================
RCS file: /cvsroot/koha/koha/C4/AuthoritiesMarc.pm,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -r1.2 -r1.3
*** AuthoritiesMarc.pm 10 Jun 2004 08:29:01 -0000 1.2
--- AuthoritiesMarc.pm 17 Jun 2004 08:02:13 -0000 1.3
***************
*** 23,26 ****
--- 23,27 ----
use C4::Koha;
use MARC::Record;
+ use C4::Biblio;
use vars qw($VERSION @ISA @EXPORT);
***************
*** 113,117 ****
my $oldline;
while (($counter <= $#result) && ($counter <= ($offset + $length))) {
! warn "HERE";
# get MARC::Record of the authority
my $record = AUTHgetauthority($dbh,$result[$counter]);
--- 114,118 ----
my $oldline;
while (($counter <= $#result) && ($counter <= ($offset + $length))) {
! # warn " HERE : $counter, $#result, $offset, $length";
# get MARC::Record of the authority
my $record = AUTHgetauthority($dbh,$result[$counter]);
***************
*** 136,147 ****
$summary =~ s/\[(.*?)]//g;
$summary =~ s/\n/<br>/g;
# then add a line for the template loop
my %newline;
$newline{summary} = $summary;
$newline{authid} = $result[$counter];
push @finalresult, \%newline;
- my $nbresults = $#result + 1;
- return (\@finalresult, $nbresults);
}
}
--- 137,163 ----
$summary =~ s/\[(.*?)]//g;
$summary =~ s/\n/<br>/g;
+
+ # find biblio MARC field using this authtypecode (to jump to biblio)
+ my $authtypecode = AUTHfind_authtypecode($dbh,$result[$counter]);
+ my $sth = $dbh->prepare("select distinct tagfield from marc_subfield_structure where authtypecode=?");
+ $sth->execute($authtypecode);
+ my $tags_using_authtype;
+ while (my ($tagfield) = $sth->fetchrow) {
+ # warn "TAG : $tagfield";
+ $tags_using_authtype.= $tagfield."9,";
+ }
+ chop $tags_using_authtype;
+
# then add a line for the template loop
my %newline;
$newline{summary} = $summary;
$newline{authid} = $result[$counter];
+ $newline{used} = &AUTHcount_usage($result[$counter]);
+ $newline{biblio_fields} = $tags_using_authtype;
+ $counter++;
push @finalresult, \%newline;
}
+ my $nbresults = $#result + 1;
+ return (\@finalresult, $nbresults);
}
***************
*** 172,176 ****
$sql_where1 .= "(m1.word like ".$dbh->quote("@$value[$i]%");
if (@$tags[$i]) {
! $sql_where1 .=" and m1.tag+m1.subfieldid in (@$tags[$i])";
}
$sql_where1.=")";
--- 188,192 ----
$sql_where1 .= "(m1.word like ".$dbh->quote("@$value[$i]%");
if (@$tags[$i]) {
! $sql_where1 .=" and m1.tagsubfield in (@$tags[$i])";
}
$sql_where1.=")";
***************
*** 199,203 ****
$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.=")";
--- 215,219 ----
$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.=")";
***************
*** 239,242 ****
--- 255,307 ----
+ sub AUTHcount_usage {
+ my ($authid) = @_;
+ my $dbh = C4::Context->dbh;
+ # find MARC fields using this authtype
+ my $authtypecode = AUTHfind_authtypecode($dbh,$authid);
+ my $sth = $dbh->prepare("select distinct tagfield from marc_subfield_structure where authtypecode=?");
+ $sth->execute($authtypecode);
+ my $tags_using_authtype;
+ while (my ($tagfield) = $sth->fetchrow) {
+ # warn "TAG : $tagfield";
+ $tags_using_authtype.= "'".$tagfield."9',";
+ }
+ chop $tags_using_authtype;
+ $sth = $dbh->prepare("select count(*) from marc_subfield_table where concat(tag,subfieldcode) in ($tags_using_authtype) and subfieldvalue=?");
+ # warn "Q : select count(*) from marc_subfield_table where concat(tag,subfieldcode) in ($tags_using_authtype) and subfieldvalue=$authid";
+ $sth->execute($authid);
+ my ($result) = $sth->fetchrow;
+ # warn "Authority $authid TOTAL USED : $result";
+ return $result;
+ }
+
+ # 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) = @_;
***************
*** 444,448 ****
my $record = AUTHgetauthority($dbh,$authid);
! $dbh->do("delete from auth_biblio where authid=$authid");
$dbh->do("delete from auth_subfield_table where authid=$authid");
$dbh->do("delete from auth_word where authid=$authid");
--- 509,513 ----
my $record = AUTHgetauthority($dbh,$authid);
! $dbh->do("delete from auth_header where authid=$authid");
$dbh->do("delete from auth_subfield_table where authid=$authid");
$dbh->do("delete from auth_word where authid=$authid");
***************
*** 583,594 ****
my @words = split / /,$sentence;
my $stopwords= C4::Context->stopwords;
! my $sth=$dbh->prepare("insert into auth_word (authid, tag, tagorder, subfieldid, subfieldorder, word, sndx_word)
! values (?,?,?,?,?,?,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,$tagorder,$subfieldid,$subfieldorder,$word,$word);
if ($sth->err()) {
! warn "ERROR ==> insert into auth_word (authid, tag, tagorder, subfieldid, subfieldorder, word, sndx_word) values ($authid,$tag,$tagorder,$subfieldid,$subfieldorder,$word,soundex($word))\n";
}
}
--- 648,659 ----
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";
}
}
***************
*** 599,604 ****
# 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 tag=? and tagorder=? and subfieldid=? and subfieldorder=?");
! $sth->execute($authid,$tag,$tagorder,$subfield,$subfieldorder);
}
--- 664,669 ----
# 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);
}
***************
*** 759,762 ****
--- 824,830 ----
# $Id$
# $Log$
+ # Revision 1.3 2004/06/17 08:02:13 tipaul
+ # merging tag & subfield in auth_word for better perfs
+ #
# Revision 1.2 2004/06/10 08:29:01 tipaul
# MARC authority management (continued)
More information about the Koha-cvs
mailing list