Plugin for field 124e
[koha.git] / C4 / AuthoritiesMarc.pm
index eb456d4..c5a9dba 100644 (file)
@@ -41,6 +41,9 @@ $VERSION = 0.01;
        &AUTHaddsubfield
        &AUTHgetauthority
        
+       &AUTHgetauth_type
+       &AUTHcount_usage
+       
        &authoritysearch
        
        &MARCmodsubfield
@@ -48,6 +51,7 @@ $VERSION = 0.01;
        &AUTHaddword
        &MARCaddword &MARCdelword
        &char_decode
+       &FindDuplicate
  );
 
 sub authoritysearch {
@@ -58,7 +62,27 @@ sub authoritysearch {
        #               where m1.authid=m2.authid and
        #               (m1.subfieldvalue like "Des%" and m2.subfieldvalue like "27%")
 
+       # 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 = ();
@@ -66,6 +90,11 @@ sub authoritysearch {
        # Extracts the NOT statements from the list of statements
        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]))
@@ -93,6 +122,7 @@ sub authoritysearch {
        my ($sql_tables, $sql_where1, $sql_where2) = create_request($dbh,\@normal_tags, \@normal_and_or, \@normal_operator, \@normal_value);
 
        my $sth;
+
        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)";
@@ -102,9 +132,7 @@ sub authoritysearch {
        }
        $sth->execute($authtypecode);
        my @result = ();
-
        while (my ($authid) = $sth->fetchrow) {
-                       warn "AUTH: $authid";
                        push @result,$authid;
                }
 
@@ -130,7 +158,7 @@ sub authoritysearch {
                                        my $subfieldcode = $subf[$i][0];
                                        my $subfieldvalue = $subf[$i][1];
                                        my $tagsubf = $tag.$subfieldcode;
-                                       $summary =~ s/\[(.?.?.?)$tagsubf(.*?)]/$1$subfieldvalue\[$1$tagsubf$2]$2$3/g;
+                                       $summary =~ s/\[(.?.?.?)$tagsubf(.*?)]/$1$subfieldvalue$2\[$1$tagsubf$2]/g;
                                }
                        }
                }
@@ -154,6 +182,8 @@ sub authoritysearch {
                $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') if $record->field($mainentrytag);
                $counter++;
                push @finalresult, \%newline;
        }
