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
 165 sub catalogsearch {
 166         my ($dbh, $tags, $and_or, $excluding, $operator, $value, $offset,$length,$orderby,$desc_or_asc,$sqlstring, $extratables) = @_;
 167
 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"');
 172         $sth->execute;
 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;
 180                 }
 181         }
 182         my $subtitle; # Added by JF for Subtitles
 183
 184         # prepare the query to find item status
 185         my $sth_itemCN;
 186         if (C4::Context->preference('hidelostitem')) {
 187                 $sth_itemCN = $dbh->prepare("select items.* from items where biblionumber=? and (itemlost = 0 or itemlost is NULL)");
 188         } else {
 189                 $sth_itemCN = $dbh->prepare("select items.* from items where biblionumber=?");
 190         }
 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=?");
 194
 195         # prepare the query to find subtitles
 196         my $sth_subtitle = $dbh->prepare("SELECT subtitle FROM bibliosubtitle WHERE biblionumber=?"); # Added BY JF for Subtitles
 197
 198         # build the z3950 request
 199         my $attr;
 200 #       if ($type eq 'isbn') {
 201 #               $attr='1=7';
 202 #       } elsif ($type eq 'title') {
 203 #               $attr='1=4';
 204 #       } elsif ($type eq 'author') {
 205 #               $attr='1=1003';
 206 #       } elsif ($type eq 'lccn') {
 207 #               $attr='1=9';
 208 #       } elsif ($type eq 'keyword') {
 209                 $attr='1=1016';
 210 #       }
 211 #       my $term = @$value[0];
 212 #       my $query="\@attr $attr \"$term\"";
 213         #
 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
 221         #
 222         my $tagslib = MARCgettagslib($dbh,$1,'');
 223         my $query;
 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];
 227                 $x[0] =~ s/'//g;
 228                 $x[0] =~ /(...)(.)/;
 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]."\" ";
 240                         } else {
 241                                 $query .= "\@attr 1=1016 \"".@$value[$i]."\" ";
 242                         }
 243                 }
 244 #               warn "$i : ".@$tags[$i]. "=> $tag / $subfield = ".$tagslib->{$tag}->{$subfield}->{kohafield};
 245         }
 246         warn "QUERY : $query";
 247
 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";
 256         } else {
 257                 warn "$numresults records found, retrieving them (max 80)\n";
 258         }
 259         my $result='';
 260         my $scantimerstart=time();
 261         my @finalresult = ();
 262         my @CNresults=();
 263         my $totalitems=0;
 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;
 280
 281         # /ADDED BY JF
 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);
 289                 my @CNresults = ();
 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
 294
 295                         # search if item is on loan
 296                         my $date_due;
 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};
 301                                 }
 302                         }
 303                         # store this item
 304                         my %lineCN;
 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;
 313                         $totalitems++;
 314                 }
 315                 # save the biblio in the final array, with item and item issue status
 316                 my %newline;
 317                 %newline = %$line;
 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;
 325                 }
 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
 331
 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});
 337                 @CNresults = ();
 338                 push @finalresult, \%newline;
 339                 $totalitems=0;
 340         }
 341         my $nbresults = $#finalresult+1;
 342         return (\@finalresult, $nbresults);
 343 }
 344
 345 =head2 my $marcnotesarray = &getMARCnotes($dbh,$bibid,$marcflavour);
 346
 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.
 349
 350 =cut
 351
 352 sub getMARCnotes {
 353         my ($dbh, $bibid, $marcflavour) = @_;
 354         my ($mintag, $maxtag);
 355         if ($marcflavour eq "MARC21") {
 356                 $mintag = "500";
 357                 $maxtag = "599";
 358         } else {           # assume unimarc if not marc21
 359                 $mintag = "300";
 360                 $maxtag = "399";
 361         }
 362
 363         my $sth=$dbh->prepare("SELECT subfieldvalue,tag FROM marc_subfield_table WHERE bibid=? AND tag BETWEEN ? AND ? ORDER BY tagorder");
 364
 365         $sth->execute($bibid,$mintag,$maxtag);
 366
 367         my @marcnotes;
 368         my $note = "";
 369         my $tag = "";
 370         my $marcnote;
 371
 372         while (my $data=$sth->fetchrow_arrayref) {
 373                 my $value=$data->[0];
 374                 my $thistag=$data->[1];
 375                 if ($value=~/\.$/) {
 376                         $value=$value . "  ";
 377                 }
 378                 if ($thistag ne $tag && $note ne "") {
 379                         $marcnote = {marcnote => $note,};
 380                         push @marcnotes, $marcnote;
 381                         $note=$value;
 382                         $tag=$thistag;
 383                 }
 384                 if ($note ne $value) {
 385                         $note = $note." ".$value;
 386                 }
 387         }
 388
 389         if ($note) {
 390                 $marcnote = {marcnote => $note};
 391                 push @marcnotes, $marcnote;   #load last tag into array
 392         }
 393
 394         $sth->finish;
 395
 396         my $marcnotesarray=\@marcnotes;
 397         return $marcnotesarray;
 398 }  # end getMARCnotes
 399
 400
 401 =head2 my $marcsubjctsarray = &getMARCsubjects($dbh,$bibid,$marcflavour);
 402
 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.
 405
 406 =cut
 407
 408 sub getMARCsubjects {
 409     my ($dbh, $bibid, $marcflavour) = @_;
 410         my ($mintag, $maxtag);
 411         if ($marcflavour eq "MARC21") {
 412                 $mintag = "600";
 413                 $maxtag = "699";
 414         } else {           # assume unimarc if not marc21
 415                 $mintag = "600";
 416                 $maxtag = "619";
 417         }
 418         my $sth=$dbh->prepare("SELECT subfieldvalue,subfieldcode FROM marc_subfield_table WHERE bibid=? AND tag BETWEEN ? AND ? ORDER BY tagorder");
 419
 420         $sth->execute($bibid,$mintag,$maxtag);
 421
 422         my @marcsubjcts;
 423         my $subjct = "";
 424         my $subfield = "";
 425         my $marcsubjct;
 426
 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;
 433                         $subjct = $value;
 434                 }
 435         }
 436
 437         $sth->finish;
 438
 439         my $marcsubjctsarray=\@marcsubjcts;
 440         return $marcsubjctsarray;
 441 }  #end getMARCsubjects
 442
 443 END { }       # module clean-up code here (global destructor)
 444
 445 1;
 446 __END__
 447
 448 =back
 449
 450 =head1 AUTHOR
 451
 452 Koha Developement team <info@koha.org>
 453
 454 =cut