From dfb739be5a8c4e40c0d4e6074b0b7c36b57d9ce3 Mon Sep 17 00:00:00 2001 From: gmccullagh Date: Fri, 3 Jun 2005 17:01:53 +0000 Subject: [PATCH] two new files SearchBiblio.pm forked from SearchMarc.pm opac-search-biblio.pl forked from opac-search.pl (just change module) an attempt at a new search using FULLTEXT indexes. NB: Boolean won't work without MySQL >v4.0 NNB: Will be slow without indexes added on Biblio table as follows: ALTER TABLE biblio ADD FULLTEXT (author,title,unititle,seriestitle); Only searching on "Any word" field just now. more to come. --- C4/SearchBiblio.pm | 716 +++++++++++++++++++++++++++++++++++++ opac/opac-search-biblio.pl | 415 +++++++++++++++++++++ 2 files changed, 1131 insertions(+) create mode 100644 C4/SearchBiblio.pm create mode 100755 opac/opac-search-biblio.pl diff --git a/C4/SearchBiblio.pm b/C4/SearchBiblio.pm new file mode 100644 index 0000000000..c896723061 --- /dev/null +++ b/C4/SearchBiblio.pm @@ -0,0 +1,716 @@ +package C4::SearchBiblio; + +# Copyright 2000-2002 Katipo Communications +# +# This file is part of Koha. +# +# Koha is free software; you can redistribute it and/or modify it under the +# terms of the GNU General Public License as published by the Free Software +# Foundation; either version 2 of the License, or (at your option) any later +# version. +# +# Koha is distributed in the hope that it will be useful, but WITHOUT ANY +# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR +# A PARTICULAR PURPOSE. See the GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License along with +# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place, +# Suite 330, Boston, MA 02111-1307 USA + +use strict; +require Exporter; +use DBI; +use C4::Context; +use C4::Biblio; +use C4::Date; +use Date::Manip; + +use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); + +# set the version for version checking +$VERSION = 0.02; + +=head1 NAME + +C4::Search - Functions for searching the Koha MARC catalog + +=head1 FUNCTIONS + +This module provides the searching facilities for the Koha MARC catalog + +=cut + +@ISA = qw(Exporter); +@EXPORT = qw(&catalogsearch1 &catalogsearch &findseealso &findsuggestion &getMARCnotes &getMARCsubjects); + +=head1 findsuggestion($dbh,$values); + +=head2 $dbh is a link to the DB handler. + +use C4::Context; +my $dbh =C4::Context->dbh; + +=head2 $values is a word + +Searches words with the same soundex, ordered by frequency of use. +Useful to suggest other searches to the users. + +=cut + +sub findsuggestion { + my ($dbh,$values) = @_; + my $sth = $dbh->prepare("SELECT count( * ) AS total, word FROM marc_word WHERE sndx_word = soundex( ? ) AND word <> ? GROUP BY word ORDER BY total DESC"); + my @results; + for(my $i = 0 ; $i <= $#{$values} ; $i++) { + if (length(@$values[$i]) >=5) { + $sth->execute(@$values[$i],@$values[$i]); + my $resfound = 1; + my @resline; + while ((my ($count,$word) = $sth->fetchrow) and $resfound <=10) { + push @results, "@$values[$i]|$word|$count"; +# $results{@$values[$i]} = \@resline; + $resfound++; + } + } + } + return \@results; +} + +=head1 findseealso($dbh,$fields); + +=head2 $dbh is a link to the DB handler. + +use C4::Context; +my $dbh =C4::Context->dbh; + +=head2 $fields is a reference to the fields array + +This function modify the @$fields array and add related fields to search on. + +=cut + +sub findseealso { + my ($dbh, $fields) = @_; + my $tagslib = MARCgettagslib ($dbh,1); + for (my $i=0;$i<=$#{$fields};$i++) { + my ($tag) =substr(@$fields[$i],1,3); + my ($subfield) =substr(@$fields[$i],4,1); + @$fields[$i].=','.$tagslib->{$tag}->{$subfield}->{seealso} if ($tagslib->{$tag}->{$subfield}->{seealso}); + } +} + +=head1 my ($count, @results) = catalogsearch($dbh, $tags, $and_or, $excluding, $operator, $value, $offset,$length,$orderby,$sqlstring); + +=head2 $dbh is a link to the DB handler. + +use C4::Context; +my $dbh =C4::Context->dbh; + +$tags,$and_or, $excluding, $operator, $value are references to array + +=head2 $tags + +contains the list of tags+subfields (for example : $@tags[0] = '200a') +A field can be a list of fields : '200f','700a','700b','701a','701b' + +Example + +=head2 $and_or + +contains a list of strings containing and or or. The 1st value is useless. + +=head2 $excluding + +contains 0 or 1. If 1, then the request is negated. + +=head2 $operator + +contains contains,=,start,>,>=,<,<= the = and start work on the complete subfield. The contains operator works on every word in the subfield. + +examples : +contains home, search home anywhere. += home, search a string being home. + +=head2 $value + +contains the value to search +If it contains a * or a %, then the search is partial. + +=head2 $offset and $length + +returns $length results, beginning at $offset + +=head2 $orderby + +define the field used to order the request. Any field in the biblio/biblioitem tables can be used. DESC is possible too + +(for example title, title DESC,...) + +=head2 $sqlstring + +optional argument containing an sql string to be used in the 'where' statement. see usage in opac-search.pl. + +=head2 RETURNS + +returns an array containing hashes. The hash contains all biblio & biblioitems fields and a reference to an item hash. The "item hash contains one line for each callnumber & the number of items related to the callnumber. + +=cut + +=head2 my $marcnotesarray = &getMARCnotes($dbh,$bibid,$marcflavour); + +Returns a reference to an array containing all the notes stored in the MARC database for the given bibid. +$marcflavour ("MARC21" or "UNIMARC") determines which tags are used for retrieving subjects. + +=head2 my $marcsubjctsarray = &getMARCsubjects($dbh,$bibid,$marcflavour); + +Returns a reference to an array containing all the subjects stored in the MARC database for the given bibid. +$marcflavour ("MARC21" or "UNIMARC") determines which tags are used for retrieving subjects. + +=cut + +sub catalogsearch1 { + my ($dbh, $tags, $and_or, $excluding, $operator, $value, $offset,$length,$orderby,$desc_or_asc,$sqlstring) = @_; +# warn "=================="; +# warn " +# db: $dbh, +# tags_array: @$tags, +# andor_array: @$and_or, +# excludes_array: @$excluding, +# operator_array: @$operator, +# value_array: @$value, +# start: $offset, +# resultsperpage: $length, +# orderby: $orderby, +# order: $desc_or_asc, +# sqlstring: $sqlstring)\n"; +# warn "==================\n"; + + my @cols = ('biblionumber','author','title','unititle','notes','serial','seriestitle', + 'copyrightdate','timestamp','abstract','illus','biblioitemnumber','marc', + 'url','isbn','volumeddesc','classification','publicationyear','pages','number', + 'itemtype','place','issn','size','dewey','publishercode','lccn','volume', + 'subclass', 'volumedate','subtitle','bibid','notforloan',); + # missing 'CN', 'description', 'odd', 'bn', 'norequests', 'totitem', + my @valarray = @$value; +# warn "@$value\n"; +# warn "$valarray[0]\n"; + my $sql = " + SELECT biblio.biblionumber, biblio.author, biblio.title, biblio.unititle, + biblio.notes, biblio.serial, biblio.seriestitle, biblio.copyrightdate, + biblio.timestamp, biblio.abstract, + biblioitems.illus, biblioitems.biblioitemnumber, biblioitems.marc, + biblioitems.url, biblioitems.isbn, biblioitems.volumeddesc, + biblioitems.classification, biblioitems.publicationyear, + biblioitems.pages, biblioitems.number, biblioitems.itemtype, + biblioitems.place, biblioitems.issn, biblioitems.size, + biblioitems.dewey, biblioitems.publishercode, biblioitems.lccn, + biblioitems.volume, biblioitems.subclass, biblioitems.volumedate, + bibliosubtitle.subtitle, + marc_biblio.bibid, + items.notforloan, + MATCH(biblio.title,biblio.author,biblio.unititle,biblio.seriestitle) + AGAINST ('$$value[0]' IN BOOLEAN MODE) as Relevance + FROM biblio + LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber + LEFT JOIN bibliosubtitle ON bibliosubtitle.biblionumber=biblio.biblionumber + LEFT JOIN marc_biblio ON marc_biblio.biblionumber=biblio.biblionumber + LEFT JOIN items ON items.biblionumber=biblio.biblionumber + WHERE MATCH(biblio.title,biblio.author,biblio.unititle,biblio.seriestitle) + AGAINST ('$$value[0]' IN BOOLEAN MODE) + ORDER BY Relevance DESC;"; + warn "$sql\n"; + my $sth = $dbh->prepare($sql); + $sth->execute; + my @biblioArray=(); + my $numBooks=0; + while (my @vals = $sth->fetchrow) { + my $numcols = $#vals; + my %biblioEntryHash=(); + for(my $i=0; $i<$numcols; $i++) { + $biblioEntryHash{$cols[$i]} = $vals[$i]; + } + $biblioEntryHash{odd} = ((($numBooks+1) % 2) > 0) ? 1 : ""; + #FIXME + $biblioEntryHash{notforloan} = ""; + #warn "\$biblioEntryHash{odd} = .$biblioEntryHash{odd}.\n"; + push(@biblioArray,\%biblioEntryHash); + $numBooks++; + } + + +# CN: ARRAY(0x89d1540)? branch + location + callnumber + status +# CDI SL (N8KIM) (2) (if several, group them) +# description: ? +# odd: 1 ? +# bn: 501? biblionumber? +# norequests: 0? +# totitem: 1? + +# my ($res,$numres) = catalogsearch(@_); +# my @results = @$res; +# warn "==================\n"; +# warn "\n\tres: @$res:,\n\tnumres: $numres\n"; +# while ( (my ($key, $value) = each(%{$results[0]})) && (my ($key1, $value1) = each(%{$biblioArray[0]})) ) { +# warn "\t$key => $value\t$key1 => $value1\n"; +# } +# warn "a. " . $results[0]->{odd} . "\t" . $biblioArray[0]->{odd}. "\n"; +# warn "b. " . $results[1]->{odd} . "\t" . $biblioArray[1]->{odd}. "\n"; +# warn "==================\n"; + #return ($res,$numres); + return (\@biblioArray,$numBooks); +} + +sub catalogsearch { + my ($dbh, $tags, $and_or, $excluding, $operator, $value, $offset,$length,$orderby,$desc_or_asc,$sqlstring) = @_; + # build the sql request. She will look like : + # select m1.bibid + # from marc_subfield_table as m1, marc_subfield_table as m2 + # where m1.bibid=m2.bibid and + # (m1.subfieldvalue like "Des%" and m2.subfieldvalue like "27%") + + # last minute stripping out of stuff + # doesn't work @$value =~ s/\'/ /; + # @$value = map { $_ =~ s/\'/ /g } @$value; + + # "Normal" statements + my @normal_tags = (); + my @normal_and_or = (); + my @normal_operator = (); + my @normal_value = (); + # Extracts the NOT statements from the list of statements + my @not_tags = (); + my @not_and_or = (); + my @not_operator = (); + my @not_value = (); + my $any_not = 0; + $orderby = "biblio.title" unless $orderby; + $desc_or_asc = "ASC" unless $desc_or_asc; + #last minute stripping out of ' and , +# paul : quoting, it's done a few lines lated. +# foreach $_ (@$value) { +# $_=~ s/\'/ /g; +# $_=~ s/\,/ /g; +# } + +# the item.notforloan contains an integer. Every value <>0 means "book unavailable for loan". +# but each library can have it's own table of meaning for each value. Get them +# 1st search if there is a list of authorised values connected to items.notforloan + my $sth = $dbh->prepare('select authorised_value from marc_subfield_structure where kohafield="items.notforloan"'); + $sth->execute; + my %notforloanstatus; + my ($authorised_valuecode) = $sth->fetchrow; + if ($authorised_valuecode) { + $sth = $dbh->prepare("select authorised_value,lib from authorised_values where category=?"); + $sth->execute($authorised_valuecode); + while (my ($authorised_value,$lib) = $sth->fetchrow) { + $notforloanstatus{$authorised_value} = $lib?$lib:$authorised_value; + } + } + 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(@$excluding[$i]) # NOT statements + { + $any_not = 1; + if(@$operator[$i] eq "contains") + { + foreach my $word (split(/ /, @$value[$i])) # if operator is contains, splits the words in separate requests + { + # remove the "%" for small word (3 letters. (note : the >4 is due to the % at the end) +# warn "word : $word"; + $word =~ s/%//g unless length($word)>4; + unless (C4::Context->stopwords->{uc($word)} or length($word)==1) { #it's NOT a stopword => use it. Otherwise, ignore + push @not_tags, @$tags[$i]; + push @not_and_or, "or"; # as request is negated, finds "foo" or "bar" if final request is NOT "foo" and "bar" + push @not_operator, @$operator[$i]; + push @not_value, $word; + } + } + } + else + { + push @not_tags, @$tags[$i]; + push @not_and_or, "or"; # as request is negated, finds "foo" or "bar" if final request is NOT "foo" and "bar" + push @not_operator, @$operator[$i]; + push @not_value, @$value[$i]; + } + } + else # NORMAL statements + { + if(@$operator[$i] eq "contains") # if operator is contains, splits the words in separate requests + { + foreach my $word (split(/ /, @$value[$i])) + { + # remove the "%" for small word (3 letters. (note : the >4 is due to the % at the end) +# warn "word : $word"; + $word =~ s/%//g unless length($word)>4; + unless (C4::Context->stopwords->{uc($word)} or length($word)==1) { #it's NOT a stopword => use it. Otherwise, ignore + 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); + $sql_where1 .=" ". $sqlstring; + $sql_where1 .= "and TO_DAYS( NOW( ) ) - TO_DAYS( biblio.timestamp ) <30" if $orderby =~ "biblio.timestamp"; + my $sth; + if ($sql_where2) { + $sth = $dbh->prepare("select distinct m1.bibid from biblio,biblioitems,items,marc_biblio,$sql_tables where biblio.biblionumber=marc_biblio.biblionumber and biblio.biblionumber=biblioitems.biblionumber and m1.bibid=marc_biblio.bibid and $sql_where2 and ($sql_where1) order by $orderby $desc_or_asc"); + warn "Q2 : select distinct m1.bibid from biblio,biblioitems,items,marc_biblio,$sql_tables where biblio.biblionumber=marc_biblio.biblionumber and biblio.biblionumber=biblioitems.biblionumber and m1.bibid=marc_biblio.bibid and $sql_where2 and ($sql_where1) order by $orderby $desc_or_asc term is @$value"; + } else { + $sth = $dbh->prepare("select distinct m1.bibid from biblio,biblioitems,items,marc_biblio,$sql_tables where biblio.biblionumber=marc_biblio.biblionumber and biblio.biblionumber=biblioitems.biblionumber and m1.bibid=marc_biblio.bibid and $sql_where1 order by $orderby $desc_or_asc"); + warn "Q : select distinct m1.bibid from biblio,biblioitems,items,marc_biblio,$sql_tables where biblio.biblionumber=marc_biblio.biblionumber and biblio.biblionumber=biblioitems.biblionumber and m1.bibid=marc_biblio.bibid and $sql_where1 order by $orderby $desc_or_asc"; + } + $sth->execute(); + my @result = (); + my $subtitle; # Added by JF for Subtitles + + # Processes the NOT if any and there are results + my ($not_sql_tables, $not_sql_where1, $not_sql_where2); + + if( ($sth->rows) && $any_not ) # some results to tune up and some NOT statements + { + ($not_sql_tables, $not_sql_where1, $not_sql_where2) = create_request($dbh,\@not_tags, \@not_and_or, \@not_operator, \@not_value); + + my @tmpresult; + + while (my ($bibid) = $sth->fetchrow) { + push @tmpresult,$bibid; + } + my $sth_not; + warn "NOT : select distinct m1.bibid from $not_sql_tables where $not_sql_where2 and ($not_sql_where1)"; + if ($not_sql_where2) { + $sth_not = $dbh->prepare("select distinct m1.bibid from $not_sql_tables where $not_sql_where2 and ($not_sql_where1)"); + } else { + $sth_not = $dbh->prepare("select distinct m1.bibid from $not_sql_tables where $not_sql_where1"); + } + $sth_not->execute(); + + if($sth_not->rows) + { + my %not_bibids = (); + while(my $bibid = $sth_not->fetchrow()) { + $not_bibids{$bibid} = 1; # populates the hashtable with the bibids matching the NOT statement + } + + foreach my $bibid (@tmpresult) + { + if(!$not_bibids{$bibid}) + { + push @result, $bibid; + } + } + } + $sth_not->finish(); + } + else # no NOT statements + { + while (my ($bibid) = $sth->fetchrow) { + push @result,$bibid; + } + } + + # we have bibid list. Now, loads title and author from [offset] to [offset]+[length] + my $counter = $offset; + # HINT : biblionumber as bn is important. The hash is fills biblionumber with items.biblionumber. + # so if you dont' has an item, you get a not nice empty value. + $sth = $dbh->prepare("SELECT biblio.biblionumber as bn,biblio.*, biblioitems.*,marc_biblio.bibid,itemtypes.notforloan,itemtypes.description + FROM biblio, marc_biblio + LEFT JOIN biblioitems on biblio.biblionumber = biblioitems.biblionumber + LEFT JOIN itemtypes on itemtypes.itemtype=biblioitems.itemtype + WHERE biblio.biblionumber = marc_biblio.biblionumber AND bibid = ?"); + my $sth_subtitle = $dbh->prepare("SELECT subtitle FROM bibliosubtitle WHERE biblionumber=?"); # Added BY JF for Subtitles + my @finalresult = (); + my @CNresults=(); + my $totalitems=0; + my $oldline; + my ($oldbibid, $oldauthor, $oldtitle); + my $sth_itemCN = $dbh->prepare("select items.* from items where biblionumber=?"); + my $sth_issue = $dbh->prepare("select date_due,returndate from issues where itemnumber=?"); + # parse all biblios between start & end. + while (($counter <= $#result) && ($counter <= ($offset + $length))) { + # search & parse all items & note itemcallnumber + $sth->execute($result[$counter]); + my $continue=1; + my $line = $sth->fetchrow_hashref; + my $biblionumber=$line->{bn}; + # Return subtitles first ADDED BY JF + $sth_subtitle->execute($biblionumber); + my $subtitle_here.= $sth_subtitle->fetchrow." "; + chop $subtitle_here; + $subtitle = $subtitle_here; +# warn "Here's the Biblionumber ".$biblionumber; +# warn "and here's the subtitle: ".$subtitle_here; + + # /ADDED BY JF + +# $continue=0 unless $line->{bn}; +# my $lastitemnumber; + $sth_itemCN->execute($biblionumber); + my @CNresults = (); + my $notforloan=1; # to see if there is at least 1 item that can be issued + while (my $item = $sth_itemCN->fetchrow_hashref) { + # parse the result, putting holdingbranch & itemcallnumber in separate array + # then all other fields in the main array + + # search if item is on loan + my $date_due; + $sth_issue->execute($item->{itemnumber}); + while (my $loan = $sth_issue->fetchrow_hashref) { + if ($loan->{date_due} and !$loan->{returndate}) { + $date_due = $loan->{date_due}; + } + } + # store this item + my %lineCN; + $lineCN{holdingbranch} = $item->{holdingbranch}; + $lineCN{itemcallnumber} = $item->{itemcallnumber}; + $lineCN{location} = $item->{location}; + $lineCN{date_due} = format_date($date_due); + $lineCN{notforloan} = $notforloanstatus{$line->{notforloan}} if ($line->{notforloan}); # setting not forloan if itemtype is not for loan + $lineCN{notforloan} = $notforloanstatus{$item->{notforloan}} if ($item->{notforloan}); # setting not forloan it this item is not for loan + $notforloan=0 unless ($item->{notforloan} or $item->{wthdrawn} or $item->{itemlost}); + push @CNresults,\%lineCN; + $totalitems++; + } + # save the biblio in the final array, with item and item issue status + my %newline; + %newline = %$line; + $newline{totitem} = $totalitems; + # if $totalitems == 0, check if it's being ordered. + if ($totalitems == 0) { + my $sth = $dbh->prepare("select count(*) from aqorders where biblionumber=? and datecancellationprinted is NULL"); + $sth->execute($biblionumber); + my ($ordered) = $sth->fetchrow; + $newline{onorder} = 1 if $ordered; + } + $newline{biblionumber} = $biblionumber; + $newline{norequests} = 0; + $newline{norequests} = 1 if ($line->{notforloan}); # itemtype not issuable + $newline{norequests} = 1 if (!$line->{notforloan} && $notforloan); # itemtype issuable but all items not issuable for instance + $newline{subtitle} = $subtitle; # put the subtitle in ADDED BY JF + + my @CNresults2= @CNresults; + $newline{CN} = \@CNresults2; + $newline{'even'} = 1 if $#finalresult % 2 == 0; + $newline{'odd'} = 1 if $#finalresult % 2 == 1; + $newline{'timestamp'} = format_date($newline{timestamp}); + @CNresults = (); + push @finalresult, \%newline; + $totalitems=0; + $counter++; + } + my $nbresults = $#result+1; + return (\@finalresult, $nbresults); +} + +# Creates the SQL Request + +sub create_request { + my ($dbh,$tags, $and_or, $operator, $value) = @_; + + my $sql_tables; # will contain marc_subfield_table as m1,... + my $sql_where1; # will contain the "true" where + my $sql_where2 = "("; # will contain m1.bibid=m2.bibid + my $nb_active=0; # will contain the number of "active" entries. an entry is active if a value is provided. + my $nb_table=1; # will contain the number of table. ++ on each entry EXCEPT when an OR is provided. + + my $maxloop=8; # the maximum number of words to avoid a too complex search. + $maxloop = @$value if @$value<$maxloop; + + for(my $i=0; $i<=$maxloop;$i++) { + if (@$value[$i]) { + $nb_active++; + if ($nb_active==1) { + if (@$operator[$i] eq "start") { + $sql_tables .= "marc_subfield_table as m$nb_table,"; + $sql_where1 .= "(m1.subfieldvalue like ".$dbh->quote("@$value[$i]%"); + if (@$tags[$i]) { + $sql_where1 .=" and concat(m1.tag,m1.subfieldcode) in (@$tags[$i])"; + } + $sql_where1.=")"; + } elsif (@$operator[$i] eq "contains") { + $sql_tables .= "marc_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 .= "marc_subfield_table as m$nb_table,"; + $sql_where1 .= "(m1.subfieldvalue @$operator[$i] ".$dbh->quote("@$value[$i]"); + if (@$tags[$i]) { + $sql_where1 .=" and concat(m1.tag,m1.subfieldcode) in (@$tags[$i])"; + } + $sql_where1.=")"; + } + } else { + if (@$operator[$i] eq "start") { + $nb_table++; + $sql_tables .= "marc_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 concat(m$nb_table.tag,m$nb_table.subfieldcode) in (@$tags[$i])"; + } + $sql_where1.=")"; + $sql_where2 .= "m1.bibid=m$nb_table.bibid and "; + } elsif (@$operator[$i] eq "contains") { + if (@$and_or[$i] eq 'and') { + $nb_table++; + $sql_tables .= "marc_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.bibid=m$nb_table.bibid 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.tagsubfield in (@$tags[$i])"; + } + $sql_where1.=")"; + $sql_where2 .= "m1.bibid=m$nb_table.bibid and "; + } + } else { + $nb_table++; + $sql_tables .= "marc_subfield_table as m$nb_table,"; + $sql_where1 .= "@$and_or[$i] (m$nb_table.subfieldvalue @$operator[$i] ".$dbh->quote(@$value[$i]); + if (@$tags[$i]) { + $sql_where1 .=" and concat(m$nb_table.tag,m$nb_table.subfieldcode) in (@$tags[$i])"; + } + $sql_where2 .= "m1.bibid=m$nb_table.bibid and "; + $sql_where1.=")"; + } + } + } + } + + if($sql_where2 ne "(") # some datas added to sql_where2, processing + { + $sql_where2 = substr($sql_where2, 0, (length($sql_where2)-5)); # deletes the trailing ' and ' + $sql_where2 .= ")"; + } + else # no sql_where2 statement, deleting '(' + { + $sql_where2 = ""; + } + chop $sql_tables; # deletes the trailing ',' + return ($sql_tables, $sql_where1, $sql_where2); +} + +sub getMARCnotes { + my ($dbh, $bibid, $marcflavour) = @_; + my ($mintag, $maxtag); + if ($marcflavour eq "MARC21") { + $mintag = "500"; + $maxtag = "599"; + } else { # assume unimarc if not marc21 + $mintag = "300"; + $maxtag = "399"; + } + + my $sth=$dbh->prepare("SELECT subfieldvalue,tag FROM marc_subfield_table WHERE bibid=? AND tag BETWEEN ? AND ? ORDER BY tagorder"); + + $sth->execute($bibid,$mintag,$maxtag); + + my @marcnotes; + my $note = ""; + my $tag = ""; + my $marcnote; + + while (my $data=$sth->fetchrow_arrayref) { + my $value=$data->[0]; + my $thistag=$data->[1]; + if ($value=~/\.$/) { + $value=$value . " "; + } + if ($thistag ne $tag && $note ne "") { + $marcnote = {marcnote => $note,}; + push @marcnotes, $marcnote; + $note=$value; + $tag=$thistag; + } + if ($note ne $value) { + $note = $note." ".$value; + } + } + + if ($note) { + $marcnote = {marcnote => $note}; + push @marcnotes, $marcnote; #load last tag into array + } + + $sth->finish; + $dbh->disconnect; + + my $marcnotesarray=\@marcnotes; + return $marcnotesarray; +} # end getMARCnotes + + +sub getMARCsubjects { + my ($dbh, $bibid, $marcflavour) = @_; + my ($mintag, $maxtag); + if ($marcflavour eq "MARC21") { + $mintag = "600"; + $maxtag = "699"; + } else { # assume unimarc if not marc21 + $mintag = "600"; + $maxtag = "619"; + } + my $sth=$dbh->prepare("SELECT subfieldvalue,subfieldcode FROM marc_subfield_table WHERE bibid=? AND tag BETWEEN ? AND ? ORDER BY tagorder"); + + $sth->execute($bibid,$mintag,$maxtag); + + my @marcsubjcts; + my $subjct = ""; + my $subfield = ""; + my $marcsubjct; + + while (my $data=$sth->fetchrow_arrayref) { + my $value = $data->[0]; + my $subfield = $data->[1]; + if ($subfield eq "a" && $value ne $subjct) { + $marcsubjct = {MARCSUBJCT => $value,}; + push @marcsubjcts, $marcsubjct; + $subjct = $value; + } + } + + $sth->finish; + $dbh->disconnect; + + my $marcsubjctsarray=\@marcsubjcts; + return $marcsubjctsarray; +} #end getMARCsubjects + +END { } # module clean-up code here (global destructor) + +1; +__END__ + +=back + +=head1 AUTHOR + +Koha Developement team + +=cut diff --git a/opac/opac-search-biblio.pl b/opac/opac-search-biblio.pl new file mode 100755 index 0000000000..5c7b5dbd32 --- /dev/null +++ b/opac/opac-search-biblio.pl @@ -0,0 +1,415 @@ +#!/usr/bin/perl +use strict; +require Exporter; + +use C4::Auth; +use C4::Interface::CGI::Output; +use C4::Context; +use CGI; +use C4::Database; +use HTML::Template; +use C4::SearchBiblio; +use C4::Acquisition; +use C4::Biblio; +my @spsuggest; # the array for holding suggestions +my $suggest; # a flag to be set (if there are suggestions it's 1) +my $firstbiblionumber; # needed for directly sending user to first item +# use C4::Search; + + +my $itemtypelist; +my $brancheslist; +my $categorylist; +my $subcategorylist; +my $mediatypelist; +# added by Gavin +my $totalresults; + +my $dbh=C4::Context->dbh; +my $sth=$dbh->prepare("select description,itemtype from itemtypes order by description"); +$sth->execute; +while (my ($description,$itemtype) = $sth->fetchrow) { + $itemtypelist.="\n"; +} +my $sth=$dbh->prepare("select description,subcategorycode from subcategorytable order by description"); +$sth->execute; +while (my ($description,$subcategorycode) = $sth->fetchrow) { + $subcategorylist.="\n"; +} +my $sth=$dbh->prepare("select description,mediatypecode from mediatypetable order by description"); +$sth->execute; +while (my ($description,$mediatypecode) = $sth->fetchrow) { + $mediatypelist.="\n"; +} +my $sth=$dbh->prepare("select description,categorycode from categorytable order by description"); +$sth->execute; +while (my ($description,$categorycode) = $sth->fetchrow) { + $categorylist .= ''.$description.'
'; +} +my $sth=$dbh->prepare("select branchname,branchcode from branches order by branchname"); +$sth->execute; + +while (my ($branchname,$branchcode) = $sth->fetchrow) { + $brancheslist.="\n"; +} +my $query = new CGI; +my $op = $query->param("op"); +my $type=$query->param('type'); + +my $itemtypesstring=$query->param("itemtypesstring"); +$itemtypesstring =~s/"//g; +my @itemtypes = split ( /\|/, $itemtypesstring); +my $branchesstring=$query->param("branchesstring"); +$branchesstring =~s/"//g; +my @branches = split (/\|/, $branchesstring); + +my $startfrom=$query->param('startfrom'); +$startfrom=0 if(!defined $startfrom); +my ($template, $loggedinuser, $cookie); +my $resultsperpage; +my $searchdesc; + +if ($op eq "do_search") { + my @marclist = $query->param('marclist'); + my @and_or = $query->param('and_or'); + my @excluding = $query->param('excluding'); + my @operator = $query->param('operator'); + my @value = $query->param('value'); + + for (my $i=0;$i<=$#marclist;$i++) { + if ($searchdesc) { # don't put the and_or on the 1st search term + $searchdesc .= $and_or[$i]." ".$excluding[$i]." ".($marclist[$i]?$marclist[$i]:"*")." ".$operator[$i]." ".$value[$i]." " if ($value[$i]); + } else { + $searchdesc = $excluding[$i]." ".($marclist[$i]?$marclist[$i]:"*")." ".$operator[$i]." ".$value[$i]." " if ($value[$i]); + } + } + if ($itemtypesstring ne ''){ + $searchdesc .= 'filtered by itemtypes '; + $searchdesc .= join(" ",@itemtypes) + } + if ($branchesstring ne ''){ + $searchdesc .= ' in branches '; + $searchdesc .= join(" ",@branches) + } + $resultsperpage= $query->param('resultsperpage'); + $resultsperpage = 19 if(!defined $resultsperpage); + my $orderby = $query->param('orderby'); + my $desc_or_asc = $query->param('desc_or_asc'); + # builds tag and subfield arrays + my @tags; + + foreach my $marc (@marclist) { + if ($marc) { + my ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,$marc,''); + if ($tag) { + push @tags,$dbh->quote("$tag$subfield"); + } else { + push @tags, $dbh->quote(substr($marc,0,4)); + } + } else { + push @tags, ""; + } + } + findseealso($dbh,\@tags); + my $sqlstring; + if ($itemtypesstring ne ''){ + $sqlstring = 'and (biblioitems.itemtype IN ('; + my $itemtypeloop=0; + foreach my $itemtype (@itemtypes){ + if ($itemtype ne ''){ + if ($itemtypeloop != 0){ + $sqlstring .=',' + } + $sqlstring .= '"'.$itemtype.'"'; + $itemtypeloop++; + } + } + $sqlstring .= '))' + } + if ($branchesstring ne ''){ + $sqlstring .= 'and biblio.biblionumber=items.biblionumber and (items.holdingbranch IN ('; + my $branchesloop=0; + foreach my $branch (@branches){ + if ($branch ne ''){ + if ($branchesloop != 0){ + $sqlstring .=',' + } + $sqlstring .= '"'.$branch.'"'; + $branchesloop++; + } + } + $sqlstring .= '))' + } + + my ($results,$total) = catalogsearch1($dbh, \@tags,\@and_or, + \@excluding, \@operator, \@value, + $startfrom*$resultsperpage, $resultsperpage,$orderby,$desc_or_asc,$sqlstring); + if ($total ==1) { + if (C4::Context->preference("BiblioDefaultView") eq "normal") { + print $query->redirect("/cgi-bin/koha/opac-detail.pl?bib=".@$results[0]->{biblionumber}); + } elsif (C4::Context->preference("BiblioDefaultView") eq "MARC") { + print $query->redirect("/cgi-bin/koha/MARCdetail.pl?bib=".@$results[0]->{biblionumber}); + } else { + print $query->redirect("/cgi-bin/koha/ISBDdetail.pl?bib=".@$results[0]->{biblionumber}); + } + exit; + } + ($template, $loggedinuser, $cookie) + = get_template_and_user({template_name => "opac-searchresults.tmpl", + query => $query, + type => 'opac', + authnotrequired => 1, + debug => 1, + }); + + # multi page display gestion + my $displaynext=0; + my $displayprev=$startfrom; + if(($total - (($startfrom+1)*($resultsperpage))) > 0 ){ + $displaynext = 1; + } + + my @field_data = (); + +### Added by JF +## This next does a number of things: +# 1. It allows you to track all the searches made for stats, etc. +# 2. It fixes the 'searchdesc' variable problem by introducing +# a. 'searchterms' which comes out as 'Keyword: neal stephenson' +# b. 'phraseorterm' which comes out as 'neal stephenson' +# both of these are useful for differen purposes ... I use searchterms +# for display purposes and phraseorterm for passing the search terms +# to an external source through a url (like a database search) +# 3. It provides the variables necessary for the spellchecking (look below for +# how this is done +# 4. + +$totalresults = $total; + +## This formats the 'search results' string and populates +## the 'OPLIN' variable as well as the 'spellcheck' variable +## with appropriate values based on the user's search input + +my $searchterms; #returned in place of searchdesc for 'results for search' + # as a string (can format if need be) + +my @spphrases; +my $phraseorterm; +my %searchtypehash = ( # used only for the searchterms string formation + # and for spellcheck string + '0' => 'keyword', + '1' => 'title', + '2' => 'author', + '3' => 'subject', + '4' => 'series', + '5' => 'format', + ); + +my @searchterm = $query->param('value'); + +for (my $i=0; $i <= $#searchterm; $i++) { + my $searchtype = $searchtypehash{$i}; + push @spphrases, $searchterm[$i]; + if ($searchterms) { #don't put and in again + if ($searchterm[$i]) { + $phraseorterm.=$searchterm[$i]; + $searchterms.=" AND ".$searchtype." : \'".$searchterm[$i]."\'"; + } + } else { + if ($searchterm[$i]) { + $phraseorterm.=$searchterm[$i]; + $searchterms.=$searchtype.": \'".$searchterm[$i]."\'"; + } + } +} + +# Spellchecck stuff ... needs to use above scheme but must change +# cgi script first +my $phrases = $query->param('value'); +#my $searchterms = $query->param('value'); +# warn "here is searchterms:".$searchterms; + +# FIXME: should be obvious ;-) +#foreach my $phrases (@spphrases) { +$phrases =~ s/(\.|\?|\:|\!|\'|,|\-|\"|\(|\)|\[|\]|\{|\})/ /g; +$phrases =~ s/(\Athe |\Aa |\Aan |)//g; +my $spchkphraseorterm = $phraseorterm; + $spchkphraseorterm =~ tr/A-Z/a-z/; + $spchkphraseorterm =~ s/(\.|\?|\:|\!|\'|,|\-|\"|\(|\)|\[|\]|\{|\})/ /g; + $spchkphraseorterm =~s/(\Aand-or |\Aand\/or |\Aanon |\Aan |\Aa |\Abut |\Aby |\Ade |\Ader |\Adr |\Adu|et |\Afor |\Afrom |\Ain |\Ainto |\Ait |\Amy |\Anot |\Aon |\Aor |\Aper |\Apt |\Aspp |\Ato |\Avs |\Awith |\Athe )/ /g; + $spchkphraseorterm =~s/( and-or | and\/or | anon | an | a | but | by | de | der | dr | du|et | for | from | in | into | it | my | not | on | or | per | pt | spp | to | vs | with | the )/ /g; + + $spchkphraseorterm =~s/ / /g; +my $resultcount = $total; +my $ipaddress = $query->remote_host(); +# + +if ( +#need to create a table to record the search info +#...FIXME: add the script name that creates the table +# +my $dbhpop=DBI->connect("DBI:mysql:demosuggest:localhost","auth","YourPass")) { + +# insert the search info query +my $insertpop = "INSERT INTO phrase_log(phr_phrase,phr_resultcount,phr_ip) VALUES(?,?,?)"; + +# grab spelling suggestions query +my $getsugg = "SELECT display FROM spellcheck WHERE strcmp(soundex(suggestion), soundex(?)) = 0 order by soundex(suggestion) limit 0,5"; + +#get spelling suggestions when there are no results +if ($resultcount eq 0) { + my $sthgetsugg=$dbhpop->prepare($getsugg); + $sthgetsugg->execute($spchkphraseorterm); + while (my ($spsuggestion)=$sthgetsugg->fetchrow_array) { +# warn "==>$spsuggestion"; + #push @spsuggest, +{ spsuggestion => $spsuggestion }; + my %line; + $line{spsuggestion} = $spsuggestion; + push @spsuggest,\%line; + $suggest = 1; + } +# warn "==>".$#spsuggest; + $sthgetsugg->finish; +} +# end of spelling suggestions + +my $sthpop=$dbhpop->prepare($insertpop); + +#$sthpop->execute($phrases,$resultcount,$ipaddress); +$sthpop->finish; +} +# +### end of tracking stuff -- jmf at kados dot org +# +$template->param(suggest => $suggest ); +$template->param( SPELL_SUGGEST => \@spsuggest ); +$template->param( searchterms => $searchterms ); +$template->param( phraseorterm => $phraseorterm ); +#warn "here's the search terms: ".$searchterms; +# +### end of spelling suggestions +### /Added by JF + + for(my $i = 0 ; $i <= $#marclist ; $i++) + { + push @field_data, { term => "marclist", val=>$marclist[$i] }; + push @field_data, { term => "and_or", val=>$and_or[$i] }; + push @field_data, { term => "excluding", val=>$excluding[$i] }; + push @field_data, { term => "operator", val=>$operator[$i] }; + push @field_data, { term => "value", val=>$value[$i] }; + } + + my @numbers = (); + + if ($total>$resultsperpage) + { + for (my $i=1; $i<$total/$resultsperpage+1; $i++) + { + if ($i<16) + { + my $highlight=0; + ($startfrom==($i-1)) && ($highlight=1); + push @numbers, { number => $i, + highlight => $highlight , + searchdata=> \@field_data, + startfrom => ($i-1)}; + } + } + } + + my $from = $startfrom*$resultsperpage+1; + my $to; + + if($total < (($startfrom+1)*$resultsperpage)) + { + $to = $total; + } else { + $to = (($startfrom+1)*$resultsperpage); + } + my $defaultview = 'BiblioDefaultView'.C4::Context->preference('BiblioDefaultView'); + $template->param(results => $results, + startfrom=> $startfrom, + displaynext=> $displaynext, + displayprev=> $displayprev, + resultsperpage => $resultsperpage, + orderby => $orderby, + startfromnext => $startfrom+1, + startfromprev => $startfrom-1, + searchdata=>\@field_data, + total=>$total, + from=>$from, + to=>$to, + numbers=>\@numbers, + searchdesc=> $searchdesc, + $defaultview => 1, + suggestion => C4::Context->preference("suggestion"), + virtualshelves => C4::Context->preference("virtualshelves"), + itemtypelist => $itemtypelist, + subcategorylist => $subcategorylist, + brancheslist => $brancheslist, + categorylist => $categorylist, + mediatypelist => $mediatypelist, + itemtypesstring => $itemtypesstring, + ); + +} else { + ($template, $loggedinuser, $cookie) + = get_template_and_user({template_name => "opac-search.tmpl", + query => $query, + type => "opac", + authnotrequired => 1, + }); + + + $sth=$dbh->prepare("Select itemtype,description from itemtypes order by description"); + $sth->execute; + my @itemtype; + my %itemtypes; + push @itemtype, ""; + $itemtypes{''} = ""; + while (my ($value,$lib) = $sth->fetchrow_array) { + push @itemtype, $value; + $itemtypes{$value}=$lib; + } + + my $CGIitemtype=CGI::scrolling_list( -name => 'value', + -values => \@itemtype, + -labels => \%itemtypes, + -size => 1, + -multiple => 0 ); + $sth->finish; + + my @branches; + my @select_branch; + my %select_branches; + my ($count2,@branches)=branches(); + push @select_branch, ""; + $select_branches{''} = ""; + for (my $i=0;$i<$count2;$i++){ + push @select_branch, $branches[$i]->{'branchcode'};# + $select_branches{$branches[$i]->{'branchcode'}} = $branches[$i]->{'branchname'}; + } + my $CGIbranch=CGI::scrolling_list( -name => 'value', + -values => \@select_branch, + -labels => \%select_branches, + -size => 1, + -multiple => 0 ); + $sth->finish; + + $template->param(itemtypelist => $itemtypelist, + CGIitemtype => $CGIitemtype, + CGIbranch => $CGIbranch, + suggestion => C4::Context->preference("suggestion"), + virtualshelves => C4::Context->preference("virtualshelves"), + ); +} +# ADDED BY JF +if ($totalresults == 1){ + # if its a barcode search by definition we will only have one result. + # And if we have a result + # lets jump straight to the detail.pl page + print $query->redirect("/cgi-bin/koha/opac-detail.pl?bib=$firstbiblionumber"); +} +else { + output_html_with_http_headers $query, $cookie, $template->output; +} -- 2.39.5