1 package C4::SearchMarc;
3 # Copyright 2000-2002 Katipo Communications
5 # This file is part of Koha.
7 # Koha is free software; you can redistribute it and/or modify it under the
8 # terms of the GNU General Public License as published by the Free Software
9 # Foundation; either version 2 of the License, or (at your option) any later
12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14 # A PARTICULAR PURPOSE. See the GNU General Public License for more details.
16 # You should have received a copy of the GNU General Public License along with
17 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
18 # Suite 330, Boston, MA 02111-1307 USA
29 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
31 # set the version for version checking
36 C4::Search - Functions for searching the Koha MARC catalog
40 This module provides the searching facilities for the Koha MARC catalog
45 @EXPORT = qw(&catalogsearch &findseealso &findsuggestion &getMARCnotes &getMARCsubjects);
47 =head1 findsuggestion($dbh,$values);
49 =head2 $dbh is a link to the DB handler.
52 my $dbh =C4::Context->dbh;
54 =head2 $values is a word
56 Searches words with the same soundex, ordered by frequency of use.
57 Useful to suggest other searches to the users.
62 my ($dbh,$values) = @_;
63 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");
65 for(my $i = 0 ; $i <= $#{$values} ; $i++) {
66 if (length(@$values[$i]) >=5) {
67 $sth->execute(@$values[$i],@$values[$i]);
70 while ((my ($count,$word) = $sth->fetchrow) and $resfound <=10) {
71 push @results, "@$values[$i]|$word|$count";
72 # $results{@$values[$i]} = \@resline;
80 =head1 findseealso($dbh,$fields);
82 =head2 $dbh is a link to the DB handler.
85 my $dbh =C4::Context->dbh;
87 =head2 $fields is a reference to the fields array
89 This function modify the @$fields array and add related fields to search on.
94 my ($dbh, $fields) = @_;
95 my $tagslib = MARCgettagslib ($dbh,1);
96 for (my $i=0;$i<=$#{$fields};$i++) {
97 my ($tag) =substr(@$fields[$i],1,3);
98 my ($subfield) =substr(@$fields[$i],4,1);
99 @$fields[$i].=','.$tagslib->{$tag}->{$subfield}->{seealso} if ($tagslib->{$tag}->{$subfield}->{seealso});
103 =head1 my ($count, @results) = catalogsearch($dbh, $tags, $and_or, $excluding, $operator, $value, $offset,$length,$orderby,$sqlstring);
105 =head2 $dbh is a link to the DB handler.
108 my $dbh =C4::Context->dbh;
110 $tags,$and_or, $excluding, $operator, $value are references to array
114 contains the list of tags+subfields (for example : $@tags[0] = '200a')
115 A field can be a list of fields : '200f','700a','700b','701a','701b'
121 contains a list of strings containing and or or. The 1st value is useless.
125 contains 0 or 1. If 1, then the request is negated.
129 contains contains,=,start,>,>=,<,<= the = and start work on the complete subfield. The contains operator works on every word in the subfield.
132 contains home, search home anywhere.
133 = home, search a string being home.
137 contains the value to search
138 If it contains a * or a %, then the search is partial.
140 =head2 $offset and $length
142 returns $length results, beginning at $offset
146 define the field used to order the request. Any field in the biblio/biblioitem tables can be used. DESC is possible too
148 (for example title, title DESC,...)
152 optional argument containing an sql string to be used in the 'where' statement. see usage in opac-search.pl.
156 optional argument containing extra tables to search. Used in conjunction with $sqlstring. See usage in opac-search.pl.
157 String... so ',items,issues,reserves' allows the items, issues and reserves tables to be used.in a where.
161 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.
166 my ($dbh, $tags, $and_or, $excluding, $operator, $value, $offset,$length,$orderby,$desc_or_asc,$sqlstring, $extratables) = @_;
168 # the item.notforloan contains an integer. Every value <>0 means "book unavailable for loan".
169 # but each library can have it's own table of meaning for each value. Get them
170 # 1st search if there is a list of authorised values connected to items.notforloan
171 my $sth = $dbh->prepare('select authorised_value from marc_subfield_structure where kohafield="items.notforloan"');
173 my %notforloanstatus;
174 my ($authorised_valuecode) = $sth->fetchrow;
175 if ($authorised_valuecode) {
176 $sth = $dbh->prepare("select authorised_value,lib from authorised_values where category=?");
177 $sth->execute($authorised_valuecode);
178 while (my ($authorised_value,$lib) = $sth->fetchrow) {
179 $notforloanstatus{$authorised_value} = $lib?$lib:$authorised_value;
182 my $subtitle; # Added by JF for Subtitles
184 # prepare the query to find item status
186 if (C4::Context->preference('hidelostitem')) {
187 $sth_itemCN = $dbh->prepare("select items.* from items where biblionumber=? and (itemlost = 0 or itemlost is NULL)");
189 $sth_itemCN = $dbh->prepare("select items.* from items where biblionumber=?");
191 # prepare the query to find date_due where applicable
192 my $sth_issue = $dbh->prepare("select date_due,returndate from issues where itemnumber=?");
193 my $sth_itemtype = $dbh->prepare("select itemtypes.description,itemtypes.notforloan,itemtypes.imageurl from itemtypes where itemtype=?");
195 # prepare the query to find subtitles
196 my $sth_subtitle = $dbh->prepare("SELECT subtitle FROM bibliosubtitle WHERE biblionumber=?"); # Added BY JF for Subtitles
198 # build the z3950 request
200 # if ($type eq 'isbn') {
202 # } elsif ($type eq 'title') {
204 # } elsif ($type eq 'author') {
206 # } elsif ($type eq 'lccn') {
208 # } elsif ($type eq 'keyword') {
211 # my $term = @$value[0];
212 # my $query="\@attr $attr \"$term\"";
214 # now, do stupid things, that have to be modified for 3.0 :
215 # retrieve the 1st MARC tag.
216 # find the matching non-MARC field
217 # find bib1 attribute. This way, we will be MARC-independant (as title is in 200$a in UNIMARC and 245ùa in MARC21, we use "title" !)
218 # the best method to do this would probably to add a "bib1 attribute" column to marc_subfield_structure
219 # (or a CQL attribute name if we don't want to build bib1 requests)
220 # for instance, we manage only author / title / isbn. Any other field is considered as a keyword/anywhere search
222 my $tagslib = MARCgettagslib($dbh,$1,'');
224 for(my $i = 0 ; $i <= $#{$value} ; $i++){
225 # 1st split on , then remove ' in the 1st, the find koha field
226 my @x = split /,/, @$tags[$i];
229 my ($tag,$subfield) = ($1,$2);
230 if (@$value[$i]) { # if there is something to search, build the request
231 # if $query already contains something, add @and
232 $query = "\@and $query" if ($query);
233 my $field = $tagslib->{$tag}->{$subfield}->{kohafield};
234 if ($field eq 'biblio.author') {
235 $query .= "\@attr 1=1003 \"".@$value[$i]."\" ";
236 } elsif ($field eq 'biblio.title') {
237 $query .= "\@attr 1=4 \"".@$value[$i]."\" ";
238 } elsif ($field eq 'biblioitems.isbn') {
239 $query .= "\@attr 1=7 \"".@$value[$i]."\" ";
241 $query .= "\@attr 1=1016 \"".@$value[$i]."\" ";
244 # warn "$i : ".@$tags[$i]. "=> $tag / $subfield = ".$tagslib->{$tag}->{$subfield}->{kohafield};
246 warn "QUERY : $query";
248 my $conn= new Net::Z3950::Connection('localhost', '2100'); #databaseName => $database, user => $user, password => $password)
249 eval {$conn->option(elementSetName => 'F')};
250 # eval { $conn->option(preferredRecordSyntax => Net::Z3950::RecordSyntax::USMARC);} if ($globalsyntax eq "MARC21");
251 eval { $conn->option(preferredRecordSyntax => Net::Z3950::RecordSyntax::USMARC);};
252 my $rs=$conn->search($query);
253 my $numresults=$rs->size();
254 if ($numresults eq 0) {
255 warn "no records found\n";
257 warn "$numresults records found, retrieving them (max 80)\n";
260 my $scantimerstart=time();
261 my @finalresult = ();
264 $offset=1 unless $offset;
265 # calculate max offset
266 my $maxrecordnum = $offset+$length<$numresults?$offset+$length:$numresults;
267 for (my $i=$offset; $i <= $maxrecordnum; $i++) {
268 # get the MARC record...
269 my $record = MARC::File::USMARC::decode($rs->record($i)->rawdata());
270 # transform it into a meaningul hash
271 my $line = MARCmarc2koha($dbh,$record);
272 my $biblionumber=$line->{biblionumber};
273 # Return subtitles first ADDED BY JF
274 # $sth_subtitle->execute($biblionumber);
275 # my $subtitle_here.= $sth_subtitle->fetchrow." ";
276 # chop $subtitle_here;
277 # $subtitle = $subtitle_here;
278 # warn "Here's the Biblionumber ".$biblionumber;
279 # warn "and here's the subtitle: ".$subtitle_here;
282 # search itemtype information
283 $sth_itemtype->execute($line->{itemtype});
284 my ($itemtype_description,$itemtype_notforloan,$itemtype_imageurl) = $sth_itemtype->fetchrow;
285 $line->{description} = $itemtype_description;
286 $line->{imageurl} = $itemtype_imageurl;
287 $line->{notforloan} = $itemtype_notforloan;
288 $sth_itemCN->execute($biblionumber);
290 my $notforloan=1; # to see if there is at least 1 item that can be issued
291 while (my $item = $sth_itemCN->fetchrow_hashref) {
292 # parse the result, putting holdingbranch & itemcallnumber in separate array
293 # then all other fields in the main array
295 # search if item is on loan
297 $sth_issue->execute($item->{itemnumber});
298 while (my $loan = $sth_issue->fetchrow_hashref) {
299 if ($loan->{date_due} and !$loan->{returndate}) {
300 $date_due = $loan->{date_due};
305 $lineCN{holdingbranch} = $item->{holdingbranch};
306 $lineCN{itemcallnumber} = $item->{itemcallnumber};
307 $lineCN{location} = $item->{location};
308 $lineCN{date_due} = format_date($date_due);
309 $lineCN{notforloan} = $notforloanstatus{$line->{notforloan}} if ($line->{notforloan}); # setting not forloan if itemtype is not for loan
310 $lineCN{notforloan} = $notforloanstatus{$item->{notforloan}} if ($item->{notforloan}); # setting not forloan it this item is not for loan
311 $notforloan=0 unless ($item->{notforloan} or $item->{wthdrawn} or $item->{itemlost});
312 push @CNresults,\%lineCN;
315 # save the biblio in the final array, with item and item issue status
318 $newline{totitem} = $totalitems;
319 # if $totalitems == 0, check if it's being ordered.
320 if ($totalitems == 0) {
321 my $sth = $dbh->prepare("select count(*) from aqorders where biblionumber=? and datecancellationprinted is NULL");
322 $sth->execute($biblionumber);
323 my ($ordered) = $sth->fetchrow;
324 $newline{onorder} = 1 if $ordered;
326 $newline{biblionumber} = $biblionumber;
327 $newline{norequests} = 0;
328 $newline{norequests} = 1 if ($line->{notforloan}); # itemtype not issuable
329 $newline{norequests} = 1 if (!$line->{notforloan} && $notforloan); # itemtype issuable but all items not issuable for instance
330 $newline{subtitle} = $subtitle; # put the subtitle in ADDED BY JF
332 my @CNresults2= @CNresults;
333 $newline{CN} = \@CNresults2;
334 $newline{'even'} = 1 if $#finalresult % 2 == 0;
335 $newline{'odd'} = 1 if $#finalresult % 2 == 1;
336 $newline{'timestamp'} = format_date($newline{timestamp});
338 push @finalresult, \%newline;
341 my $nbresults = $#finalresult+1;
342 return (\@finalresult, $nbresults);
345 =head2 my $marcnotesarray = &getMARCnotes($dbh,$bibid,$marcflavour);
347 Returns a reference to an array containing all the notes stored in the MARC database for the given bibid.
348 $marcflavour ("MARC21" or "UNIMARC") determines which tags are used for retrieving subjects.
353 my ($dbh, $bibid, $marcflavour) = @_;
354 my ($mintag, $maxtag);
355 if ($marcflavour eq "MARC21") {
358 } else { # assume unimarc if not marc21
363 my $sth=$dbh->prepare("SELECT subfieldvalue,tag FROM marc_subfield_table WHERE bibid=? AND tag BETWEEN ? AND ? ORDER BY tagorder");
365 $sth->execute($bibid,$mintag,$maxtag);
372 while (my $data=$sth->fetchrow_arrayref) {
373 my $value=$data->[0];
374 my $thistag=$data->[1];
378 if ($thistag ne $tag && $note ne "") {
379 $marcnote = {marcnote => $note,};
380 push @marcnotes, $marcnote;
384 if ($note ne $value) {
385 $note = $note." ".$value;
390 $marcnote = {marcnote => $note};
391 push @marcnotes, $marcnote; #load last tag into array
396 my $marcnotesarray=\@marcnotes;
397 return $marcnotesarray;
401 =head2 my $marcsubjctsarray = &getMARCsubjects($dbh,$bibid,$marcflavour);
403 Returns a reference to an array containing all the subjects stored in the MARC database for the given bibid.
404 $marcflavour ("MARC21" or "UNIMARC") determines which tags are used for retrieving subjects.
408 sub getMARCsubjects {
409 my ($dbh, $bibid, $marcflavour) = @_;
410 my ($mintag, $maxtag);
411 if ($marcflavour eq "MARC21") {
414 } else { # assume unimarc if not marc21
418 my $sth=$dbh->prepare("SELECT subfieldvalue,subfieldcode FROM marc_subfield_table WHERE bibid=? AND tag BETWEEN ? AND ? ORDER BY tagorder");
420 $sth->execute($bibid,$mintag,$maxtag);
427 while (my $data=$sth->fetchrow_arrayref) {
428 my $value = $data->[0];
429 my $subfield = $data->[1];
430 if ($subfield eq "a" && $value ne $subjct) {
431 $marcsubjct = {MARCSUBJCT => $value,};
432 push @marcsubjcts, $marcsubjct;
439 my $marcsubjctsarray=\@marcsubjcts;
440 return $marcsubjctsarray;
441 } #end getMARCsubjects
443 END { } # module clean-up code here (global destructor)
452 Koha Developement team <info@koha.org>