@@ -172,9 +202,11 @@ sub create_request {
        my $nb_active=0; # will contain the number of "active" entries. and entry is active is a value is provided.
        my $nb_table=1; # will contain the number of table. ++ on each entry EXCEPT when an OR  is provided.
 
+
        for(my $i=0; $i<=@$value;$i++) {
                if (@$value[$i]) {
                        $nb_active++;
+#                      warn " @$tags[$i]";
                        if ($nb_active==1) {
                                if (@$operator[$i] eq "start") {
                                        $sql_tables .= "auth_subfield_table as m$nb_table,";
@@ -183,14 +215,15 @@ sub create_request {
                                                $sql_where1 .=" and m1.tag+m1.subfieldcode in (@$tags[$i])";
                                        }
                                        $sql_where1.=")";
-                               } elsif (@$operator[$i] eq "contains") {
-                                       $sql_tables .= "auth_word as m$nb_table,";
+                               } 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]) {
@@ -250,6 +283,7 @@ sub create_request {
                $sql_where2 = "";
        }
        chop $sql_tables;       # deletes the trailing ','
+       
        return ($sql_tables, $sql_where1, $sql_where2);
 }
 
@@ -267,7 +301,11 @@ sub AUTHcount_usage {
                $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=?");
+       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;
@@ -314,9 +352,7 @@ sub AUTHfind_authtypecode {
 
 sub AUTHgettagslib {
        my ($dbh,$forlibrarian,$authtypecode)= @_;
-#      warn "AUTH : $authtypecode";
        $authtypecode="" unless $authtypecode;
-#      warn "AUTH : $authtypecode";
        my $sth;
        my $libfield = ($forlibrarian eq 1)? 'liblibrarian' : 'libopac';
        # check that framework exists
@@ -487,6 +523,13 @@ sub AUTHgetauthority {
        return $record;
 }
 
+sub AUTHgetauth_type {
+       my ($authtypecode) = @_;
+       my $dbh=C4::Context->dbh;
+       my $sth=$dbh->prepare("select * from auth_types where authtypecode=?");
+       $sth->execute($authtypecode);
+       return $sth->fetchrow_hashref;
+}
 sub AUTHmodauthority {
        my ($dbh,$authid,$record,$delete)=@_;
        my $oldrecord=&AUTHgetauthority($dbh,$authid);
@@ -496,8 +539,12 @@ sub AUTHmodauthority {
 # 1st delete the authority,
 # 2nd recreate it
        &AUTHdelauthority($dbh,$authid,1);
-       &AUTHaddauthority($dbh,$record,$authid);
-       # FIXME : modify the authority in biblio too.
+       &AUTHaddauthority($dbh,$record,$authid,AUTHfind_authtypecode($dbh,$authid));
+       # save the file in localfile/modified_authorities
+       my $filename = C4::Context->config("intranetdir")."/localfile/modified_authorities/$authid.authid";
+       open AUTH, "> $filename";
+       print AUTH $authid;
+       close AUTH;
 }
 
 sub AUTHdelauthority {
@@ -508,7 +555,7 @@ sub AUTHdelauthority {
 # the best solution for a modif is to delete / recreate the record.
 
        my $record = AUTHgetauthority($dbh,$authid);
-       $dbh->do("delete from auth_header where authid=$authid");
+       $dbh->do("delete from auth_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");
 # FIXME : delete or not in biblio tables (depending on $keep_biblio flag)
@@ -809,6 +856,57 @@ sub nsb_clean {
        return($string) ;
 }
 
+sub FindDuplicate {
+       my ($record,$authtypecode)=@_;
+       warn "IN for ".$record->as_formatted;
+       my $dbh = C4::Context->dbh;
+
+#      warn "".$record->as_formatted;
+       my $sth = $dbh->prepare("select auth_tag_to_report,summary from auth_types where authtypecode=?");
+       $sth->execute($authtypecode);
+       my ($auth_tag_to_report,$taglist) = $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";
+                               push @excluding, "";
+                               push @operator, "=";
+                               push @value, $record->field($tag)->subfield($subfield);
+                       }
+               }
+       }
+       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};
+               return @$finalresult[0]->{authid},@$finalresult[0]->{summary};
+       }
+       # no result, returns nothing
+       return;
+}
+
+
 END { }       # module clean-up code here (global destructor)
 
 =back
@@ -823,6 +921,43 @@ Paul POULAIN paul.poulain@free.fr
 
 # $Id$
 # $Log$
+# Revision 1.17  2005/06/01 12:51:02  tipaul
+# some fixes & improvements for dictionnary search in librarian interface
+#
+# Revision 1.16  2005/05/04 15:43:43  tipaul
+# synch'ing 2.2 and head
+#
+# Revision 1.9.2.3  2005/04/28 08:45:33  tipaul
+# porting FindDuplicate feature for authorities from HEAD to rel_2_2, works correctly now.
+#
+# Revision 1.9.2.2  2005/02/28 14:03:13  tipaul
+# * adding search on "main entry" (ie $a subfield) on a given authority (the "search everywhere" field is still here).
+# * adding a select box to requet "contain" or "begin with" search.
+# * fixing some bug in authority search (related to "main entry" search)
+#
+# Revision 1.9.2.1  2005/02/24 13:12:13  tipaul
+# saving authority modif in a text file. This will be used soon with another script (in crontab). The script in crontab will retrieve every authorityid in the directory localfile/authorities and modify every biblio using this authority. Those modifs may be long. So they can't be done through http, because we may encounter a webserver timeout, and kill the process before end of the job.
+# So, it will be done through a cron job.
+# (/me agree we need some doc for command line scripts)
+#
+# Revision 1.9  2004/12/23 09:48:11  tipaul
+# Minor changes in summary "exploding" (the 3 digits AFTER the subfield were not on the right place).
+#
+# Revision 1.8  2004/11/05 10:11:39  tipaul
+# export auth_count_usage (bugfix)
+#
+# Revision 1.7  2004/09/23 16:13:00  tipaul
+# Bugfix in modification
+#
+# Revision 1.6  2004/08/18 16:00:24  tipaul
+# fixes for authorities management
+#
+# Revision 1.5  2004/07/05 13:37:22  doxulting
+# First step for working authorities
+#
+# Revision 1.4  2004/06/22 11:35:37  tipaul
+# removing % at the beginning of a string to avoid loooonnnngggg searchs
+#
 # Revision 1.3  2004/06/17 08:02:13  tipaul
 # merging tag & subfield in auth_word for better perfs
 #