[Koha-cvs] CVS: koha/C4 AuthoritiesMarc.pm,1.2,1.3

[Paul POULAIN]

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 (address@hidden, $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 (address@hidden, $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)