C4/SearchMarc.pm

   1 package C4::SearchMarc;
   2
   3 # Copyright 2000-2002 Katipo Communications
   4 #
   5 # This file is part of Koha.
   6 #
   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
  10 # version.
  11 #
  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.
  15 #
  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
  19
  20 use strict;
  21 require Exporter;
  22 use DBI;
  23 use C4::Context;
  24 use C4::Biblio;
  25 use C4::Date;
  26 use Date::Manip;
  27 use Net::Z3950;
  28
  29 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
  30
  31 # set the version for version checking
  32 $VERSION = 0.02;
  33
  34 =head1 NAME
  35
  36 C4::Search - Functions for searching the Koha MARC catalog
  37
  38 =head1 FUNCTIONS
  39
  40 This module provides the searching facilities for the Koha MARC catalog
  41
  42 =cut
  43
  44 @ISA = qw(Exporter);
  45 @EXPORT = qw(&catalogsearch &findseealso &findsuggestion &getMARCnotes &getMARCsubjects);
  46
  47 =head1 findsuggestion($dbh,$values);
  48
  49 =head2 $dbh is a link to the DB handler.
  50
  51 use C4::Context;
  52 my $dbh =C4::Context->dbh;
  53
  54 =head2 $values is a word
  55
  56 Searches words with the same soundex, ordered by frequency of use.
  57 Useful to suggest other searches to the users.
  58
  59 =cut
  60
  61 sub findsuggestion {
  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");
  64         my @results;
  65         for(my $i = 0 ; $i <= $#{$values} ; $i++) {
  66                 if (length(@$values[$i]) >=5) {
  67                         $sth->execute(@$values[$i],@$values[$i]);
  68                         my $resfound = 1;
  69                         my @resline;
  70                         while ((my ($count,$word) = $sth->fetchrow) and $resfound <=10) {
  71                                 push @results, "@$values[$i]|$word|$count";
  72 #                               $results{@$values[$i]} = \@resline;
  73                                 $resfound++;
  74                         }
  75                 }
  76         }
  77         return \@results;
  78 }
  79
  80 =head1 findseealso($dbh,$fields);
  81
  82 =head2 $dbh is a link to the DB handler.
  83
  84 use C4::Context;
  85 my $dbh =C4::Context->dbh;
  86
  87 =head2 $fields is a reference to the fields array
  88
  89 This function modify the @$fields array and add related fields to search on.
  90
  91 =cut
  92
  93 sub findseealso {
  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});
 100         }
 101 }
 102
 103 =head1  my ($count, @results) = catalogsearch($dbh, $tags, $and_or, $excluding, $operator, $value, $offset,$length,$orderby,$sqlstring);
 104
 105 =head2 $dbh is a link to the DB handler.
 106
 107 use C4::Context;
 108 my $dbh =C4::Context->dbh;
 109
 110 $tags,$and_or, $excluding, $operator, $value are references to array
 111
 112 =head2 $tags
 113
 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'
 116
 117 Example
 118
 119 =head2 $and_or
 120
 121 contains  a list of strings containing and or or. The 1st value is useless.
 122
 123 =head2 $excluding
 124
 125 contains 0 or 1. If 1, then the request is negated.
 126
 127 =head2 $operator
 128
 129 contains contains,=,start,>,>=,<,<= the = and start work on the complete subfield. The contains operator works on every word in the subfield.
 130
 131 examples :
 132 contains home, search home anywhere.
 133 = home, search a string being home.
 134
 135 =head2 $value
 136
 137 contains the value to search
 138 If it contains a * or a %, then the search is partial.
 139
 140 =head2 $offset and $length
 141
 142 returns $length results, beginning at $offset
 143
 144 =head2 $orderby
 145
 146 define the field used to order the request. Any field in the biblio/biblioitem tables can be used. DESC is possible too
 147
 148 (for example title, title DESC,...)
 149
 150 =head2 $sqlstring
 151
 152 optional argument containing an sql string to be used in the 'where' statement. see usage in opac-search.pl.
 153
 154 =head2 $extratables
 155
 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.
 158
 159 =head2 RETURNS
 160
 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.
 162
 163 =cut
 164 =head2 my $marcurlsarray = &getMARCurls($dbh,$bibid,$marcflavour);
 165
 166 Returns a reference to an array containing all the URLS stored in the MARC database for the given bibid.
 167 $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.
 168
 169 =cut
 170 sub catalogsearch {
 171         my ($dbh, $tags, $and_or, $excluding, $operator, $value, $offset,$length,$orderby,$desc_or_asc,$sqlstring, $extratables) = @_;
 172
 173 # the item.notforloan contains an integer. Every value <>0 means "book unavailable for loan".
 174 # but each library can have it's own table of meaning for each value. Get them
 175 # 1st search if there is a list of authorised values connected to items.notforloan
 176         my $sth = $dbh->prepare('select authorised_value from marc_subfield_structure where kohafield="items.notforloan"');
 177         $sth->execute;
 178         my %notforloanstatus;
 179         my ($authorised_valuecode) = $sth->fetchrow;
 180         if ($authorised_valuecode) {
 181                 $sth = $dbh->prepare("select authorised_value,lib from authorised_values where category=?");
 182                 $sth->execute($authorised_valuecode);
 183                 while (my ($authorised_value,$lib) = $sth->fetchrow) {
 184                         $notforloanstatus{$authorised_value} = $lib?$lib:$authorised_value;
 185                 }
 186         }
 187         my $subtitle; # Added by JF for Subtitles
 188
 189         # prepare the query to find item status
 190         my $sth_itemCN;
 191         if (C4::Context->preference('hidelostitem')) {
 192                 $sth_itemCN = $dbh->prepare("select items.* from items where biblionumber=? and (itemlost = 0 or itemlost is NULL)");
 193         } else {
 194                 $sth_itemCN = $dbh->prepare("select items.* from items where biblionumber=?");
 195         }
 196         # prepare the query to find date_due where applicable
 197         my $sth_issue = $dbh->prepare("select date_due,returndate from issues where itemnumber=?");
 198         my $sth_itemtype = $dbh->prepare("select itemtypes.description,itemtypes.notforloan,itemtypes.imageurl from itemtypes where itemtype=?");
 199
 200         # prepare the query to find subtitles
 201         my $sth_subtitle = $dbh->prepare("SELECT subtitle FROM bibliosubtitle WHERE biblionumber=?"); # Added BY JF for Subtitles
 202
 203         # build the z3950 request
 204         my $attr;
 205 #       if ($type eq 'isbn') {
 206 #               $attr='1=7';
 207 #       } elsif ($type eq 'title') {
 208 #               $attr='1=4';
 209 #       } elsif ($type eq 'author') {
 210 #               $attr='1=1003';
 211 #       } elsif ($type eq 'lccn') {
 212 #               $attr='1=9';
 213 #       } elsif ($type eq 'keyword') {
 214                 $attr='1=1016';
 215 #       }
 216 #       my $term = @$value[0];
 217 #       my $query="\@attr $attr \"$term\"";
 218         #
 219         # now, do stupid things, that have to be modified for 3.0 :
 220         # retrieve the 1st MARC tag.
 221         # find the matching non-MARC field
 222         # 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" !)
 223         # the best method to do this would probably to add a "bib1 attribute" column to marc_subfield_structure
 224         # (or a CQL attribute name if we don't want to build bib1 requests)
 225         # for instance, we manage only author / title / isbn. Any other field is considered as a keyword/anywhere search
 226         #
 227         my $tagslib = MARCgettagslib($dbh,$1,'');
 228         my $query;
 229         for(my $i = 0 ; $i <= $#{$value} ; $i++){
 230                 # 1st split on , then remove ' in the 1st, the find koha field
 231                 my @x = split /,/, @$tags[$i];
 232                 $x[0] =~ s/'//g;
 233                 $x[0] =~ /(...)(.)/;
 234                 my ($tag,$subfield) = ($1,$2);
 235                 if (@$value[$i]) { # if there is something to search, build the request
 236                         # if $query already contains something, add @and
 237                         $query = "\@and $query" if ($query);
 238                         my $field = $tagslib->{$tag}->{$subfield}->{kohafield};
 239                         if ($field eq 'biblio.author') {
 240                                 $query .= "\@attr 1=1003 \"".@$value[$i]."\" ";
 241                         } elsif ($field eq 'biblio.title') {
 242                                 $query .= "\@attr 1=4 \"".@$value[$i]."\" ";
 243                         } elsif ($field eq 'biblioitems.isbn') {
 244                                 $query .= "\@attr 1=7 \"".@$value[$i]."\" ";
 245                         } else {
 246                                 $query .= "\@attr 1=1016 \"".@$value[$i]."\" ";
 247                         }
 248                 }
 249 #               warn "$i : ".@$tags[$i]. "=> $tag / $subfield = ".$tagslib->{$tag}->{$subfield}->{kohafield};
 250         }
 251         warn "QUERY : $query";
 252
 253         my $conn= new Net::Z3950::Connection('localhost', '2100'); #databaseName => $database, user => $user, password => $password)
 254         eval {$conn->option(elementSetName => 'F')};
 255 #       eval { $conn->option(preferredRecordSyntax => Net::Z3950::RecordSyntax::USMARC);} if ($globalsyntax eq "MARC21");
 256         eval { $conn->option(preferredRecordSyntax => Net::Z3950::RecordSyntax::USMARC);};
 257         my $rs=$conn->search($query);
 258         my $numresults=$rs->size();
 259         if ($numresults eq 0) {
 260                 warn "no records found\n";
 261         } else {
 262                 warn "$numresults records found, retrieving them (max 80)\n";
 263         }
 264         my $result='';
 265         my $scantimerstart=time();
 266         my @finalresult = ();
 267         my @CNresults=();
 268         my $totalitems=0;
 269         $offset=1 unless $offset;
 270         # calculate max offset
 271         my $maxrecordnum = $offset+$length<$numresults?$offset+$length:$numresults;
 272         for (my $i=$offset; $i <= $maxrecordnum; $i++) {
 273                 # get the MARC record...
 274                 my $record = MARC::File::USMARC::decode($rs->record($i)->rawdata());
 275                 # transform it into a meaningul hash
 276                 my $line = MARCmarc2koha($dbh,$record);
 277                 my $biblionumber=$line->{biblionumber};
 278         # Return subtitles first ADDED BY JF
 279 #                 $sth_subtitle->execute($biblionumber);
 280 #                 my $subtitle_here.= $sth_subtitle->fetchrow." ";
 281 #                 chop $subtitle_here;
 282 #                 $subtitle = $subtitle_here;
 283 #               warn "Here's the Biblionumber ".$biblionumber;
 284 #                warn "and here's the subtitle: ".$subtitle_here;
 285
 286         # /ADDED BY JF
 287                 # search itemtype information
 288                 $sth_itemtype->execute($line->{itemtype});
 289                 my ($itemtype_description,$itemtype_notforloan,$itemtype_imageurl) = $sth_itemtype->fetchrow;
 290                 $line->{description} = $itemtype_description;
 291                 $line->{imageurl} = $itemtype_imageurl;
 292                 $line->{notforloan} = $itemtype_notforloan;
 293                 $sth_itemCN->execute($biblionumber);
 294                 my @CNresults = ();
 295                 my $notforloan=1; # to see if there is at least 1 item that can be issued
 296                 while (my $item = $sth_itemCN->fetchrow_hashref) {
 297                         # parse the result, putting holdingbranch & itemcallnumber in separate array
 298                         # then all other fields in the main array
 299
 300                         # search if item is on loan
 301                         my $date_due;
 302                         $sth_issue->execute($item->{itemnumber});
 303                         while (my $loan = $sth_issue->fetchrow_hashref) {
 304                                 if ($loan->{date_due} and !$loan->{returndate}) {
 305                                         $date_due = $loan->{date_due};
 306                                 }
 307                         }
 308                         # store this item
 309                         my %lineCN;
 310                         $lineCN{holdingbranch} = $item->{holdingbranch};
 311                         $lineCN{itemcallnumber} = $item->{itemcallnumber};
 312                         $lineCN{location} = $item->{location};
 313                         $lineCN{date_due} = format_date($date_due);
 314                         $lineCN{notforloan} = $notforloanstatus{$line->{notforloan}} if ($line->{notforloan}); # setting not forloan if itemtype is not for loan
 315                         $lineCN{notforloan} = $notforloanstatus{$item->{notforloan}} if ($item->{notforloan}); # setting not forloan it this item is not for loan
 316                         $notforloan=0 unless ($item->{notforloan} or $item->{wthdrawn} or $item->{itemlost});
 317                         push @CNresults,\%lineCN;
 318                         $totalitems++;
 319                 }
 320                 # save the biblio in the final array, with item and item issue status
 321                 my %newline;
 322                 %newline = %$line;
 323                 $newline{totitem} = $totalitems;
 324                 # if $totalitems == 0, check if it's being ordered.
 325                 if ($totalitems == 0) {
 326                         my $sth = $dbh->prepare("select count(*) from aqorders where biblionumber=? and datecancellationprinted is NULL");
 327                         $sth->execute($biblionumber);
 328                         my ($ordered) = $sth->fetchrow;
 329                         $newline{onorder} = 1 if $ordered;
 330                 }
 331                 $newline{biblionumber} = $biblionumber;
 332                 $newline{norequests} = 0;
 333                 $newline{norequests} = 1 if ($line->{notforloan}); # itemtype not issuable
 334                 $newline{norequests} = 1 if (!$line->{notforloan} && $notforloan); # itemtype issuable but all items not issuable for instance
 335                 $newline{subtitle} = $subtitle;  # put the subtitle in ADDED BY JF
 336
 337                 my @CNresults2= @CNresults;
 338                 $newline{CN} = \@CNresults2;
 339                 $newline{'even'} = 1 if $#finalresult % 2 == 0;
 340                 $newline{'odd'} = 1 if $#finalresult % 2 == 1;
 341                 $newline{'timestamp'} = format_date($newline{timestamp});
 342                 @CNresults = ();
 343                 push @finalresult, \%newline;
 344                 $totalitems=0;
 345         }
 346         my $nbresults = $#finalresult+1;
 347         return (\@finalresult, $nbresults);
 348 }
 349
 350 =head2 my $marcnotesarray = &getMARCnotes($dbh,$bibid,$marcflavour);
 351
 352 Returns a reference to an array containing all the notes stored in the MARC database for the given bibid.
 353 $marcflavour ("MARC21" or "UNIMARC") determines which tags are used for retrieving subjects.
 354
 355 =cut
 356
 357 sub getMARCnotes {
 358         my ($dbh, $bibid, $marcflavour) = @_;
 359         my ($mintag, $maxtag);
 360         if ($marcflavour eq "MARC21") {
 361                 $mintag = "500";
 362                 $maxtag = "599";
 363         } else {           # assume unimarc if not marc21
 364                 $mintag = "300";
 365                 $maxtag = "399";
 366         }
 367
 368         my $sth=$dbh->prepare("SELECT subfieldvalue,tag FROM marc_subfield_table WHERE bibid=? AND tag BETWEEN ? AND ? ORDER BY tagorder");
 369
 370         $sth->execute($bibid,$mintag,$maxtag);
 371
 372         my @marcnotes;
 373         my $note = "";
 374         my $tag = "";
 375         my $marcnote;
 376
 377         while (my $data=$sth->fetchrow_arrayref) {
 378                 my $value=$data->[0];
 379                 my $thistag=$data->[1];
 380                 if ($value=~/\.$/) {
 381                         $value=$value . "  ";
 382                 }
 383                 if ($thistag ne $tag && $note ne "") {
 384                         $marcnote = {marcnote => $note,};
 385                         push @marcnotes, $marcnote;
 386                         $note=$value;
 387                         $tag=$thistag;
 388                 }
 389                 if ($note ne $value) {
 390                         $note = $note." ".$value;
 391                 }
 392         }
 393
 394         if ($note) {
 395                 $marcnote = {marcnote => $note};
 396                 push @marcnotes, $marcnote;   #load last tag into array
 397         }
 398
 399         $sth->finish;
 400
 401         my $marcnotesarray=\@marcnotes;
 402         return $marcnotesarray;
 403 }  # end getMARCnotes
 404
 405
 406 =head2 my $marcsubjctsarray = &getMARCsubjects($dbh,$bibid,$marcflavour);
 407
 408 Returns a reference to an array containing all the subjects stored in the MARC database for the given bibid.
 409 $marcflavour ("MARC21" or "UNIMARC") determines which tags are used for retrieving subjects.
 410
 411 =cut
 412
 413 sub getMARCsubjects {
 414     my ($dbh, $bibid, $marcflavour) = @_;
 415         my ($mintag, $maxtag);
 416         if ($marcflavour eq "MARC21") {
 417                 $mintag = "600";
 418                 $maxtag = "699";
 419         } else {           # assume unimarc if not marc21
 420                 $mintag = "600";
 421                 $maxtag = "699";
 422         }
 423         my $sth=$dbh->prepare("SELECT subfieldvalue,subfieldcode,tagorder,tag FROM marc_subfield_table WHERE bibid=? AND tag BETWEEN ? AND ? ORDER BY tagorder,subfieldorder");
 424
 425         $sth->execute($bibid,$mintag,$maxtag);
 426
 427         my @marcsubjcts;
 428         my $subject = "";
 429         my $marcsubjct;
 430         my $field9;
 431         my $activetagorder=0;
 432         my $lasttag;
 433         my ($subfieldvalue,$subfieldcode,$tagorder,$tag);
 434         while (($subfieldvalue,$subfieldcode,$tagorder,$tag)=$sth->fetchrow) {
 435                 $lasttag=$tag if $tag;
 436                 if ($activetagorder && $tagorder != $activetagorder) {
 437                         $subject=~ s/ -- $//;
 438                         $marcsubjct = {MARCSUBJCT => $subject,
 439                                                         link => $tag."9",
 440                                                         linkvalue => $field9,
 441                                                         };
 442                         push @marcsubjcts, $marcsubjct;
 443                         $subject='';
 444                         $tag='';
 445                         $field9='';
 446                 }
 447                 if ($subfieldcode eq 9) {
 448                         $field9=$subfieldvalue;
 449                 } else {
 450                         $subject .= $subfieldvalue." -- ";
 451                 }
 452                 $activetagorder=$tagorder;
 453         }
 454         $marcsubjct = {MARCSUBJCT => $subject,
 455                                         link => $lasttag."9",
 456                                         linkvalue => $field9,
 457                                         };
 458         push @marcsubjcts, $marcsubjct;
 459
 460         $sth->finish;
 461
 462         my $marcsubjctsarray=\@marcsubjcts;
 463         return $marcsubjctsarray;
 464 }  #end getMARCsubjects
 465
 466 END { }       # module clean-up code here (global destructor)
 467
 468 1;
 469 __END__
 470
 471 =back
 472
 473 =head1 AUTHOR
 474
 475 Koha Developement team <info@koha.org>
 476
 477 =cut