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 next unless @$fields[$i];
98 my ($tag) =substr(@$fields[$i],1,3);
99 my ($subfield) =substr(@$fields[$i],4,1);
100 @$fields[$i].=','.$tagslib->{$tag}->{$subfield}->{seealso} if ($tagslib->{$tag}->{$subfield}->{seealso});
104 =head1 my ($count, @results) = catalogsearch($dbh, $tags, $and_or, $excluding, $operator, $value, $offset,$length,$orderby,$sqlstring);
106 =head2 $dbh is a link to the DB handler.
109 my $dbh =C4::Context->dbh;
111 $tags,$and_or, $excluding, $operator, $value are references to array
115 contains the list of tags+subfields (for example : $@tags[0] = '200a')
116 A field can be a list of fields : '200f','700a','700b','701a','701b'
122 contains a list of strings containing and or or. The 1st value is useless.
126 contains 0 or 1. If 1, then the request is negated.
130 contains contains,=,start,>,>=,<,<= the = and start work on the complete subfield. The contains operator works on every word in the subfield.
133 contains home, search home anywhere.
134 = home, search a string being home.
138 contains the value to search
139 If it contains a * or a %, then the search is partial.
141 =head2 $offset and $length
143 returns $length results, beginning at $offset
147 define the field used to order the request. Any field in the biblio/biblioitem tables can be used. DESC is possible too
149 (for example title, title DESC,...)
153 optional argument containing an sql string to be used in the 'where' statement. see usage in opac-search.pl.
157 optional argument containing extra tables to search. Used in conjunction with $sqlstring. See usage in opac-search.pl.
158 String... so ',items,issues,reserves' allows the items, issues and reserves tables to be used.in a where.
162 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.
165 =head2 my $marcurlsarray = &getMARCurls($dbh,$bibid,$marcflavour);
167 Returns a reference to an array containing all the URLS stored in the MARC database for the given bibid.
168 $marcflavour ("MARC21" or "UNIMARC") isn't used in this version because both flavours of MARC use the same subfield for URLS (but eventually when we get the lables working we'll need to change this.
172 my ($dbh, $tags, $and_or, $excluding, $operator, $value, $offset,$length,$orderby,$desc_or_asc,$sqlstring, $extratables) = @_;
174 # the item.notforloan contains an integer. Every value <>0 means "book unavailable for loan".
175 # but each library can have it's own table of meaning for each value. Get them
176 # 1st search if there is a list of authorised values connected to items.notforloan
177 my $sth = $dbh->prepare('select authorised_value from marc_subfield_structure where kohafield="items.notforloan"');
179 my %notforloanstatus;
180 my ($authorised_valuecode) = $sth->fetchrow;
181 if ($authorised_valuecode) {
182 $sth = $dbh->prepare("select authorised_value,lib from authorised_values where category=?");
183 $sth->execute($authorised_valuecode);
184 while (my ($authorised_value,$lib) = $sth->fetchrow) {
185 $notforloanstatus{$authorised_value} = $lib?$lib:$authorised_value;
188 my $subtitle; # Added by JF for Subtitles
190 # prepare the query to find item status
192 if (C4::Context->preference('hidelostitem')) {
193 $sth_itemCN = $dbh->prepare("select items.* from items where biblionumber=? and (itemlost = 0 or itemlost is NULL)");
195 $sth_itemCN = $dbh->prepare("select items.* from items where biblionumber=?");
197 # prepare the query to find date_due where applicable
198 my $sth_issue = $dbh->prepare("select date_due,returndate from issues where itemnumber=?");
199 my $sth_itemtype = $dbh->prepare("select itemtypes.description,itemtypes.notforloan,itemtypes.imageurl from itemtypes where itemtype=?");
201 # prepare the query to find subtitles
202 my $sth_subtitle = $dbh->prepare("SELECT subtitle FROM bibliosubtitle WHERE biblionumber=?"); # Added BY JF for Subtitles
205 # now, do stupid things, that have to be modified for 3.0 :
206 # retrieve the 1st MARC tag.
207 # find the matching non-MARC field
208 # 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" !)
209 # the best method to do this would probably to add a "bib1 attribute" column to marc_subfield_structure
210 # (or a CQL attribute name if we don't want to build bib1 requests)
211 # for instance, we manage only author / title / isbn. Any other field is considered as a keyword/anywhere search
213 my $tagslib = MARCgettagslib($dbh,$1,'');
215 for(my $i = 0 ; $i <= $#{$value} ; $i++){
216 # 1st split on , then remove ' in the 1st, the find koha field
217 my @x = split /,/, @$tags[$i];
218 $x[0] =~ s/'//g if $x[0];
219 $x[0] =~ /(...)(.)/ if $x[0];
220 my ($tag,$subfield) = ($1,$2);
221 if (@$value[$i]) { # if there is something to search, build the request
222 # if $query already contains something, add @and
223 $query .= " and " if ($query);
224 my $field = $tagslib->{$tag}->{$subfield}->{kohafield};
225 if ($field eq 'biblio.author') {
226 $query .= "Author all /relevant \"".@$value[$i]."\"";
227 } elsif ($field eq 'biblio.title') {
228 $query .= "dc.title all /relevant \"".@$value[$i]."\"";
229 } elsif ($field eq 'biblioitems.isbn') {
230 $query .= "Isbn= ".@$value[$i];
231 } elsif ($field eq 'bibliosubject.subject'){
232 $query.="Subject all /relevant \"@$value[$i]\"";
233 } elsif ($field eq 'biblioitems.itemtype'){
234 $query="Itemtype=@$value[$i]";
235 } elsif ($field eq 'items.homebranch'){
236 $query="Branch=@$value[$i]";
237 } elsif ($field eq 'items.barcode'){
238 $query="Barcode=@$value[$i]";
241 # my @spacedout=split(/ /,@$value[$i]);
242 # my $text = join(" and ",@spacedout);
244 $query .= "dc.any all /relevant \"@$value[$i]\"";
247 # warn "$i : ".@$tags[$i]. "=> $tag / $subfield = ".$tagslib->{$tag}->{$subfield}->{kohafield};
249 # $query.= " ordered title";
250 warn "QUERY : $query";
251 my $Zconn = C4::Context->Zconn or die "unable to set Zconn";
252 my $q = new ZOOM::Query::CQL2RPN( $query, $Zconn);
253 my $rs = $Zconn->search($q);
254 my $numresults=$rs->size();
255 if ($numresults eq 0) {
256 warn "no records found\n";
258 warn "$numresults records found, retrieving them (max 80)\n";
261 # in theory this should sort by title
263 if ($orderby eq 'biblio.title'){
266 elsif ($orderby eq 'biblio.author'){
269 elsif ($orderby eq 'biblioitems.dewey'){
272 elsif ($orderby eq 'biblioitems.publicationyear'){
275 elsif ($orderby eq 'biblioitems.publishercode'){
278 if ($desc_or_asc eq 'DESC'){
285 if ($rs->sort("yaz", $sort) < 0) {
292 my $scantimerstart=time();
293 my @finalresult = ();
296 $offset=1 unless $offset;
297 # calculate max offset
298 my $maxrecordnum = $offset+$length<$numresults?$offset+$length:($numresults);
299 for (my $i=$offset-1; $i <= $maxrecordnum-1; $i++) {
300 # get the MARC record (in XML)...
301 # warn "REC $i = ".$rs->record($i)->raw();
302 # FIXME : it's a silly way to do things : XML => MARC::Record => hash. We had better developping a XML=> hash (in biblio.pm)
303 my $record = MARC::Record->new_from_xml($rs->record($i)->raw(), 'UTF-8');
304 # transform it into a meaningul hash
305 my $line = MARCmarc2koha($dbh,$record);
306 my $biblionumber=$line->{biblionumber};
307 # Return subtitles first ADDED BY JF
308 # $sth_subtitle->execute($biblionumber);
309 # my $subtitle_here.= $sth_subtitle->fetchrow." ";
310 # chop $subtitle_here;
311 # $subtitle = $subtitle_here;
312 # warn "Here's the Biblionumber ".$biblionumber;
313 # warn "and here's the subtitle: ".$subtitle_here;
316 # search itemtype information
317 $sth_itemtype->execute($line->{itemtype});
318 my ($itemtype_description,$itemtype_notforloan,$itemtype_imageurl) = $sth_itemtype->fetchrow;
319 $line->{description} = $itemtype_description;
320 $line->{imageurl} = $itemtype_imageurl;
321 $line->{notforloan} = $itemtype_notforloan;
322 $sth_itemCN->execute($biblionumber);
324 my $notforloan=1; # to see if there is at least 1 item that can be issued
325 while (my $item = $sth_itemCN->fetchrow_hashref) {
326 # parse the result, putting holdingbranch & itemcallnumber in separate array
327 # then all other fields in the main array
329 # search if item is on loan
332 $lineCN{holdingbranch} = $item->{holdingbranch};
333 $lineCN{itemcallnumber} = $item->{itemcallnumber};
334 $lineCN{location} = $item->{location};
335 $lineCN{cnt} = $item->{cnt} unless ($item->{cnt}==1);
336 if ($item->{cnt}==1){
338 $sth_issue->execute($item->{itemnumber});
339 while (my $loan = $sth_issue->fetchrow_hashref) {
340 if ($loan->{date_due} and !$loan->{returndate}) {
341 $date_due = $loan->{date_due};
344 $lineCN{date_due} = format_date($date_due) ;
345 $lineCN{notforloan} = $notforloanstatus{$item->{notforloan}} if ($item->{notforloan}); # setting not forloan it this item is not for loan
346 $notforloan=0 unless ($item->{notforloan} or $item->{wthdrawn} or $item->{itemlost});
348 $lineCN{notforloan} = $notforloanstatus{$line->{notforloan}} if ($line->{notforloan} and not $lineCN{notforloan}); # setting not forloan if itemtype is not for loan
349 push @CNresults,\%lineCN;
350 $totalitems+=$item->{cnt};
352 # save the biblio in the final array, with item and item issue status
355 $newline{totitem} = $totalitems;
356 # if $totalitems == 0, check if it's being ordered.
357 if ($totalitems == 0) {
358 my $sth = $dbh->prepare("select count(*) from aqorders where biblionumber=? and datecancellationprinted is NULL");
359 $sth->execute($biblionumber);
360 my ($ordered) = $sth->fetchrow;
361 $newline{onorder} = 1 if $ordered;
363 $newline{biblionumber} = $biblionumber;
364 $newline{norequests} = 0;
365 $newline{norequests} = 1 if ($line->{notforloan}); # itemtype not issuable
366 $newline{norequests} = 1 if (!$line->{notforloan} && $notforloan); # itemtype issuable but all items not issuable for instance
367 $newline{subtitle} = $subtitle; # put the subtitle in ADDED BY JF
369 my @CNresults2= @CNresults;
370 $newline{CN} = \@CNresults2;
371 $newline{'even'} = 1 if $#finalresult % 2 == 0;
372 $newline{'odd'} = 1 if $#finalresult % 2 == 1;
373 $newline{'timestamp'} = format_date($newline{timestamp});
375 push @finalresult, \%newline;
378 my $nbresults = $#finalresult+1;
379 return (\@finalresult, $numresults);
382 =head2 my $marcnotesarray = &getMARCnotes($dbh,$bibid,$marcflavour);
384 Returns a reference to an array containing all the notes stored in the MARC database for the given bibid.
385 $marcflavour ("MARC21" or "UNIMARC") determines which tags are used for retrieving subjects.
390 my ($dbh, $bibid, $marcflavour) = @_;
391 my ($mintag, $maxtag);
392 if ($marcflavour eq "MARC21") {
395 } else { # assume unimarc if not marc21
400 my $sth=$dbh->prepare("SELECT subfieldvalue,tag FROM marc_subfield_table WHERE bibid=? AND tag BETWEEN ? AND ? ORDER BY tagorder");
402 $sth->execute($bibid,$mintag,$maxtag);
409 while (my $data=$sth->fetchrow_arrayref) {
410 my $value=$data->[0];
411 my $thistag=$data->[1];
415 if ($thistag ne $tag && $note ne "") {
416 $marcnote = {marcnote => $note,};
417 push @marcnotes, $marcnote;
421 if ($note ne $value) {
422 $note = $note." ".$value;
427 $marcnote = {marcnote => $note};
428 push @marcnotes, $marcnote; #load last tag into array
433 my $marcnotesarray=\@marcnotes;
434 return $marcnotesarray;
438 =head2 my $marcsubjctsarray = &getMARCsubjects($dbh,$bibid,$marcflavour);
440 Returns a reference to an array containing all the subjects stored in the MARC database for the given bibid.
441 $marcflavour ("MARC21" or "UNIMARC") determines which tags are used for retrieving subjects.
445 sub getMARCsubjects {
446 my ($dbh, $bibid, $marcflavour) = @_;
447 my ($mintag, $maxtag);
448 if ($marcflavour eq "MARC21") {
451 } else { # assume unimarc if not marc21
455 my $sth=$dbh->prepare("SELECT `subfieldvalue`,`subfieldcode`,`tagorder`,`tag` FROM `marc_subfield_table` WHERE `bibid`= ? AND `subfieldcode` NOT IN ('2','4','6','8') AND `tag` BETWEEN ? AND ? ORDER BY `tagorder`,`subfieldorder`");
456 # Subfield exclusion for $2, $4, $6, $8 protects against searching for
457 # variant data in otherwise invariant authorised subject headings when all
458 # returned subfields are used to form a query for matching subjects. One
459 # example is the use of $2 in MARC 21 where the value of $2 changes for
460 # different editions of the thesaurus used, even where the subject heading
461 # is otherwise the same. There is certainly a better fix for many cases
462 # where the value of the subfield may be parsed for the invariant data.
463 # More complete display values may also be separated from query values
464 # containing only the actual invariant authorised subject headings. More
465 # coding is required for careful value parsing, or display and query
466 # separation; instead of blanket subfield exclusion.
468 # As implemented, $3 is passed and might still pose a problem. Passing $3
469 # could have benefits for some proper use of $3 for UNIMARC, however, might
470 # restrict query usage to a given material type. -- thd
472 $sth->execute($bibid,$mintag,$maxtag);
478 my $activetagorder=0;
480 my ($subfieldvalue,$subfieldcode,$tagorder,$tag);
481 while (($subfieldvalue,$subfieldcode,$tagorder,$tag)=$sth->fetchrow) {
482 #warn "IN MARCSUBJECTS $subfieldvalue $subfieldcode $tagorder $tag\n";
483 if ($activetagorder && $tagorder != $activetagorder) {
484 # warn "ACTIVETAGORDER".$activetagorder;
485 $subject=~ s/ -- $//;
486 $marcsubjct = {MARCSUBJCT => $subject,
487 link => $lasttag."9",
488 linkvalue => $field9,
490 push @marcsubjcts, $marcsubjct;
495 if ($subfieldcode eq 9) {
496 $field9=$subfieldvalue;
497 } elsif ($subfieldcode eq (3 || 5)) {
498 $subject .= $subfieldvalue . " ";
500 $subject .= $subfieldvalue . " -- ";
502 $activetagorder=$tagorder;
503 $lasttag=$tag if $tag;
505 $subject=~ s/ -- $//;
506 $marcsubjct = {MARCSUBJCT => $subject,
507 link => $lasttag."9",
508 linkvalue => $field9,
510 push @marcsubjcts, $marcsubjct;
514 my $marcsubjctsarray=\@marcsubjcts;
515 return $marcsubjctsarray;
516 } #end getMARCsubjects
518 END { } # module clean-up code here (global destructor)
527 Koha Developement team <info@koha.org>