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 ZOOM;
  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                 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});
 101         }
 102 }
 103
 104 =head1  my ($count, @results) = catalogsearch($dbh, $tags, $and_or, $excluding, $operator, $value, $offset,$length,$orderby,$sqlstring);
 105
 106 =head2 $dbh is a link to the DB handler.
 107
 108 use C4::Context;
 109 my $dbh =C4::Context->dbh;
 110
 111 $tags,$and_or, $excluding, $operator, $value are references to array
 112
 113 =head2 $tags
 114
 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'
 117
 118 Example
 119
 120 =head2 $and_or
 121
 122 contains  a list of strings containing and or or. The 1st value is useless.
 123
 124 =head2 $excluding
 125
 126 contains 0 or 1. If 1, then the request is negated.
 127
 128 =head2 $operator
 129
 130 contains contains,=,start,>,>=,<,<= the = and start work on the complete subfield. The contains operator works on every word in the subfield.
 131
 132 examples :
 133 contains home, search home anywhere.
 134 = home, search a string being home.
 135
 136 =head2 $value
 137
 138 contains the value to search
 139 If it contains a * or a %, then the search is partial.
 140
 141 =head2 $offset and $length
 142
 143 returns $length results, beginning at $offset
 144
 145 =head2 $orderby
 146
 147 define the field used to order the request. Any field in the biblio/biblioitem tables can be used. DESC is possible too
 148
 149 (for example title, title DESC,...)
 150
 151 =head2 $sqlstring
 152
 153 optional argument containing an sql string to be used in the 'where' statement. see usage in opac-search.pl.
 154
 155 =head2 $extratables
 156
 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.
 159
 160 =head2 RETURNS
 161
 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.
 163
 164 =cut
 165 =head2 my $marcurlsarray = &getMARCurls($dbh,$bibid,$marcflavour);
 166
 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.
 169
 170 =cut
 171 sub catalogsearch {
 172         my ($dbh, $tags, $and_or, $excluding, $operator, $value, $offset,$length,$orderby,$desc_or_asc,$sqlstring, $extratables) = @_;
 173
 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"');
 178         $sth->execute;
 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;
 186                 }
 187         }
 188         my $subtitle; # Added by JF for Subtitles
 189
 190         # prepare the query to find item status
 191         my $sth_itemCN;
 192         if (C4::Context->preference('hidelostitem')) {
 193                 $sth_itemCN = $dbh->prepare("select items.* from items where biblionumber=? and (itemlost = 0 or itemlost is NULL)");
 194         } else {
 195                 $sth_itemCN = $dbh->prepare("select items.* from items where biblionumber=?");
 196         }
 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=?");
 200
 201         # prepare the query to find subtitles
 202         my $sth_subtitle = $dbh->prepare("SELECT subtitle FROM bibliosubtitle WHERE biblionumber=?"); # Added BY JF for Subtitles
 203
 204         #
 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
 212         #
 213         my $tagslib = MARCgettagslib($dbh,$1,'');
 214         my $query='';
 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]";
 239                         } else {
 240                                 warn $field;
 241 #                               my @spacedout=split(/ /,@$value[$i]);
 242 #                               my $text = join(" and ",@spacedout);
 243
 244                                 $query .= "dc.any all /relevant \"@$value[$i]\"";
 245                         }
 246                 }
 247 #               warn "$i : ".@$tags[$i]. "=> $tag / $subfield = ".$tagslib->{$tag}->{$subfield}->{kohafield};
 248         }
 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";
 257         } else {
 258                 warn "$numresults records found, retrieving them (max 80)\n";
 259         }
 260         # sort result set
 261         # in theory this should sort by title
 262         my $sort;
 263         if ($orderby eq 'biblio.title'){
 264             $sort="1=4";
 265         }
 266         elsif ($orderby eq 'biblio.author'){
 267             $sort="1=1003";
 268             }
 269         elsif ($orderby eq 'biblioitems.dewey'){
 270             $sort="1=13";
 271             }
 272         elsif ($orderby eq 'biblioitems.publicationyear'){
 273             $sort="1=30";
 274             }
 275         elsif ($orderby eq 'biblioitems.publishercode'){
 276             $sort="1=1018";
 277             }
 278         if ($desc_or_asc eq 'DESC'){
 279             $sort.=" >i";
 280             }
 281         else {
 282             $sort.=" <i";
 283             }
 284
 285         if ($rs->sort("yaz", $sort) < 0) {
 286                  warn "sort failed";
 287         }
 288         else {
 289             warn "sorted";
 290             }
 291         my $result='';
 292         my $scantimerstart=time();
 293         my @finalresult = ();
 294         my @CNresults=();
 295         my $totalitems=0;
 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;
 314
 315         # /ADDED BY JF
 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);
 323                 my @CNresults = ();
 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
 328
 329                         # search if item is on loan
 330                         # store this item
 331                         my %lineCN;
 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){
 337               my $date_due;
 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};
 342                   }
 343               }
 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});
 347             }
 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};
 351                 }
 352                 # save the biblio in the final array, with item and item issue status
 353                 my %newline;
 354                 %newline = %$line;
 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;
 362                 }
 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
 368
 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});
 374                 @CNresults = ();
 375                 push @finalresult, \%newline;
 376                 $totalitems=0;
 377         }
 378         my $nbresults = $#finalresult+1;
 379         return (\@finalresult, $numresults);
 380 }
 381
 382 =head2 my $marcnotesarray = &getMARCnotes($dbh,$bibid,$marcflavour);
 383
 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.
 386
 387 =cut
 388
 389 sub getMARCnotes {
 390         my ($dbh, $bibid, $marcflavour) = @_;
 391         my ($mintag, $maxtag);
 392         if ($marcflavour eq "MARC21") {
 393                 $mintag = "500";
 394                 $maxtag = "599";
 395         } else {           # assume unimarc if not marc21
 396                 $mintag = "300";
 397                 $maxtag = "399";
 398         }
 399
 400         my $sth=$dbh->prepare("SELECT subfieldvalue,tag FROM marc_subfield_table WHERE bibid=? AND tag BETWEEN ? AND ? ORDER BY tagorder");
 401
 402         $sth->execute($bibid,$mintag,$maxtag);
 403
 404         my @marcnotes;
 405         my $note = "";
 406         my $tag = "";
 407         my $marcnote;
 408
 409         while (my $data=$sth->fetchrow_arrayref) {
 410                 my $value=$data->[0];
 411                 my $thistag=$data->[1];
 412                 if ($value=~/\.$/) {
 413                         $value=$value . "  ";
 414                 }
 415                 if ($thistag ne $tag && $note ne "") {
 416                         $marcnote = {marcnote => $note,};
 417                         push @marcnotes, $marcnote;
 418                         $note=$value;
 419                         $tag=$thistag;
 420                 }
 421                 if ($note ne $value) {
 422                         $note = $note." ".$value;
 423                 }
 424         }
 425
 426         if ($note) {
 427                 $marcnote = {marcnote => $note};
 428                 push @marcnotes, $marcnote;   #load last tag into array
 429         }
 430
 431         $sth->finish;
 432
 433         my $marcnotesarray=\@marcnotes;
 434         return $marcnotesarray;
 435 }  # end getMARCnotes
 436
 437
 438 =head2 my $marcsubjctsarray = &getMARCsubjects($dbh,$bibid,$marcflavour);
 439
 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.
 442
 443 =cut
 444
 445 sub getMARCsubjects {
 446     my ($dbh, $bibid, $marcflavour) = @_;
 447         my ($mintag, $maxtag);
 448         if ($marcflavour eq "MARC21") {
 449         $mintag = "600";
 450                 $maxtag = "699";
 451         } else {           # assume unimarc if not marc21
 452                 $mintag = "600";
 453                 $maxtag = "699";
 454         }
 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.
 467         #
 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
 471
 472         $sth->execute($bibid,$mintag,$maxtag);
 473
 474         my @marcsubjcts;
 475         my $subject = "";
 476         my $marcsubjct;
 477         my $field9;
 478         my $activetagorder=0;
 479         my $lasttag;
 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,
 489                                                         };
 490                         push @marcsubjcts, $marcsubjct;
 491                         $subject='';
 492                         $tag='';
 493                         $field9='';
 494                 }
 495                 if ($subfieldcode eq 9) {
 496                         $field9=$subfieldvalue;
 497                 } elsif ($subfieldcode eq (3 || 5)) {
 498                         $subject .= $subfieldvalue . " ";
 499                 } else {
 500                         $subject .= $subfieldvalue . " -- ";
 501                 }
 502                 $activetagorder=$tagorder;
 503                 $lasttag=$tag if $tag;
 504         }
 505         $subject=~ s/ -- $//;
 506         $marcsubjct = {MARCSUBJCT => $subject,
 507                                         link => $lasttag."9",
 508                                         linkvalue => $field9,
 509                                         };
 510         push @marcsubjcts, $marcsubjct;
 511
 512         $sth->finish;
 513
 514         my $marcsubjctsarray=\@marcsubjcts;
 515         return $marcsubjctsarray;
 516 }  #end getMARCsubjects
 517
 518 END { }       # module clean-up code here (global destructor)
 519
 520 1;
 521 __END__
 522
 523 =back
 524
 525 =head1 AUTHOR
 526
 527 Koha Developement team <info@koha.org>
 528
 529 =cut