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
 194         # prepare the query to find subtitles
 195         my $sth_subtitle = $dbh->prepare("SELECT subtitle FROM bibliosubtitle WHERE biblionumber=?"); # Added BY JF for Subtitles
 196
 197         # build the z3950 request
 198         my $attr;
 199 #       if ($type eq 'isbn') {
 200 #               $attr='1=7';
 201 #       } elsif ($type eq 'title') {
 202 #               $attr='1=4';
 203 #       } elsif ($type eq 'author') {
 204 #               $attr='1=1003';
 205 #       } elsif ($type eq 'lccn') {
 206 #               $attr='1=9';
 207 #       } elsif ($type eq 'keyword') {
 208                 $attr='1=1016';
 209 #       }
 210 #       my $term = @$value[0];
 211 #       my $query="\@attr $attr \"$term\"";
 212         #
 213         # now, do stupid things, that have to be modified for 3.0 :
 214         # retrieve the 1st MARC tag.
 215         # find the matching non-MARC field
 216         # 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" !)
 217         # the best method to do this would probably to add a "bib1 attribute" column to marc_subfield_structure
 218         # (or a CQL attribute name if we don't want to build bib1 requests)
 219         # for instance, we manage only author / title / isbn. Any other field is considered as a keyword/anywhere search
 220         #
 221         my $tagslib = MARCgettagslib($dbh,$1,'');
 222         my $query;
 223         for(my $i = 0 ; $i <= $#{$value} ; $i++){
 224                 # 1st split on , then remove ' in the 1st, the find koha field
 225                 my @x = split /,/, @$tags[$i];
 226                 $x[0] =~ s/'//g;
 227                 $x[0] =~ /(...)(.)/;
 228                 my ($tag,$subfield) = ($1,$2);
 229                 if (@$value[$i]) { # if there is something to search, build the request
 230                         # if $query already contains something, add @and
 231                         $query = "\@and $query" if ($query);
 232                         my $field = $tagslib->{$tag}->{$subfield}->{kohafield};
 233                         if ($field eq 'biblio.author') {
 234                                 $query .= "\@attr 1=1003 \"".@$value[$i]."\" ";
 235                         } elsif ($field eq 'biblio.title') {
 236                                 $query .= "\@attr 1=4 \"".@$value[$i]."\" ";
 237                         } elsif ($field eq 'biblioitems.isbn') {
 238                                 $query .= "\@attr 1=7 \"".@$value[$i]."\" ";
 239                         } else {
 240                                 $query .= "\@attr 1=1016 \"".@$value[$i]."\" ";
 241                         }
 242                 }
 243 #               warn "$i : ".@$tags[$i]. "=> $tag / $subfield = ".$tagslib->{$tag}->{$subfield}->{kohafield};
 244         }
 245         warn "QUERY : $query";
 246
 247         my $conn= new Net::Z3950::Connection('localhost', '2100'); #databaseName => $database, user => $user, password => $password)
 248         eval {$conn->option(elementSetName => 'F')};
 249 #       eval { $conn->option(preferredRecordSyntax => Net::Z3950::RecordSyntax::USMARC);} if ($globalsyntax eq "MARC21");
 250         eval { $conn->option(preferredRecordSyntax => Net::Z3950::RecordSyntax::USMARC);};
 251         my $rs=$conn->search($query);
 252         my $numresults=$rs->size();
 253         if ($numresults eq 0) {
 254                 warn "no records found\n";
 255         } else {
 256                 warn "$numresults records found, retrieving them (max 80)\n";
 257         }
 258         my $result='';
 259         my $scantimerstart=time();
 260         my @finalresult = ();
 261         my @CNresults=();
 262         my $totalitems=0;
 263         $offset=1 unless $offset;
 264         # calculate max offset
 265         my $maxrecordnum = $offset+$length<$numresults?$offset+$length:$numresults;
 266         for (my $i=$offset; $i <= $maxrecordnum; $i++) {
 267                 # get the MARC record...
 268                 my $record = MARC::File::USMARC::decode($rs->record($i)->rawdata());
 269                 # transform it into a meaningul hash
 270                 my $line = MARCmarc2koha($dbh,$record);
 271                 my $biblionumber=$line->{biblionumber};
 272         # Return subtitles first ADDED BY JF
 273 #                 $sth_subtitle->execute($biblionumber);
 274 #                 my $subtitle_here.= $sth_subtitle->fetchrow." ";
 275 #                 chop $subtitle_here;
 276 #                 $subtitle = $subtitle_here;
 277 #               warn "Here's the Biblionumber ".$biblionumber;
 278 #                warn "and here's the subtitle: ".$subtitle_here;
 279
 280         # /ADDED BY JF
 281
 282                 $sth_itemCN->execute($biblionumber);
 283                 my @CNresults = ();
 284                 my $notforloan=1; # to see if there is at least 1 item that can be issued
 285                 while (my $item = $sth_itemCN->fetchrow_hashref) {
 286                         # parse the result, putting holdingbranch & itemcallnumber in separate array
 287                         # then all other fields in the main array
 288
 289                         # search if item is on loan
 290                         my $date_due;
 291                         $sth_issue->execute($item->{itemnumber});
 292                         while (my $loan = $sth_issue->fetchrow_hashref) {
 293                                 if ($loan->{date_due} and !$loan->{returndate}) {
 294                                         $date_due = $loan->{date_due};
 295                                 }
 296                         }
 297                         # store this item
 298                         my %lineCN;
 299                         $lineCN{holdingbranch} = $item->{holdingbranch};
 300                         $lineCN{itemcallnumber} = $item->{itemcallnumber};
 301                         $lineCN{location} = $item->{location};
 302                         $lineCN{date_due} = format_date($date_due);
 303                         $lineCN{notforloan} = $notforloanstatus{$line->{notforloan}} if ($line->{notforloan}); # setting not forloan if itemtype is not for loan
 304                         $lineCN{notforloan} = $notforloanstatus{$item->{notforloan}} if ($item->{notforloan}); # setting not forloan it this item is not for loan
 305                         $notforloan=0 unless ($item->{notforloan} or $item->{wthdrawn} or $item->{itemlost});
 306                         push @CNresults,\%lineCN;
 307                         $totalitems++;
 308                 }
 309                 # save the biblio in the final array, with item and item issue status
 310                 my %newline;
 311                 %newline = %$line;
 312                 $newline{totitem} = $totalitems;
 313                 # if $totalitems == 0, check if it's being ordered.
 314                 if ($totalitems == 0) {
 315                         my $sth = $dbh->prepare("select count(*) from aqorders where biblionumber=? and datecancellationprinted is NULL");
 316                         $sth->execute($biblionumber);
 317                         my ($ordered) = $sth->fetchrow;
 318                         $newline{onorder} = 1 if $ordered;
 319                 }
 320                 $newline{biblionumber} = $biblionumber;
 321                 $newline{norequests} = 0;
 322                 $newline{norequests} = 1 if ($line->{notforloan}); # itemtype not issuable
 323                 $newline{norequests} = 1 if (!$line->{notforloan} && $notforloan); # itemtype issuable but all items not issuable for instance
 324                 $newline{subtitle} = $subtitle;  # put the subtitle in ADDED BY JF
 325
 326                 my @CNresults2= @CNresults;
 327                 $newline{CN} = \@CNresults2;
 328                 $newline{'even'} = 1 if $#finalresult % 2 == 0;
 329                 $newline{'odd'} = 1 if $#finalresult % 2 == 1;
 330                 $newline{'timestamp'} = format_date($newline{timestamp});
 331                 @CNresults = ();
 332                 push @finalresult, \%newline;
 333                 $totalitems=0;
 334         }
 335         my $nbresults = $#finalresult+1;
 336         return (\@finalresult, $nbresults);
 337 }
 338
 339 =head2 my $marcnotesarray = &getMARCnotes($dbh,$bibid,$marcflavour);
 340
 341 Returns a reference to an array containing all the notes stored in the MARC database for the given bibid.
 342 $marcflavour ("MARC21" or "UNIMARC") determines which tags are used for retrieving subjects.
 343
 344 =cut
 345
 346 sub getMARCnotes {
 347         my ($dbh, $bibid, $marcflavour) = @_;
 348         my ($mintag, $maxtag);
 349         if ($marcflavour eq "MARC21") {
 350                 $mintag = "500";
 351                 $maxtag = "599";
 352         } else {           # assume unimarc if not marc21
 353                 $mintag = "300";
 354                 $maxtag = "399";
 355         }
 356
 357         my $sth=$dbh->prepare("SELECT subfieldvalue,tag FROM marc_subfield_table WHERE bibid=? AND tag BETWEEN ? AND ? ORDER BY tagorder");
 358
 359         $sth->execute($bibid,$mintag,$maxtag);
 360
 361         my @marcnotes;
 362         my $note = "";
 363         my $tag = "";
 364         my $marcnote;
 365
 366         while (my $data=$sth->fetchrow_arrayref) {
 367                 my $value=$data->[0];
 368                 my $thistag=$data->[1];
 369                 if ($value=~/\.$/) {
 370                         $value=$value . "  ";
 371                 }
 372                 if ($thistag ne $tag && $note ne "") {
 373                         $marcnote = {marcnote => $note,};
 374                         push @marcnotes, $marcnote;
 375                         $note=$value;
 376                         $tag=$thistag;
 377                 }
 378                 if ($note ne $value) {
 379                         $note = $note." ".$value;
 380                 }
 381         }
 382
 383         if ($note) {
 384                 $marcnote = {marcnote => $note};
 385                 push @marcnotes, $marcnote;   #load last tag into array
 386         }
 387
 388         $sth->finish;
 389
 390         my $marcnotesarray=\@marcnotes;
 391         return $marcnotesarray;
 392 }  # end getMARCnotes
 393
 394
 395 =head2 my $marcsubjctsarray = &getMARCsubjects($dbh,$bibid,$marcflavour);
 396
 397 Returns a reference to an array containing all the subjects stored in the MARC database for the given bibid.
 398 $marcflavour ("MARC21" or "UNIMARC") determines which tags are used for retrieving subjects.
 399
 400 =cut
 401
 402 sub getMARCsubjects {
 403     my ($dbh, $bibid, $marcflavour) = @_;
 404         my ($mintag, $maxtag);
 405         if ($marcflavour eq "MARC21") {
 406                 $mintag = "600";
 407                 $maxtag = "699";
 408         } else {           # assume unimarc if not marc21
 409                 $mintag = "600";
 410                 $maxtag = "619";
 411         }
 412         my $sth=$dbh->prepare("SELECT subfieldvalue,subfieldcode FROM marc_subfield_table WHERE bibid=? AND tag BETWEEN ? AND ? ORDER BY tagorder");
 413
 414         $sth->execute($bibid,$mintag,$maxtag);
 415
 416         my @marcsubjcts;
 417         my $subjct = "";
 418         my $subfield = "";
 419         my $marcsubjct;
 420
 421         while (my $data=$sth->fetchrow_arrayref) {
 422                 my $value = $data->[0];
 423                 my $subfield = $data->[1];
 424                 if ($subfield eq "a" && $value ne $subjct) {
 425                         $marcsubjct = {MARCSUBJCT => $value,};
 426                         push @marcsubjcts, $marcsubjct;
 427                         $subjct = $value;
 428                 }
 429         }
 430
 431         $sth->finish;
 432
 433         my $marcsubjctsarray=\@marcsubjcts;
 434         return $marcsubjctsarray;
 435 }  #end getMARCsubjects
 436
 437 END { }       # module clean-up code here (global destructor)
 438
 439 1;
 440 __END__
 441
 442 =back
 443
 444 =head1 AUTHOR
 445
 446 Koha Developement team <info@koha.org>
 447
 448 =cut