C4/Search.pm

   1 package C4::Search;
   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::Reserves2;
  25         # FIXME - C4::Search uses C4::Reserves2, which uses C4::Search.
  26         # So Perl complains that all of the functions here get redefined.
  27 use C4::Date;
  28
  29 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
  30
  31 # set the version for version checking
  32 $VERSION = do { my @v = '$Revision$' =~ /\d+/g;
  33           shift(@v) . "." . join("_", map {sprintf "%03d", $_ } @v); };
  34
  35 =head1 NAME
  36
  37 C4::Search - Functions for searching the Koha catalog and other databases
  38
  39 =head1 SYNOPSIS
  40
  41   use C4::Search;
  42
  43   my ($count, @results) = catalogsearch($env, $type, $search, $num, $offset);
  44
  45 =head1 DESCRIPTION
  46
  47 This module provides the searching facilities for the Koha catalog and
  48 other databases.
  49
  50 C<&catalogsearch> is a front end to all the other searches. Depending
  51 on what is passed to it, it calls the appropriate search function.
  52
  53 =head1 FUNCTIONS
  54
  55 =over 2
  56
  57 =cut
  58
  59 @ISA = qw(Exporter);
  60 @EXPORT = qw(
  61         &catalogsearch &KeywordSearch &CatSearch &subsearch
  62 );
  63 # make all your functions, whether exported or not;
  64
  65 =item catalogsearch
  66
  67   ($count, @results) = &catalogsearch($env, $type, $search, $num, $offset);
  68
  69 This is primarily a front-end to other, more specialized catalog
  70 search functions: if C<$search-E<gt>{itemnumber}> or
  71 C<$search-E<gt>{isbn}> is given, C<&catalogsearch> uses a precise
  72 C<&CatSearch>. If $search->{subject} is given, it runs a subject
  73 C<&CatSearch>. If C<$search-E<gt>{keyword}> is given, it runs a
  74 C<&KeywordSearch>. Otherwise, it runs a loose C<&CatSearch>.
  75
  76 If C<$env-E<gt>{itemcount}> is 1, then C<&catalogsearch> also counts
  77 the items for each result, and adds several keys:
  78
  79 =over 4
  80
  81 =item C<itemcount>
  82
  83 The total number of copies of this book.
  84
  85 =item C<locationhash>
  86
  87 This is a reference-to-hash; the keys are the names of branches where
  88 this book may be found, and the values are the number of copies at
  89 that branch.
  90
  91 =item C<location>
  92
  93 A descriptive string saying where the book is located, and how many
  94 copies there are, if greater than 1.
  95
  96 =item C<subject2>
  97
  98 The book's subject, with spaces replaced with C<%20>, presumably for
  99 HTML.
 100
 101 =back
 102
 103 =cut
 104 #'
 105 sub catalogsearch {
 106         my ($env,$type,$search,$num,$offset)=@_;
 107         my $dbh = C4::Context->dbh;
 108         #  foreach my $key (%$search){
 109         #    $search->{$key}=$dbh->quote($search->{$key});
 110         #  }
 111         my ($count,@results);
 112         if ($search->{'itemnumber'} ne '' || $search->{'isbn'} ne ''){
 113                 print STDERR "Doing a precise search\n";
 114                 ($count,@results)=CatSearch($env,'precise',$search,$num,$offset);
 115         } elsif ($search->{'subject'} ne ''){
 116                 ($count,@results)=CatSearch($env,'subject',$search,$num,$offset);
 117         } elsif ($search->{'keyword'} ne ''){
 118                 ($count,@results)=&KeywordSearch($env,'keyword',$search,$num,$offset);
 119         } else {
 120                 ($count,@results)=CatSearch($env,'loose',$search,$num,$offset);
 121
 122         }
 123         if ($env->{itemcount} eq '1') {
 124                 foreach my $data (@results){
 125                         my ($counts) = itemcount2($env, $data->{'biblionumber'}, 'intra');
 126                         my $subject2=$data->{'subject'};
 127                         $subject2=~ s/ /%20/g;
 128                         $data->{'itemcount'}=$counts->{'total'};
 129                         my $totalitemcounts=0;
 130                         foreach my $key (keys %$counts){
 131                                 if ($key ne 'total'){   # FIXME - Should ignore 'order', too.
 132                                         #$data->{'location'}.="$key $counts->{$key} ";
 133                                         $totalitemcounts+=$counts->{$key};
 134                                         $data->{'locationhash'}->{$key}=$counts->{$key};
 135                                 }
 136                         }
 137                         my $locationtext='';
 138                         my $locationtextonly='';
 139                         my $notavailabletext='';
 140                         foreach (sort keys %{$data->{'locationhash'}}) {
 141                                 if ($_ eq 'notavailable') {
 142                                         $notavailabletext="Not available";
 143                                         my $c=$data->{'locationhash'}->{$_};
 144                                         $data->{'not-available-p'}=$totalitemcounts;
 145                                         if ($totalitemcounts>1) {
 146                                         $notavailabletext.=" ($c)";
 147                                         $data->{'not-available-plural-p'}=1;
 148                                         }
 149                                 } else {
 150                                         $locationtext.="$_";
 151                                         my $c=$data->{'locationhash'}->{$_};
 152                                         if ($_ eq 'Item Lost') {
 153                                         $data->{'lost-p'}=$totalitemcounts;
 154                                         $data->{'lost-plural-p'}=1
 155                                                         if $totalitemcounts > 1;
 156                                         } elsif ($_ eq 'Withdrawn') {
 157                                         $data->{'withdrawn-p'}=$totalitemcounts;
 158                                         $data->{'withdrawn-plural-p'}=1
 159                                                         if $totalitemcounts > 1;
 160                                         } elsif ($_ eq 'On Loan') {
 161                                         $data->{'on-loan-p'}=$totalitemcounts;
 162                                         $data->{'on-loan-plural-p'}=1
 163                                                         if $totalitemcounts > 1;
 164                                         } else {
 165                                         $locationtextonly.=$_;
 166                                         $locationtextonly.=" ($c), "
 167                                                         if $totalitemcounts>1;
 168                                         }
 169                                         if ($totalitemcounts>1) {
 170                                         $locationtext.=" ($c), ";
 171                                         }
 172                                 }
 173                         }
 174                         if ($notavailabletext) {
 175                                 $locationtext.=$notavailabletext;
 176                         } else {
 177                                 $locationtext=~s/, $//;
 178                         }
 179                         $data->{'location'}=$locationtext;
 180                         $data->{'location-only'}=$locationtextonly;
 181                         $data->{'subject2'}=$subject2;
 182                         $data->{'use-location-flags-p'}=1; # XXX
 183                 }
 184         }
 185         return ($count,@results);
 186 }
 187
 188 =item KeywordSearch
 189
 190   $search = { "keyword" => "One or more keywords",
 191               "class"   => "VID|CD",    # Limit search to fiction and CDs
 192               "dewey"   => "813",
 193          };
 194   ($count, @results) = &KeywordSearch($env, $type, $search, $num, $offset);
 195
 196 C<&KeywordSearch> searches the catalog by keyword: given a string
 197 (C<$search-E<gt>{"keyword"}> consisting of a space-separated list of
 198 keywords, it looks for books that contain any of those keywords in any
 199 of a number of places.
 200
 201 C<&KeywordSearch> looks for keywords in the book title (and subtitle),
 202 series name, notes (both C<biblio.notes> and C<biblioitems.notes>),
 203 and subjects.
 204
 205 C<$search-E<gt>{"class"}> can be set to a C<|> (pipe)-separated list of
 206 item class codes (e.g., "F" for fiction, "JNF" for junior nonfiction,
 207 etc.). In this case, the search will be restricted to just those
 208 classes.
 209
 210 If C<$search-E<gt>{"class"}> is not specified, you may specify
 211 C<$search-E<gt>{"dewey"}>. This will restrict the search to that
 212 particular Dewey Decimal Classification category. Setting
 213 C<$search-E<gt>{"dewey"}> to "513" will return books about arithmetic,
 214 whereas setting it to "5" will return all books with Dewey code 5I<xx>
 215 (Science and Mathematics).
 216
 217 C<$env> and C<$type> are ignored.
 218
 219 C<$offset> and C<$num> specify the subset of results to return.
 220 C<$num> specifies the number of results to return, and C<$offset> is
 221 the number of the first result. Thus, setting C<$offset> to 100 and
 222 C<$num> to 5 will return results 100 through 104 inclusive.
 223
 224 =cut
 225 #'
 226 sub KeywordSearch {
 227   my ($env,$type,$search,$num,$offset)=@_;
 228   my $dbh = C4::Context->dbh;
 229   $search->{'keyword'}=~ s/ +$//;
 230   my @key=split(' ',$search->{'keyword'});
 231                 # FIXME - Naive users might enter comma-separated
 232                 # words, e.g., "training, animal". Ought to cope with
 233                 # this.
 234   my $count=@key;
 235   my $i=1;
 236   my %biblionumbers;            # Set of biblionumbers returned by the
 237                                 # various searches.
 238
 239   # FIXME - Ought to filter the stopwords out of the list of keywords.
 240   #     @key = map { !defined($stopwords{$_}) } @key;
 241
 242   # FIXME - The way this code is currently set up, it looks for all of
 243   # the keywords first in (title, notes, seriestitle), then in the
 244   # subtitle, then in the subject. Thus, if you look for keywords
 245   # "science fiction", this search won't find a book with
 246   #     title    = "How to write fiction"
 247   #     subtitle = "A science-based approach"
 248   # Is this the desired effect? If not, then the first SQL query
 249   # should look in the biblio, subtitle, and subject tables all at
 250   # once. The way the first query is built can accomodate this easily.
 251
 252   # Look for keywords in table 'biblio'.
 253
 254   # Build an SQL query that finds each of the keywords in any of the
 255   # title, biblio.notes, or seriestitle. To do this, we'll build up an
 256   # array of clauses, one for each keyword.
 257   my $query;                    # The SQL query
 258   my @clauses = ();             # The search clauses
 259   my @bind = ();                # The term bindings
 260
 261   $query = <<EOT;               # Beginning of the query
 262         SELECT  biblionumber
 263         FROM    biblio
 264         WHERE
 265 EOT
 266   foreach my $keyword (@key)
 267   {
 268     my @subclauses = ();        # Subclauses, one for each field we're
 269                                 # searching on
 270
 271     # For each field we're searching on, create a subclause that'll
 272     # match the current keyword in the current field.
 273     foreach my $field (qw(title notes seriestitle author))
 274     {
 275       push @subclauses,
 276         "$field LIKE ? OR $field LIKE ?";
 277           push(@bind,"\Q$keyword\E%","% \Q$keyword\E%");
 278     }
 279     # (Yes, this could have been done as
 280     #   @subclauses = map {...} qw(field1 field2 ...)
 281     # )but I think this way is more readable.
 282
 283     # Construct the current clause by joining the subclauses.
 284     push @clauses, "(" . join(")\n\tOR (", @subclauses) . ")";
 285   }
 286   # Now join all of the clauses together and append to the query.
 287   $query .= "(" . join(")\nAND (", @clauses) . ")";
 288
 289   # FIXME - Perhaps use $sth->bind_columns() ? Documented as the most
 290   # efficient way to fetch data.
 291   my $sth=$dbh->prepare($query);
 292   $sth->execute(@bind);
 293   while (my @res = $sth->fetchrow_array) {
 294     for (@res)
 295     {
 296         $biblionumbers{$_} = 1;         # Add these results to the set
 297     }
 298   }
 299   $sth->finish;
 300
 301   # Now look for keywords in the 'bibliosubtitle' table.
 302
 303   # Again, we build a list of clauses from the keywords.
 304   @clauses = ();
 305   @bind = ();
 306   $query = "SELECT biblionumber FROM bibliosubtitle WHERE ";
 307   foreach my $keyword (@key)
 308   {
 309     push @clauses,
 310         "subtitle LIKE ? OR subtitle like ?";
 311         push(@bind,"\Q$keyword\E%","% \Q$keyword\E%");
 312   }
 313   $query .= "(" . join(") AND (", @clauses) . ")";
 314
 315   $sth=$dbh->prepare($query);
 316   $sth->execute(@bind);
 317   while (my @res = $sth->fetchrow_array) {
 318     for (@res)
 319     {
 320         $biblionumbers{$_} = 1;         # Add these results to the set
 321     }
 322   }
 323   $sth->finish;
 324
 325   # Look for the keywords in the notes for individual items
 326   # ('biblioitems.notes')
 327
 328   # Again, we build a list of clauses from the keywords.
 329   @clauses = ();
 330   @bind = ();
 331   $query = "SELECT biblionumber FROM biblioitems WHERE ";
 332   foreach my $keyword (@key)
 333   {
 334     push @clauses,
 335         "notes LIKE ? OR notes like ?";
 336         push(@bind,"\Q$keyword\E%","% \Q$keyword\E%");
 337   }
 338   $query .= "(" . join(") AND (", @clauses) . ")";
 339
 340   $sth=$dbh->prepare($query);
 341   $sth->execute(@bind);
 342   while (my @res = $sth->fetchrow_array) {
 343     for (@res)
 344     {
 345         $biblionumbers{$_} = 1;         # Add these results to the set
 346     }
 347   }
 348   $sth->finish;
 349
 350   # Look for keywords in the 'bibliosubject' table.
 351
 352   # FIXME - The other queries look for words in the desired field that
 353   # begin with the individual keywords the user entered. This one
 354   # searches for the literal string the user entered. Is this the
 355   # desired effect?
 356   # Note in particular that spaces are retained: if the user typed
 357   #     science  fiction
 358   # (with two spaces), this won't find the subject "science fiction"
 359   # (one space). Likewise, a search for "%" will return absolutely
 360   # everything.
 361   # If this isn't the desired effect, see the previous searches for
 362   # how to do it.
 363
 364   $sth=$dbh->prepare("Select biblionumber from bibliosubject where subject
 365   like ? group by biblionumber");
 366   $sth->execute("%$search->{'keyword'}%");
 367
 368   while (my @res = $sth->fetchrow_array) {
 369     for (@res)
 370     {
 371         $biblionumbers{$_} = 1;         # Add these results to the set
 372     }
 373   }
 374   $sth->finish;
 375
 376   my $i2=0;
 377   my $i3=0;
 378   my $i4=0;
 379
 380   my @res2;
 381   my @res = keys %biblionumbers;
 382   $count=@res;
 383
 384   $i=0;
 385 #  print "count $count";
 386   if ($search->{'class'} ne ''){
 387     while ($i2 <$count){
 388       my $query="select * from biblio,biblioitems where
 389       biblio.biblionumber=? and
 390       biblio.biblionumber=biblioitems.biblionumber ";
 391       my @bind = ($res[$i2]);
 392       if ($search->{'class'} ne ''){    # FIXME - Redundant
 393       my @temp=split(/\|/,$search->{'class'});
 394       my $count=@temp;
 395       $query.= "and ( itemtype=?";
 396       push(@bind,$temp[0]);
 397       for (my $i=1;$i<$count;$i++){
 398         $query.=" or itemtype=?";
 399         push(@bind,$temp[$i]);
 400       }
 401       $query.=")";
 402       }
 403        my $sth=$dbh->prepare($query);
 404        #    print $query;
 405        $sth->execute(@bind);
 406        if (my $data2=$sth->fetchrow_hashref){
 407          my $dewey= $data2->{'dewey'};
 408          my $subclass=$data2->{'subclass'};
 409          # FIXME - This next bit is bogus, because it assumes that the
 410          # Dewey code is a floating-point number. It isn't. It's
 411          # actually a string that mainly consists of numbers. In
 412          # particular, "4" is not a valid Dewey code, although "004"
 413          # is ("Data processing; Computer science"). Likewise, zeros
 414          # after the decimal are significant ("575" is not the same as
 415          # "575.0"; the latter is more specific). And "000" is a
 416          # perfectly good Dewey code ("General works; computer
 417          # science") and should not be interpreted to mean "this
 418          # database entry does not have a Dewey code". That's what
 419          # NULL is for.
 420          $dewey=~s/\.*0*$//;
 421          ($dewey == 0) && ($dewey='');
 422          ($dewey) && ($dewey.=" $subclass") ;
 423           $sth->finish;
 424           my $end=$offset +$num;
 425           if ($i4 <= $offset){
 426             $i4++;
 427           }
 428 #         print $i4;
 429           if ($i4 <=$end && $i4 > $offset){
 430             $data2->{'dewey'}=$dewey;
 431             $res2[$i3]=$data2;
 432
 433 #           $res2[$i3]="$data2->{'author'}\t$data2->{'title'}\t$data2->{'biblionumber'}\t$data2->{'copyrightdate'}\t$dewey";
 434             $i3++;
 435             $i4++;
 436 #           print "in here $i3<br>";
 437           } else {
 438 #           print $end;
 439           }
 440           $i++;
 441         }
 442      $i2++;
 443      }
 444      $count=$i;
 445
 446    } else {
 447   # $search->{'class'} was not specified
 448
 449   # FIXME - This is bogus: it makes a separate query for each
 450   # biblioitem, and returns results in apparently random order. It'd
 451   # be much better to combine all of the previous queries into one big
 452   # one (building it up a little at a time, of course), and have that
 453   # big query select all of the desired fields, instead of just
 454   # 'biblionumber'.
 455
 456   while ($i2 < $num && $i2 < $count){
 457     my $query="select * from biblio,biblioitems where
 458     biblio.biblionumber=? and
 459     biblio.biblionumber=biblioitems.biblionumber ";
 460     my @bind=($res[$i2+$offset]);
 461
 462     if ($search->{'dewey'} ne ''){
 463       $query.= "and (dewey like ?)";
 464       push(@bind,"$search->{'dewey'}%");
 465     }
 466
 467     my $sth=$dbh->prepare($query);
 468 #    print $query;
 469     $sth->execute(@bind);
 470     if (my $data2=$sth->fetchrow_hashref){
 471         my $dewey= $data2->{'dewey'};
 472         my $subclass=$data2->{'subclass'};
 473         $dewey=~s/\.*0*$//;
 474         ($dewey == 0) && ($dewey='');
 475         ($dewey) && ($dewey.=" $subclass") ;
 476         $sth->finish;
 477         $data2->{'dewey'}=$dewey;
 478
 479         $res2[$i]=$data2;
 480 #       $res2[$i]="$data2->{'author'}\t$data2->{'title'}\t$data2->{'biblionumber'}\t$data2->{'copyrightdate'}\t$dewey";
 481         $i++;
 482     }
 483     $i2++;
 484
 485   }
 486   }
 487
 488   #$count=$i;
 489   return($count,@res2);
 490 }
 491
 492 =item CatSearch
 493
 494   ($count, @results) = &CatSearch($env, $type, $search, $num, $offset);
 495
 496 C<&CatSearch> searches the Koha catalog. It returns a list whose first
 497 element is the number of returned results, and whose subsequent
 498 elements are the results themselves.
 499
 500 Each returned element is a reference-to-hash. Most of the keys are
 501 simply the fields from the C<biblio> table in the Koha database, but
 502 the following keys may also be present:
 503
 504 =over 4
 505
 506 =item C<illustrator>
 507
 508 The book's illustrator.
 509
 510 =item C<publisher>
 511
 512 The publisher.
 513
 514 =back
 515
 516 C<$env> is ignored.
 517
 518 C<$type> may be C<subject>, C<loose>, or C<precise>. This controls the
 519 high-level behavior of C<&CatSearch>, as described below.
 520
 521 In many cases, the description below says that a certain field in the
 522 database must match the search string. In these cases, it means that
 523 the beginning of some word in the field must match the search string.
 524 Thus, an author search for "sm" will return books whose author is
 525 "John Smith" or "Mike Smalls", but not "Paul Grossman", since the "sm"
 526 does not occur at the beginning of a word.
 527
 528 Note that within each search mode, the criteria are and-ed together.
 529 That is, if you perform a loose search on the author "Jerome" and the
 530 title "Boat", the search will only return books by Jerome containing
 531 "Boat" in the title.
 532
 533 It is not possible to cross modes, e.g., set the author to "Asimov"
 534 and the subject to "Math" in hopes of finding books on math by Asimov.
 535
 536 =head2 Loose search
 537
 538 If C<$type> is set to C<loose>, the following search criteria may be
 539 used:
 540
 541 =over 4
 542
 543 =item C<$search-E<gt>{author}>
 544
 545 The search string is a space-separated list of words. Each word must
 546 match either the C<author> or C<additionalauthors> field.
 547
 548 =item C<$search-E<gt>{title}>
 549
 550 Each word in the search string must match the book title. If no author
 551 is specified, the book subtitle will also be searched.
 552
 553 =item C<$search-E<gt>{abstract}>
 554
 555 Searches for the given search string in the book's abstract.
 556
 557 =item C<$search-E<gt>{'date-before'}>
 558
 559 Searches for books whose copyright date matches the search string.
 560 That is, setting C<$search-E<gt>{'date-before'}> to "1985" will find
 561 books written in 1985, and setting it to "198" will find books written
 562 between 1980 and 1989.
 563
 564 =item C<$search-E<gt>{title}>
 565
 566 Searches by title are also affected by the value of
 567 C<$search-E<gt>{"ttype"}>; if it is set to C<exact>, then the book
 568 title, (one of) the series titleZ<>(s), or (one of) the unititleZ<>(s) must
 569 match the search string exactly (the subtitle is not searched).
 570
 571 If C<$search-E<gt>{"ttype"}> is set to anything other than C<exact>,
 572 each word in the search string must match the title, subtitle,
 573 unititle, or series title.
 574
 575 =item C<$search-E<gt>{class}>
 576
 577 Restricts the search to certain item classes. The value of
 578 C<$search-E<gt>{"class"}> is a | (pipe)-separated list of item types.
 579 Thus, setting it to "F" restricts the search to fiction, and setting
 580 it to "CD|CAS" will only look in compact disks and cassettes.
 581
 582 =item C<$search-E<gt>{dewey}>
 583
 584 Searches for books whose Dewey Decimal Classification code matches the
 585 search string. That is, setting C<$search-E<gt>{"dewey"}> to "5" will
 586 search for all books in 5I<xx> (Science and mathematics), setting it
 587 to "54" will search for all books in 54I<x> (Chemistry), and setting
 588 it to "546" will search for books on inorganic chemistry.
 589
 590 =item C<$search-E<gt>{publisher}>
 591
 592 Searches for books whose publisher contains the search string (unlike
 593 other search criteria, C<$search-E<gt>{publisher}> is a string, not a
 594 set of words.
 595
 596 =back
 597
 598 =head2 Subject search
 599
 600 If C<$type> is set to C<subject>, the following search criterion may
 601 be used:
 602
 603 =over 4
 604
 605 =item C<$search-E<gt>{subject}>
 606
 607 The search string is a space-separated list of words, each of which
 608 must match the book's subject.
 609
 610 Special case: if C<$search-E<gt>{subject}> is set to C<nz>,
 611 C<&CatSearch> will search for books whose subject is "New Zealand".
 612 However, setting C<$search-E<gt>{subject}> to C<"nz football"> will
 613 search for books on "nz" and "football", not books on "New Zealand"
 614 and "football".
 615
 616 =back
 617
 618 =head2 Precise search
 619
 620 If C<$type> is set to C<precise>, the following search criteria may be
 621 used:
 622
 623 =over 4
 624
 625 =item C<$search-E<gt>{item}>
 626
 627 Searches for books whose barcode exactly matches the search string.
 628
 629 =item C<$search-E<gt>{isbn}>
 630
 631 Searches for books whose ISBN exactly matches the search string.
 632
 633 =back
 634
 635 For a loose search, if an author was specified, the results are
 636 ordered by author and title. If no author was specified, the results
 637 are ordered by title.
 638
 639 For other (non-loose) searches, if a subject was specified, the
 640 results are ordered alphabetically by subject.
 641
 642 In all other cases (e.g., loose search by keyword), the results are
 643 not ordered.
 644
 645 =cut
 646 #'
 647 sub CatSearch  {
 648         my ($env,$type,$search,$num,$offset)=@_;
 649         my $dbh = C4::Context->dbh;
 650         my $query = '';
 651         my @bind = ();
 652         my @results;
 653
 654         my $title = lc($search->{'title'});
 655
 656         if ($type eq 'loose') {
 657                 if ($search->{'author'} ne ''){
 658                         my @key=split(' ',$search->{'author'});
 659                         my $count=@key;
 660                         my $i=1;
 661                         $query="select *,biblio.author,biblio.biblionumber from
 662                                                         biblio
 663                                                         left join additionalauthors
 664                                                         on additionalauthors.biblionumber =biblio.biblionumber
 665                                                         where
 666                                                         ((biblio.author like ? or biblio.author like ? or
 667                                                         additionalauthors.author like ? or additionalauthors.author
 668                                                         like ?
 669                                                                 )";
 670                         @bind=("$key[0]%","% $key[0]%","$key[0]%","% $key[0]%");
 671                         while ($i < $count){
 672                                         $query .= " and (
 673                                                                         biblio.author like ? or biblio.author like ? or
 674                                                                         additionalauthors.author like ? or additionalauthors.author like ?
 675                                                                         )";
 676                                         push(@bind,"$key[$i]%","% $key[$i]%","$key[$i]%","% $key[$i]%");
 677                                 $i++;
 678                         }
 679                         $query .= ")";
 680                         if ($search->{'title'} ne ''){
 681                                 my @key=split(' ',$search->{'title'});
 682                                 my $count=@key;
 683                                 my $i=0;
 684                                 $query.= " and (((title like ? or title like ?)";
 685                                 push(@bind,"$key[0]%","% $key[0]%");
 686                                 while ($i<$count){
 687                                         $query .= " and (title like ? or title like ?)";
 688                                         push(@bind,"$key[$i]%","% $key[$i]%");
 689                                         $i++;
 690                                 }
 691                                 $query.=") or ((seriestitle like ? or seriestitle like ?)";
 692                                 push(@bind,"$key[0]%","% $key[0]%");
 693                                 for ($i=1;$i<$count;$i++){
 694                                         $query.=" and (seriestitle like ? or seriestitle like ?)";
 695                                         push(@bind,"$key[$i]%","% $key[$i]%");
 696                                         }
 697                                 $query.=") or ((unititle like ? or unititle like ?)";
 698                                 push(@bind,"$key[0]%","% $key[0]%");
 699                                 for ($i=1;$i<$count;$i++){
 700                                         $query.=" and (unititle like ? or unititle like ?)";
 701                                         push(@bind,"$key[$i]%","% $key[$i]%");
 702                                         }
 703                                 $query .= "))";
 704                         }
 705                         if ($search->{'abstract'} ne ''){
 706                                 $query.= " and (abstract like ?)";
 707                                 push(@bind,"%$search->{'abstract'}%");
 708                         }
 709                         if ($search->{'date-before'} ne ''){
 710                                 $query.= " and (copyrightdate like ?)";
 711                                 push(@bind,"%$search->{'date-before'}%");
 712                         }
 713                         $query.=" group by biblio.biblionumber";
 714                 } else {
 715                         if ($search->{'title'} ne '') {
 716                                 if ($search->{'ttype'} eq 'exact'){
 717                                         $query="select * from biblio
 718                                         where
 719                                         (biblio.title=? or (biblio.unititle = ?
 720                                         or biblio.unititle like ? or
 721                                         biblio.unititle like ? or
 722                                         biblio.unititle like ?) or
 723                                         (biblio.seriestitle = ? or
 724                                         biblio.seriestitle like ? or
 725                                         biblio.seriestitle like ? or
 726                                         biblio.seriestitle like ?)
 727                                         )";
 728                                         @bind=($search->{'title'},$search->{'title'},"$search->{'title'} |%","%| $search->{'title'} |%","%| $search->{'title'}",$search->{'title'},"$search->{'title'} |%","%| $search->{'title'} |%","%| $search->{'title'}");
 729                                 } else {
 730                                         my @key=split(' ',$search->{'title'});
 731                                         my $count=@key;
 732                                         my $i=1;
 733                                         $query="select biblio.biblionumber,author,title,unititle,notes,abstract,serial,seriestitle,copyrightdate,timestamp,subtitle from biblio
 734                                         left join bibliosubtitle on
 735                                         biblio.biblionumber=bibliosubtitle.biblionumber
 736                                         where
 737                                         (((title like ? or title like ?)";
 738                                         @bind=("$key[0]%","% $key[0]%");
 739                                         while ($i<$count){
 740                                                 $query .= " and (title like ? or title like ?)";
 741                                                 push(@bind,"$key[$i]%","% $key[$i]%");
 742                                                 $i++;
 743                                         }
 744                                         $query.=") or ((subtitle like ? or subtitle like ?)";
 745                                         push(@bind,"$key[0]%","% $key[0]%");
 746                                         for ($i=1;$i<$count;$i++){
 747                                                 $query.=" and (subtitle like ? or subtitle like ?)";
 748                                                 push(@bind,"$key[$i]%","% $key[$i]%");
 749                                         }
 750                                         $query.=") or ((seriestitle like ? or seriestitle like ?)";
 751                                         push(@bind,"$key[0]%","% $key[0]%");
 752                                         for ($i=1;$i<$count;$i++){
 753                                                 $query.=" and (seriestitle like ? or seriestitle like ?)";
 754                                                 push(@bind,"$key[$i]%","% $key[$i]%");
 755                                         }
 756                                         $query.=") or ((unititle like ? or unititle like ?)";
 757                                         push(@bind,"$key[0]%","% $key[0]%");
 758                                         for ($i=1;$i<$count;$i++){
 759                                                 $query.=" and (unititle like ? or unititle like ?)";
 760                                                 push(@bind,"$key[$i]%","% $key[$i]%");
 761                                         }
 762                                         $query .= "))";
 763                                 }
 764                                 if ($search->{'abstract'} ne ''){
 765                                         $query.= " and (abstract like ?)";
 766                                         push(@bind,"%$search->{'abstract'}%");
 767                                 }
 768                                 if ($search->{'date-before'} ne ''){
 769                                         $query.= " and (copyrightdate like ?)";
 770                                         push(@bind,"%$search->{'date-before'}%");
 771                                 }
 772                         } elsif ($search->{'class'} ne ''){
 773                                 $query="select * from biblioitems,biblio where biblio.biblionumber=biblioitems.biblionumber";
 774                                 my @temp=split(/\|/,$search->{'class'});
 775                                 my $count=@temp;
 776                                 $query.= " and ( itemtype= ?)";
 777                                 @bind=($temp[0]);
 778                                 for (my $i=1;$i<$count;$i++){
 779                                         $query.=" or itemtype=?";
 780                                         push(@bind,$temp[$i]);
 781                                 }
 782                                 $query.=")";
 783                                 if ($search->{'illustrator'} ne ''){
 784                                         $query.=" and illus like ?";
 785                                         push(@bind,"%".$search->{'illustrator'}."%");
 786                                 }
 787                                 if ($search->{'dewey'} ne ''){
 788                                         $query.=" and biblioitems.dewey like ?";
 789                                         push(@bind,"$search->{'dewey'}%");
 790                                 }
 791                         } elsif ($search->{'dewey'} ne ''){
 792                                 $query="select * from biblioitems,biblio
 793                                 where biblio.biblionumber=biblioitems.biblionumber
 794                                 and biblioitems.dewey like ?";
 795                                 @bind=("$search->{'dewey'}%");
 796                         } elsif ($search->{'illustrator'} ne '') {
 797                                         $query="select * from biblioitems,biblio
 798                                 where biblio.biblionumber=biblioitems.biblionumber
 799                                 and biblioitems.illus like ?";
 800                                         @bind=("%".$search->{'illustrator'}."%");
 801                         } elsif ($search->{'publisher'} ne ''){
 802                                 $query = "Select * from biblio,biblioitems where biblio.biblionumber
 803                                 =biblioitems.biblionumber and (publishercode like ?)";
 804                                 @bind=("%$search->{'publisher'}%");
 805                         } elsif ($search->{'abstract'} ne ''){
 806                                 $query = "Select * from biblio where abstract like ?";
 807                                 @bind=("%$search->{'abstract'}%");
 808                         } elsif ($search->{'date-before'} ne ''){
 809                                 $query = "Select * from biblio where copyrightdate like ?";
 810                                 @bind=("%$search->{'date-before'}%");
 811                         }
 812                         $query .=" group by biblio.biblionumber";
 813                 }
 814         }
 815         if ($type eq 'subject'){
 816                 my @key=split(' ',$search->{'subject'});
 817                 my $count=@key;
 818                 my $i=1;
 819                 $query="select * from bibliosubject, biblioitems where
 820 (bibliosubject.biblionumber = biblioitems.biblionumber) and ( subject like ? or subject like ? or subject like ?)";
 821                 @bind=("$key[0]%","% $key[0]%","%($key[0])%");
 822                 while ($i<$count){
 823                         $query.=" and (subject like ? or subject like ? or subject like ?)";
 824                         push(@bind,"$key[$i]%","% $key[$i]%","%($key[$i])%");
 825                         $i++;
 826                 }
 827
 828                 # FIXME - Wouldn't it be better to fix the database so that if a
 829                 # book has a subject "NZ", then it also gets added the subject
 830                 # "New Zealand"?
 831                 # This can also be generalized by adding a table of subject
 832                 # synonyms to the database: just declare "NZ" to be a synonym for
 833                 # "New Zealand", "SF" a synonym for both "Science fiction" and
 834                 # "Fantastic fiction", etc.
 835
 836                 if (lc($search->{'subject'}) eq 'nz'){
 837                         $query.= " or (subject like 'NEW ZEALAND %' or subject like '% NEW ZEALAND %'
 838                         or subject like '% NEW ZEALAND' or subject like '%(NEW ZEALAND)%' ) ";
 839                 } elsif ( $search->{'subject'} =~ /^nz /i || $search->{'subject'} =~ / nz /i || $search->{'subject'} =~ / nz$/i){
 840                         $query=~ s/ nz/ NEW ZEALAND/ig;
 841                         $query=~ s/nz /NEW ZEALAND /ig;
 842                         $query=~ s/\(nz\)/\(NEW ZEALAND\)/gi;
 843                 }
 844         }
 845         if ($type eq 'precise'){
 846                 if ($search->{'itemnumber'} ne ''){
 847                         $query="select * from items,biblio ";
 848                         my $search2=uc $search->{'itemnumber'};
 849                         $query=$query." where
 850                         items.biblionumber=biblio.biblionumber
 851                         and barcode=?";
 852                         @bind=($search2);
 853                                         # FIXME - .= <<EOT;
 854                 }
 855                 if ($search->{'isbn'} ne ''){
 856                         my $search2=uc $search->{'isbn'};
 857                         my $sth1=$dbh->prepare("select * from biblioitems where isbn=?");
 858                         $sth1->execute($search2);
 859                         my $i2=0;
 860                         while (my $data=$sth1->fetchrow_hashref) {
 861                                 my $sth=$dbh->prepare("select * from biblioitems,biblio where
 862                                         biblio.biblionumber = ?
 863                                         and biblioitems.biblionumber = biblio.biblionumber");
 864                                 $sth->execute($data->{'biblionumber'});
 865                                 # FIXME - There's already a $data in this scope.
 866                                 my $data=$sth->fetchrow_hashref;
 867                                 my ($dewey, $subclass) = ($data->{'dewey'}, $data->{'subclass'});
 868                                 # FIXME - The following assumes that the Dewey code is a
 869                                 # floating-point number. It isn't: it's a string.
 870                                 $dewey=~s/\.*0*$//;
 871                                 ($dewey == 0) && ($dewey='');
 872                                 ($dewey) && ($dewey.=" $subclass");
 873                                 $data->{'dewey'}=$dewey;
 874                                 $results[$i2]=$data;
 875                         #           $results[$i2]="$data->{'author'}\t$data->{'title'}\t$data->{'biblionumber'}\t$data->{'copyrightdate'}\t$dewey\t$data->{'isbn'}\t$data->{'itemtype'}";
 876                                 $i2++;
 877                                 $sth->finish;
 878                         }
 879                         $sth1->finish;
 880                 }
 881         }
 882         if ($type ne 'precise' && $type ne 'subject'){
 883                 if ($search->{'author'} ne ''){
 884                         $query .= " order by biblio.author,title";
 885                 } else {
 886                         $query .= " order by title";
 887                 }
 888         } else {
 889                 if ($type eq 'subject'){
 890                         $query .= " group by subject ";
 891                 }
 892         }
 893         my $sth=$dbh->prepare($query);
 894         $sth->execute(@bind);
 895         my $count=1;
 896         my $i=0;
 897         my $limit= $num+$offset;
 898         while (my $data=$sth->fetchrow_hashref){
 899                 my $query="select classification,dewey,subclass,publishercode from biblioitems where biblionumber=?";
 900                 my @bind=($data->{'biblionumber'});
 901                 if ($search->{'class'} ne ''){
 902                         my @temp=split(/\|/,$search->{'class'});
 903                         my $count=@temp;
 904                         $query.= " and ( itemtype= ?";
 905                         push(@bind,$temp[0]);
 906                         for (my $i=1;$i<$count;$i++){
 907                         $query.=" or itemtype=?";
 908                         push(@bind,$temp[$i]);
 909                         }
 910                         $query.=")";
 911                 }
 912                 if ($search->{'dewey'} ne ''){
 913                         $query.=" and dewey=? ";
 914                         push(@bind,$search->{'dewey'});
 915                 }
 916                 if ($search->{'illustrator'} ne ''){
 917                         $query.=" and illus like ?";
 918                         push(@bind,"%$search->{'illustrator'}%");
 919                 }
 920                 if ($search->{'publisher'} ne ''){
 921                         $query.= " and (publishercode like ?)";
 922                         push(@bind,"%$search->{'publisher'}%");
 923                 }
 924                 my $sti=$dbh->prepare($query);
 925                 $sti->execute(@bind);
 926                 my $classification;
 927                 my $dewey;
 928                 my $subclass;
 929                 my $true=0;
 930                 my $publishercode;
 931                 my $bibitemdata;
 932                 if ($bibitemdata = $sti->fetchrow_hashref()){
 933                         $true=1;
 934                         $classification=$bibitemdata->{'classification'};
 935                         $dewey=$bibitemdata->{'dewey'};
 936                         $subclass=$bibitemdata->{'subclass'};
 937                         $publishercode=$bibitemdata->{'publishercode'};
 938                 }
 939                 #  print STDERR "$dewey $subclass $publishercode\n";
 940                 # FIXME - The Dewey code is a string, not a number.
 941                 $dewey=~s/\.*0*$//;
 942                 ($dewey == 0) && ($dewey='');
 943                 ($dewey) && ($dewey.=" $subclass");
 944                 $data->{'classification'}=$classification;
 945                 $data->{'dewey'}=$dewey;
 946                 $data->{'publishercode'}=$publishercode;
 947                 $sti->finish;
 948                 if ($true == 1){
 949                         if ($count > $offset && $count <= $limit){
 950                                 $results[$i]=$data;
 951                                 $i++;
 952                         }
 953                         $count++;
 954                 }
 955         }
 956         $sth->finish;
 957         $count--;
 958         return($count,@results);
 959 }
 960
 961 =item subsearch
 962
 963   @results = &subsearch($env, $subject);
 964
 965 Searches for books that have a subject that exactly matches
 966 C<$subject>.
 967
 968 C<&subsearch> returns an array of results. Each element of this array
 969 is a string, containing the book's title, author, and biblionumber,
 970 separated by tabs.
 971
 972 C<$env> is ignored.
 973
 974 =cut
 975 #'
 976 sub subsearch {
 977   my ($env,$subject)=@_;
 978   my $dbh = C4::Context->dbh;
 979   my $sth=$dbh->prepare("Select * from biblio,bibliosubject where
 980   biblio.biblionumber=bibliosubject.biblionumber and
 981   bibliosubject.subject=? group by biblio.biblionumber
 982   order by biblio.title");
 983   $sth->execute($subject);
 984   my $i=0;
 985   my @results;
 986   while (my $data=$sth->fetchrow_hashref){
 987     push @results, $data;
 988     $i++;
 989   }
 990   $sth->finish;
 991   return(@results);
 992 }
 993
 994 END { }       # module clean-up code here (global destructor)
 995
 996 1;
 997 __END__
 998
 999 =back
1000
1001 =head1 AUTHOR
1002
1003 Koha Developement team <info@koha.org>
1004
1005 =cut