Koha/C4/SearchMarc.pm
tipaul ba3339c4e8 searching with the zebra.
replacing 2.2 marc search by a Net::z3950 search (waiting for Perl/Zoom)
works only for title/author/isbn search, any other search is considered as 'keywork search' (=anywhere
2005-08-12 13:51:48 +00:00

448 lines
14 KiB
Perl
Raw Blame History

package C4::SearchMarc;
# 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 Net::Z3950;
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(&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 $extratables
optional argument containing extra tables to search. Used in conjunction with $sqlstring. See usage in opac-search.pl.
String... so ',items,issues,reserves' allows the items, issues and reserves tables to be used.in a where.
=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
sub catalogsearch {
my ($dbh, $tags, $and_or, $excluding, $operator, $value, $offset,$length,$orderby,$desc_or_asc,$sqlstring, $extratables) = @_;
# 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;
}
}
my $subtitle; # Added by JF for Subtitles
# prepare the query to find item status
my $sth_itemCN;
if (C4::Context->preference('hidelostitem')) {
$sth_itemCN = $dbh->prepare("select items.* from items where biblionumber=? and (itemlost = 0 or itemlost is NULL)");
} else {
$sth_itemCN = $dbh->prepare("select items.* from items where biblionumber=?");
}
# prepare the query to find date_due where applicable
my $sth_issue = $dbh->prepare("select date_due,returndate from issues where itemnumber=?");
# prepare the query to find subtitles
my $sth_subtitle = $dbh->prepare("SELECT subtitle FROM bibliosubtitle WHERE biblionumber=?"); # Added BY JF for Subtitles
# build the z3950 request
my $attr;
# if ($type eq 'isbn') {
# $attr='1=7';
# } elsif ($type eq 'title') {
# $attr='1=4';
# } elsif ($type eq 'author') {
# $attr='1=1003';
# } elsif ($type eq 'lccn') {
# $attr='1=9';
# } elsif ($type eq 'keyword') {
$attr='1=1016';
# }
# my $term = @$value[0];
# my $query="\@attr $attr \"$term\"";
#
# now, do stupid things, that have to be modified for 3.0 :
# retrieve the 1st MARC tag.
# find the matching non-MARC field
# find bib1 attribute. This way, we will be MARC-independant (as title is in 200$a in UNIMARC and 245<34>a in MARC21, we use "title" !)
# the best method to do this would probably to add a "bib1 attribute" column to marc_subfield_structure
# (or a CQL attribute name if we don't want to build bib1 requests)
# for instance, we manage only author / title / isbn. Any other field is considered as a keyword/anywhere search
#
my $tagslib = MARCgettagslib($dbh,$1,'');
my $query;
for(my $i = 0 ; $i <= $#{$value} ; $i++){
# 1st split on , then remove ' in the 1st, the find koha field
my @x = split /,/, @$tags[$i];
$x[0] =~ s/'//g;
$x[0] =~ /(...)(.)/;
my ($tag,$subfield) = ($1,$2);
if (@$value[$i]) { # if there is something to search, build the request
# if $query already contains something, add @and
$query = "\@and $query" if ($query);
my $field = $tagslib->{$tag}->{$subfield}->{kohafield};
if ($field eq 'biblio.author') {
$query .= "\@attr 1=1003 \"".@$value[$i]."\" ";
} elsif ($field eq 'biblio.title') {
$query .= "\@attr 1=4 \"".@$value[$i]."\" ";
} elsif ($field eq 'biblioitems.isbn') {
$query .= "\@attr 1=7 \"".@$value[$i]."\" ";
} else {
$query .= "\@attr 1=1016 \"".@$value[$i]."\" ";
}
}
# warn "$i : ".@$tags[$i]. "=> $tag / $subfield = ".$tagslib->{$tag}->{$subfield}->{kohafield};
}
warn "QUERY : $query";
my $conn= new Net::Z3950::Connection('localhost', '2100'); #databaseName => $database, user => $user, password => $password)
eval {$conn->option(elementSetName => 'F')};
# eval { $conn->option(preferredRecordSyntax => Net::Z3950::RecordSyntax::USMARC);} if ($globalsyntax eq "MARC21");
eval { $conn->option(preferredRecordSyntax => Net::Z3950::RecordSyntax::USMARC);};
my $rs=$conn->search($query);
my $numresults=$rs->size();
if ($numresults eq 0) {
warn "no records found\n";
} else {
warn "$numresults records found, retrieving them (max 80)\n";
}
my $result='';
my $scantimerstart=time();
my @finalresult = ();
my @CNresults=();
my $totalitems=0;
$offset=1 unless $offset;
# calculate max offset
my $maxrecordnum = $offset+$length<$numresults?$offset+$length:$numresults;
for (my $i=$offset; $i <= $maxrecordnum; $i++) {
# get the MARC record...
my $record = MARC::File::USMARC::decode($rs->record($i)->rawdata());
# transform it into a meaningul hash
my $line = MARCmarc2koha($dbh,$record);
my $biblionumber=$line->{biblionumber};
# 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
$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;
}
my $nbresults = $#finalresult+1;
return (\@finalresult, $nbresults);
}
=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.
=cut
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;
my $marcnotesarray=\@marcnotes;
return $marcnotesarray;
} # end getMARCnotes
=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 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;
my $marcsubjctsarray=\@marcsubjcts;
return $marcsubjctsarray;
} #end getMARCsubjects
END { } # module clean-up code here (global destructor)
1;
__END__
=back
=head1 AUTHOR
Koha Developement team <info@koha.org>
=cut