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 &CatSearch &BornameSearch &ItemInfo &KeywordSearch &subsearch
  62 &itemdata &bibdata &GetItems &borrdata &itemnodata
  63 &borrdata2 &NewBorrowerNumber &bibitemdata &borrissues
  64 &getboracctrecord &ItemType &itemissues &subject &subtitle
  65 &addauthor &bibitems &barcodes &allissues &getwebsites &getwebbiblioitems &catalogsearch &itemcount2
  66 &isbnsearch &getbranchname &getborrowercategory);
  67 # make all your functions, whether exported or not;
  68
  69 =item catalogsearch
  70
  71   ($count, @results) = &catalogsearch($env, $type, $search, $num, $offset);
  72
  73 This is primarily a front-end to other, more specialized catalog
  74 search functions: if C<$search-E<gt>{itemnumber}> or
  75 C<$search-E<gt>{isbn}> is given, C<&catalogsearch> uses a precise
  76 C<&CatSearch>. If $search->{subject} is given, it runs a subject
  77 C<&CatSearch>. If C<$search-E<gt>{keyword}> is given, it runs a
  78 C<&KeywordSearch>. Otherwise, it runs a loose C<&CatSearch>.
  79
  80 If C<$env-E<gt>{itemcount}> is 1, then C<&catalogsearch> also counts
  81 the items for each result, and adds several keys:
  82
  83 =over 4
  84
  85 =item C<itemcount>
  86
  87 The total number of copies of this book.
  88
  89 =item C<locationhash>
  90
  91 This is a reference-to-hash; the keys are the names of branches where
  92 this book may be found, and the values are the number of copies at
  93 that branch.
  94
  95 =item C<location>
  96
  97 A descriptive string saying where the book is located, and how many
  98 copies there are, if greater than 1.
  99
 100 =item C<subject2>
 101
 102 The book's subject, with spaces replaced with C<%20>, presumably for
 103 HTML.
 104
 105 =back
 106
 107 =cut
 108 #'
 109 sub catalogsearch {
 110         my ($env,$type,$search,$num,$offset)=@_;
 111         my $dbh = C4::Context->dbh;
 112         #  foreach my $key (%$search){
 113         #    $search->{$key}=$dbh->quote($search->{$key});
 114         #  }
 115         my ($count,@results);
 116         if ($search->{'itemnumber'} ne '' || $search->{'isbn'} ne ''){
 117                 print STDERR "Doing a precise search\n";
 118                 ($count,@results)=CatSearch($env,'precise',$search,$num,$offset);
 119         } elsif ($search->{'subject'} ne ''){
 120                 ($count,@results)=CatSearch($env,'subject',$search,$num,$offset);
 121         } elsif ($search->{'keyword'} ne ''){
 122                 ($count,@results)=&KeywordSearch($env,'keyword',$search,$num,$offset);
 123         } else {
 124                 ($count,@results)=CatSearch($env,'loose',$search,$num,$offset);
 125
 126         }
 127         if ($env->{itemcount} eq '1') {
 128                 foreach my $data (@results){
 129                         my ($counts) = itemcount2($env, $data->{'biblionumber'}, 'intra');
 130                         my $subject2=$data->{'subject'};
 131                         $subject2=~ s/ /%20/g;
 132                         $data->{'itemcount'}=$counts->{'total'};
 133                         my $totalitemcounts=0;
 134                         foreach my $key (keys %$counts){
 135                                 if ($key ne 'total'){   # FIXME - Should ignore 'order', too.
 136                                         #$data->{'location'}.="$key $counts->{$key} ";
 137                                         $totalitemcounts+=$counts->{$key};
 138                                         $data->{'locationhash'}->{$key}=$counts->{$key};
 139                                 }
 140                         }
 141                         my $locationtext='';
 142                         my $locationtextonly='';
 143                         my $notavailabletext='';
 144                         foreach (sort keys %{$data->{'locationhash'}}) {
 145                                 if ($_ eq 'notavailable') {
 146                                         $notavailabletext="Not available";
 147                                         my $c=$data->{'locationhash'}->{$_};
 148                                         $data->{'not-available-p'}=$totalitemcounts;
 149                                         if ($totalitemcounts>1) {
 150                                         $notavailabletext.=" ($c)";
 151                                         $data->{'not-available-plural-p'}=1;
 152                                         }
 153                                 } else {
 154                                         $locationtext.="$_";
 155                                         my $c=$data->{'locationhash'}->{$_};
 156                                         if ($_ eq 'Item Lost') {
 157                                         $data->{'lost-p'}=$totalitemcounts;
 158                                         $data->{'lost-plural-p'}=1
 159                                                         if $totalitemcounts > 1;
 160                                         } elsif ($_ eq 'Withdrawn') {
 161                                         $data->{'withdrawn-p'}=$totalitemcounts;
 162                                         $data->{'withdrawn-plural-p'}=1
 163                                                         if $totalitemcounts > 1;
 164                                         } elsif ($_ eq 'On Loan') {
 165                                         $data->{'on-loan-p'}=$totalitemcounts;
 166                                         $data->{'on-loan-plural-p'}=1
 167                                                         if $totalitemcounts > 1;
 168                                         } else {
 169                                         $locationtextonly.=$_;
 170                                         $locationtextonly.=" ($c), "
 171                                                         if $totalitemcounts>1;
 172                                         }
 173                                         if ($totalitemcounts>1) {
 174                                         $locationtext.=" ($c), ";
 175                                         }
 176                                 }
 177                         }
 178                         if ($notavailabletext) {
 179                                 $locationtext.=$notavailabletext;
 180                         } else {
 181                                 $locationtext=~s/, $//;
 182                         }
 183                         $data->{'location'}=$locationtext;
 184                         $data->{'location-only'}=$locationtextonly;
 185                         $data->{'subject2'}=$subject2;
 186                         $data->{'use-location-flags-p'}=1; # XXX
 187                 }
 188         }
 189         return ($count,@results);
 190 }
 191
 192 =item KeywordSearch
 193
 194   $search = { "keyword" => "One or more keywords",
 195               "class"   => "VID|CD",    # Limit search to fiction and CDs
 196               "dewey"   => "813",
 197          };
 198   ($count, @results) = &KeywordSearch($env, $type, $search, $num, $offset);
 199
 200 C<&KeywordSearch> searches the catalog by keyword: given a string
 201 (C<$search-E<gt>{"keyword"}> consisting of a space-separated list of
 202 keywords, it looks for books that contain any of those keywords in any
 203 of a number of places.
 204
 205 C<&KeywordSearch> looks for keywords in the book title (and subtitle),
 206 series name, notes (both C<biblio.notes> and C<biblioitems.notes>),
 207 and subjects.
 208
 209 C<$search-E<gt>{"class"}> can be set to a C<|> (pipe)-separated list of
 210 item class codes (e.g., "F" for fiction, "JNF" for junior nonfiction,
 211 etc.). In this case, the search will be restricted to just those
 212 classes.
 213
 214 If C<$search-E<gt>{"class"}> is not specified, you may specify
 215 C<$search-E<gt>{"dewey"}>. This will restrict the search to that
 216 particular Dewey Decimal Classification category. Setting
 217 C<$search-E<gt>{"dewey"}> to "513" will return books about arithmetic,
 218 whereas setting it to "5" will return all books with Dewey code 5I<xx>
 219 (Science and Mathematics).
 220
 221 C<$env> and C<$type> are ignored.
 222
 223 C<$offset> and C<$num> specify the subset of results to return.
 224 C<$num> specifies the number of results to return, and C<$offset> is
 225 the number of the first result. Thus, setting C<$offset> to 100 and
 226 C<$num> to 5 will return results 100 through 104 inclusive.
 227
 228 =cut
 229 #'
 230 sub KeywordSearch {
 231   my ($env,$type,$search,$num,$offset)=@_;
 232   my $dbh = C4::Context->dbh;
 233   $search->{'keyword'}=~ s/ +$//;
 234   my @key=split(' ',$search->{'keyword'});
 235                 # FIXME - Naive users might enter comma-separated
 236                 # words, e.g., "training, animal". Ought to cope with
 237                 # this.
 238   my $count=@key;
 239   my $i=1;
 240   my %biblionumbers;            # Set of biblionumbers returned by the
 241                                 # various searches.
 242
 243   # FIXME - Ought to filter the stopwords out of the list of keywords.
 244   #     @key = map { !defined($stopwords{$_}) } @key;
 245
 246   # FIXME - The way this code is currently set up, it looks for all of
 247   # the keywords first in (title, notes, seriestitle), then in the
 248   # subtitle, then in the subject. Thus, if you look for keywords
 249   # "science fiction", this search won't find a book with
 250   #     title    = "How to write fiction"
 251   #     subtitle = "A science-based approach"
 252   # Is this the desired effect? If not, then the first SQL query
 253   # should look in the biblio, subtitle, and subject tables all at
 254   # once. The way the first query is built can accomodate this easily.
 255
 256   # Look for keywords in table 'biblio'.
 257
 258   # Build an SQL query that finds each of the keywords in any of the
 259   # title, biblio.notes, or seriestitle. To do this, we'll build up an
 260   # array of clauses, one for each keyword.
 261   my $query;                    # The SQL query
 262   my @clauses = ();             # The search clauses
 263   my @bind = ();                # The term bindings
 264
 265   $query = <<EOT;               # Beginning of the query
 266         SELECT  biblionumber
 267         FROM    biblio
 268         WHERE
 269 EOT
 270   foreach my $keyword (@key)
 271   {
 272     my @subclauses = ();        # Subclauses, one for each field we're
 273                                 # searching on
 274
 275     # For each field we're searching on, create a subclause that'll
 276     # match the current keyword in the current field.
 277     foreach my $field (qw(title notes seriestitle author))
 278     {
 279       push @subclauses,
 280         "$field LIKE ? OR $field LIKE ?";
 281           push(@bind,"\Q$keyword\E%","% \Q$keyword\E%");
 282     }
 283     # (Yes, this could have been done as
 284     #   @subclauses = map {...} qw(field1 field2 ...)
 285     # )but I think this way is more readable.
 286
 287     # Construct the current clause by joining the subclauses.
 288     push @clauses, "(" . join(")\n\tOR (", @subclauses) . ")";
 289   }
 290   # Now join all of the clauses together and append to the query.
 291   $query .= "(" . join(")\nAND (", @clauses) . ")";
 292
 293   # FIXME - Perhaps use $sth->bind_columns() ? Documented as the most
 294   # efficient way to fetch data.
 295   my $sth=$dbh->prepare($query);
 296   $sth->execute(@bind);
 297   while (my @res = $sth->fetchrow_array) {
 298     for (@res)
 299     {
 300         $biblionumbers{$_} = 1;         # Add these results to the set
 301     }
 302   }
 303   $sth->finish;
 304
 305   # Now look for keywords in the 'bibliosubtitle' table.
 306
 307   # Again, we build a list of clauses from the keywords.
 308   @clauses = ();
 309   @bind = ();
 310   $query = "SELECT biblionumber FROM bibliosubtitle WHERE ";
 311   foreach my $keyword (@key)
 312   {
 313     push @clauses,
 314         "subtitle LIKE ? OR subtitle like ?";
 315         push(@bind,"\Q$keyword\E%","% \Q$keyword\E%");
 316   }
 317   $query .= "(" . join(") AND (", @clauses) . ")";
 318
 319   $sth=$dbh->prepare($query);
 320   $sth->execute(@bind);
 321   while (my @res = $sth->fetchrow_array) {
 322     for (@res)
 323     {
 324         $biblionumbers{$_} = 1;         # Add these results to the set
 325     }
 326   }
 327   $sth->finish;
 328
 329   # Look for the keywords in the notes for individual items
 330   # ('biblioitems.notes')
 331
 332   # Again, we build a list of clauses from the keywords.
 333   @clauses = ();
 334   @bind = ();
 335   $query = "SELECT biblionumber FROM biblioitems WHERE ";
 336   foreach my $keyword (@key)
 337   {
 338     push @clauses,
 339         "notes LIKE ? OR notes like ?";
 340         push(@bind,"\Q$keyword\E%","% \Q$keyword\E%");
 341   }
 342   $query .= "(" . join(") AND (", @clauses) . ")";
 343
 344   $sth=$dbh->prepare($query);
 345   $sth->execute(@bind);
 346   while (my @res = $sth->fetchrow_array) {
 347     for (@res)
 348     {
 349         $biblionumbers{$_} = 1;         # Add these results to the set
 350     }
 351   }
 352   $sth->finish;
 353
 354   # Look for keywords in the 'bibliosubject' table.
 355
 356   # FIXME - The other queries look for words in the desired field that
 357   # begin with the individual keywords the user entered. This one
 358   # searches for the literal string the user entered. Is this the
 359   # desired effect?
 360   # Note in particular that spaces are retained: if the user typed
 361   #     science  fiction
 362   # (with two spaces), this won't find the subject "science fiction"
 363   # (one space). Likewise, a search for "%" will return absolutely
 364   # everything.
 365   # If this isn't the desired effect, see the previous searches for
 366   # how to do it.
 367
 368   $sth=$dbh->prepare("Select biblionumber from bibliosubject where subject
 369   like ? group by biblionumber");
 370   $sth->execute("%$search->{'keyword'}%");
 371
 372   while (my @res = $sth->fetchrow_array) {
 373     for (@res)
 374     {
 375         $biblionumbers{$_} = 1;         # Add these results to the set
 376     }
 377   }
 378   $sth->finish;
 379
 380   my $i2=0;
 381   my $i3=0;
 382   my $i4=0;
 383
 384   my @res2;
 385   my @res = keys %biblionumbers;
 386   $count=@res;
 387
 388   $i=0;
 389 #  print "count $count";
 390   if ($search->{'class'} ne ''){
 391     while ($i2 <$count){
 392       my $query="select * from biblio,biblioitems where
 393       biblio.biblionumber=? and
 394       biblio.biblionumber=biblioitems.biblionumber ";
 395       my @bind = ($res[$i2]);
 396       if ($search->{'class'} ne ''){    # FIXME - Redundant
 397       my @temp=split(/\|/,$search->{'class'});
 398       my $count=@temp;
 399       $query.= "and ( itemtype=?";
 400       push(@bind,$temp[0]);
 401       for (my $i=1;$i<$count;$i++){
 402         $query.=" or itemtype=?";
 403         push(@bind,$temp[$i]);
 404       }
 405       $query.=")";
 406       }
 407        my $sth=$dbh->prepare($query);
 408        #    print $query;
 409        $sth->execute(@bind);
 410        if (my $data2=$sth->fetchrow_hashref){
 411          my $dewey= $data2->{'dewey'};
 412          my $subclass=$data2->{'subclass'};
 413          # FIXME - This next bit is bogus, because it assumes that the
 414          # Dewey code is a floating-point number. It isn't. It's
 415          # actually a string that mainly consists of numbers. In
 416          # particular, "4" is not a valid Dewey code, although "004"
 417          # is ("Data processing; Computer science"). Likewise, zeros
 418          # after the decimal are significant ("575" is not the same as
 419          # "575.0"; the latter is more specific). And "000" is a
 420          # perfectly good Dewey code ("General works; computer
 421          # science") and should not be interpreted to mean "this
 422          # database entry does not have a Dewey code". That's what
 423          # NULL is for.
 424          $dewey=~s/\.*0*$//;
 425          ($dewey == 0) && ($dewey='');
 426          ($dewey) && ($dewey.=" $subclass") ;
 427           $sth->finish;
 428           my $end=$offset +$num;
 429           if ($i4 <= $offset){
 430             $i4++;
 431           }
 432 #         print $i4;
 433           if ($i4 <=$end && $i4 > $offset){
 434             $data2->{'dewey'}=$dewey;
 435             $res2[$i3]=$data2;
 436
 437 #           $res2[$i3]="$data2->{'author'}\t$data2->{'title'}\t$data2->{'biblionumber'}\t$data2->{'copyrightdate'}\t$dewey";
 438             $i3++;
 439             $i4++;
 440 #           print "in here $i3<br>";
 441           } else {
 442 #           print $end;
 443           }
 444           $i++;
 445         }
 446      $i2++;
 447      }
 448      $count=$i;
 449
 450    } else {
 451   # $search->{'class'} was not specified
 452
 453   # FIXME - This is bogus: it makes a separate query for each
 454   # biblioitem, and returns results in apparently random order. It'd
 455   # be much better to combine all of the previous queries into one big
 456   # one (building it up a little at a time, of course), and have that
 457   # big query select all of the desired fields, instead of just
 458   # 'biblionumber'.
 459
 460   while ($i2 < $num && $i2 < $count){
 461     my $query="select * from biblio,biblioitems where
 462     biblio.biblionumber=? and
 463     biblio.biblionumber=biblioitems.biblionumber ";
 464     my @bind=($res[$i2+$offset]);
 465
 466     if ($search->{'dewey'} ne ''){
 467       $query.= "and (dewey like ?)";
 468       push(@bind,"$search->{'dewey'}%");
 469     }
 470
 471     my $sth=$dbh->prepare($query);
 472 #    print $query;
 473     $sth->execute(@bind);
 474     if (my $data2=$sth->fetchrow_hashref){
 475         my $dewey= $data2->{'dewey'};
 476         my $subclass=$data2->{'subclass'};
 477         $dewey=~s/\.*0*$//;
 478         ($dewey == 0) && ($dewey='');
 479         ($dewey) && ($dewey.=" $subclass") ;
 480         $sth->finish;
 481         $data2->{'dewey'}=$dewey;
 482
 483         $res2[$i]=$data2;
 484 #       $res2[$i]="$data2->{'author'}\t$data2->{'title'}\t$data2->{'biblionumber'}\t$data2->{'copyrightdate'}\t$dewey";
 485         $i++;
 486     }
 487     $i2++;
 488
 489   }
 490   }
 491
 492   #$count=$i;
 493   return($count,@res2);
 494 }
 495
 496 sub KeywordSearch2 {
 497   my ($env,$type,$search,$num,$offset)=@_;
 498   my $dbh = C4::Context->dbh;
 499   $search->{'keyword'}=~ s/ +$//;
 500   my @key=split(' ',$search->{'keyword'});
 501   my $count=@key;
 502   my $i=1;
 503   my @results;
 504   my $query ="Select * from biblio,bibliosubtitle,biblioitems where
 505   biblio.biblionumber=biblioitems.biblionumber and
 506   biblio.biblionumber=bibliosubtitle.biblionumber and
 507   (((title like ? or title like ?)";
 508   my @bind=("$key[0]%","% $key[0]%");
 509   while ($i < $count){
 510     $query .= " and (title like ? or title like ?)";
 511     push(@bind,"$key[$i]%","% $key[$i]%");
 512     $i++;
 513   }
 514   $query.= ") or ((subtitle like ? or subtitle like ?)";
 515   push(@bind,"$key[0]%","% $key[0]%");
 516   for ($i=1;$i<$count;$i++){
 517     $query.= " and (subtitle like ? or subtitle like ?)";
 518     push(@bind,"$key[$i]%","% $key[$i]%");
 519   }
 520   $query.= ") or ((seriestitle like ? or seriestitle like ?)";
 521   push(@bind,"$key[0]%","% $key[0]%");
 522   for ($i=1;$i<$count;$i++){
 523     $query.=" and (seriestitle like ? or seriestitle like ?)";
 524     push(@bind,"$key[$i]%","% $key[$i]%");
 525   }
 526   $query.= ") or ((biblio.notes like ? or biblio.notes like ?)";
 527   push(@bind,"$key[0]%","% $key[0]%");
 528   for ($i=1;$i<$count;$i++){
 529     $query.=" and (biblio.notes like ? or biblio.notes like ?)";
 530     push(@bind,"$key[$i]%","% $key[$i]%");
 531   }
 532   $query.= ") or ((biblioitems.notes like ? or biblioitems.notes like ?)";
 533   push(@bind,"$key[0]%","% $key[0]%");
 534   for ($i=1;$i<$count;$i++){
 535     $query.=" and (biblioitems.notes like ? or biblioitems.notes like ?)";
 536     push(@bind,"$key[$i]%","% $key[$i]%");
 537   }
 538   if ($search->{'keyword'} =~ /new zealand/i){
 539     $query.= "or (title like 'nz%' or title like '% nz %' or title like '% nz' or subtitle like 'nz%'
 540     or subtitle like '% nz %' or subtitle like '% nz' or author like 'nz %'
 541     or author like '% nz %' or author like '% nz')"
 542   }
 543   if ($search->{'keyword'} eq  'nz' || $search->{'keyword'} eq 'NZ' ||
 544   $search->{'keyword'} =~ /nz /i || $search->{'keyword'} =~ / nz /i ||
 545   $search->{'keyword'} =~ / nz/i){
 546     $query.= "or (title like 'new zealand%' or title like '% new zealand %'
 547     or title like '% new zealand' or subtitle like 'new zealand%' or
 548     subtitle like '% new zealand %'
 549     or subtitle like '% new zealand' or author like 'new zealand%'
 550     or author like '% new zealand %' or author like '% new zealand' or
 551     seriestitle like 'new zealand%' or seriestitle like '% new zealand %'
 552     or seriestitle like '% new zealand')"
 553   }
 554   $query .= "))";
 555   if ($search->{'class'} ne ''){
 556     my @temp=split(/\|/,$search->{'class'});
 557     my $count=@temp;
 558     $query.= "and ( itemtype=?";
 559     push(@bind,"$temp[0]");
 560     for (my $i=1;$i<$count;$i++){
 561       $query.=" or itemtype=?";
 562       push(@bind,"$temp[$i]");
 563      }
 564   $query.=")";
 565   }
 566   if ($search->{'dewey'} ne ''){
 567     $query.= "and (dewey like '$search->{'dewey'}%') ";
 568   }
 569    $query.="group by biblio.biblionumber";
 570    #$query.=" order by author,title";
 571 #  print $query;
 572   my $sth=$dbh->prepare($query);
 573   $sth->execute(@bind);
 574   $i=0;
 575   while (my $data=$sth->fetchrow_hashref){
 576 #FIXME: rewrite to use ? before uncomment
 577 #    my $sti=$dbh->prepare("select dewey,subclass from biblioitems where biblionumber=$data->{'biblionumber'}
 578 #    ");
 579 #    $sti->execute;
 580 #    my ($dewey, $subclass) = $sti->fetchrow;
 581     my $dewey=$data->{'dewey'};
 582     my $subclass=$data->{'subclass'};
 583     $dewey=~s/\.*0*$//;
 584     ($dewey == 0) && ($dewey='');
 585     ($dewey) && ($dewey.=" $subclass");
 586 #    $sti->finish;
 587     $results[$i]="$data->{'author'}\t$data->{'title'}\t$data->{'biblionumber'}\t$data->{'copyrightdate'}\t$dewey";
 588 #      print $results[$i];
 589     $i++;
 590   }
 591   $sth->finish;
 592   $sth=$dbh->prepare("Select biblionumber from bibliosubject where subject
 593   like ? group by biblionumber");
 594   $sth->execute("%".$search->{'keyword'}."%");
 595   while (my $data=$sth->fetchrow_hashref){
 596     $query="Select * from biblio,biblioitems where
 597     biblio.biblionumber=? and
 598     biblio.biblionumber=biblioitems.biblionumber ";
 599     @bind=($data->{'biblionumber'});
 600     if ($search->{'class'} ne ''){
 601       my @temp=split(/\|/,$search->{'class'});
 602       my $count=@temp;
 603       $query.= " and ( itemtype=?";
 604       push(@bind,$temp[0]);
 605       for (my $i=1;$i<$count;$i++){
 606         $query.=" or itemtype=?";
 607         push(@bind,$temp[$i]);
 608       }
 609       $query.=")";
 610
 611     }
 612     if ($search->{'dewey'} ne ''){
 613       $query.= "and (dewey like ?)";
 614       push(@bind,"$search->{'dewey'}%");
 615     }
 616     my $sth2=$dbh->prepare($query);
 617     $sth2->execute(@bind);
 618 #    print $query;
 619     while (my $data2=$sth2->fetchrow_hashref){
 620       my $dewey= $data2->{'dewey'};
 621       my $subclass=$data2->{'subclass'};
 622       $dewey=~s/\.*0*$//;
 623       ($dewey == 0) && ($dewey='');
 624       ($dewey) && ($dewey.=" $subclass") ;
 625 #      $sti->finish;
 626        $results[$i]="$data2->{'author'}\t$data2->{'title'}\t$data2->{'biblionumber'}\t$data2->{'copyrightdate'}\t$dewey";
 627 #      print $results[$i];
 628       $i++;
 629     }
 630     $sth2->finish;
 631   }
 632   my $i2=1;
 633   @results=sort @results;
 634   my @res;
 635   $count=@results;
 636   $i=1;
 637   if ($count > 0){
 638     $res[0]=$results[0];
 639   }
 640   while ($i2 < $count){
 641     if ($results[$i2] ne $res[$i-1]){
 642       $res[$i]=$results[$i2];
 643       $i++;
 644     }
 645     $i2++;
 646   }
 647   $i2=0;
 648   my @res2;
 649   $count=@res;
 650   while ($i2 < $num && $i2 < $count){
 651     $res2[$i2]=$res[$i2+$offset];
 652 #    print $res2[$i2];
 653     $i2++;
 654   }
 655   $sth->finish;
 656 #  $i--;
 657 #  $i++;
 658   return($i,@res2);
 659 }
 660
 661 =item CatSearch
 662
 663   ($count, @results) = &CatSearch($env, $type, $search, $num, $offset);
 664
 665 C<&CatSearch> searches the Koha catalog. It returns a list whose first
 666 element is the number of returned results, and whose subsequent
 667 elements are the results themselves.
 668
 669 Each returned element is a reference-to-hash. Most of the keys are
 670 simply the fields from the C<biblio> table in the Koha database, but
 671 the following keys may also be present:
 672
 673 =over 4
 674
 675 =item C<illustrator>
 676
 677 The book's illustrator.
 678
 679 =item C<publisher>
 680
 681 The publisher.
 682
 683 =back
 684
 685 C<$env> is ignored.
 686
 687 C<$type> may be C<subject>, C<loose>, or C<precise>. This controls the
 688 high-level behavior of C<&CatSearch>, as described below.
 689
 690 In many cases, the description below says that a certain field in the
 691 database must match the search string. In these cases, it means that
 692 the beginning of some word in the field must match the search string.
 693 Thus, an author search for "sm" will return books whose author is
 694 "John Smith" or "Mike Smalls", but not "Paul Grossman", since the "sm"
 695 does not occur at the beginning of a word.
 696
 697 Note that within each search mode, the criteria are and-ed together.
 698 That is, if you perform a loose search on the author "Jerome" and the
 699 title "Boat", the search will only return books by Jerome containing
 700 "Boat" in the title.
 701
 702 It is not possible to cross modes, e.g., set the author to "Asimov"
 703 and the subject to "Math" in hopes of finding books on math by Asimov.
 704
 705 =head2 Loose search
 706
 707 If C<$type> is set to C<loose>, the following search criteria may be
 708 used:
 709
 710 =over 4
 711
 712 =item C<$search-E<gt>{author}>
 713
 714 The search string is a space-separated list of words. Each word must
 715 match either the C<author> or C<additionalauthors> field.
 716
 717 =item C<$search-E<gt>{title}>
 718
 719 Each word in the search string must match the book title. If no author
 720 is specified, the book subtitle will also be searched.
 721
 722 =item C<$search-E<gt>{abstract}>
 723
 724 Searches for the given search string in the book's abstract.
 725
 726 =item C<$search-E<gt>{'date-before'}>
 727
 728 Searches for books whose copyright date matches the search string.
 729 That is, setting C<$search-E<gt>{'date-before'}> to "1985" will find
 730 books written in 1985, and setting it to "198" will find books written
 731 between 1980 and 1989.
 732
 733 =item C<$search-E<gt>{title}>
 734
 735 Searches by title are also affected by the value of
 736 C<$search-E<gt>{"ttype"}>; if it is set to C<exact>, then the book
 737 title, (one of) the series titleZ<>(s), or (one of) the unititleZ<>(s) must
 738 match the search string exactly (the subtitle is not searched).
 739
 740 If C<$search-E<gt>{"ttype"}> is set to anything other than C<exact>,
 741 each word in the search string must match the title, subtitle,
 742 unititle, or series title.
 743
 744 =item C<$search-E<gt>{class}>
 745
 746 Restricts the search to certain item classes. The value of
 747 C<$search-E<gt>{"class"}> is a | (pipe)-separated list of item types.
 748 Thus, setting it to "F" restricts the search to fiction, and setting
 749 it to "CD|CAS" will only look in compact disks and cassettes.
 750
 751 =item C<$search-E<gt>{dewey}>
 752
 753 Searches for books whose Dewey Decimal Classification code matches the
 754 search string. That is, setting C<$search-E<gt>{"dewey"}> to "5" will
 755 search for all books in 5I<xx> (Science and mathematics), setting it
 756 to "54" will search for all books in 54I<x> (Chemistry), and setting
 757 it to "546" will search for books on inorganic chemistry.
 758
 759 =item C<$search-E<gt>{publisher}>
 760
 761 Searches for books whose publisher contains the search string (unlike
 762 other search criteria, C<$search-E<gt>{publisher}> is a string, not a
 763 set of words.
 764
 765 =back
 766
 767 =head2 Subject search
 768
 769 If C<$type> is set to C<subject>, the following search criterion may
 770 be used:
 771
 772 =over 4
 773
 774 =item C<$search-E<gt>{subject}>
 775
 776 The search string is a space-separated list of words, each of which
 777 must match the book's subject.
 778
 779 Special case: if C<$search-E<gt>{subject}> is set to C<nz>,
 780 C<&CatSearch> will search for books whose subject is "New Zealand".
 781 However, setting C<$search-E<gt>{subject}> to C<"nz football"> will
 782 search for books on "nz" and "football", not books on "New Zealand"
 783 and "football".
 784
 785 =back
 786
 787 =head2 Precise search
 788
 789 If C<$type> is set to C<precise>, the following search criteria may be
 790 used:
 791
 792 =over 4
 793
 794 =item C<$search-E<gt>{item}>
 795
 796 Searches for books whose barcode exactly matches the search string.
 797
 798 =item C<$search-E<gt>{isbn}>
 799
 800 Searches for books whose ISBN exactly matches the search string.
 801
 802 =back
 803
 804 For a loose search, if an author was specified, the results are
 805 ordered by author and title. If no author was specified, the results
 806 are ordered by title.
 807
 808 For other (non-loose) searches, if a subject was specified, the
 809 results are ordered alphabetically by subject.
 810
 811 In all other cases (e.g., loose search by keyword), the results are
 812 not ordered.
 813
 814 =cut
 815 #'
 816 sub CatSearch  {
 817         my ($env,$type,$search,$num,$offset)=@_;
 818         my $dbh = C4::Context->dbh;
 819         my $query = '';
 820         my @bind = ();
 821         my @results;
 822
 823         my $title = lc($search->{'title'});
 824
 825         if ($type eq 'loose') {
 826                 if ($search->{'author'} ne ''){
 827                         my @key=split(' ',$search->{'author'});
 828                         my $count=@key;
 829                         my $i=1;
 830                         $query="select *,biblio.author,biblio.biblionumber from
 831                                                         biblio
 832                                                         left join additionalauthors
 833                                                         on additionalauthors.biblionumber =biblio.biblionumber
 834                                                         where
 835                                                         ((biblio.author like ? or biblio.author like ? or
 836                                                         additionalauthors.author like ? or additionalauthors.author
 837                                                         like ?
 838                                                                 )";
 839                         @bind=("$key[0]%","% $key[0]%","$key[0]%","% $key[0]%");
 840                         while ($i < $count){
 841                                         $query .= " and (
 842                                                                         biblio.author like ? or biblio.author like ? or
 843                                                                         additionalauthors.author like ? or additionalauthors.author like ?
 844                                                                         )";
 845                                         push(@bind,"$key[$i]%","% $key[$i]%","$key[$i]%","% $key[$i]%");
 846                                 $i++;
 847                         }
 848                         $query .= ")";
 849                         if ($search->{'title'} ne ''){
 850                                 my @key=split(' ',$search->{'title'});
 851                                 my $count=@key;
 852                                 my $i=0;
 853                                 $query.= " and (((title like ? or title like ?)";
 854                                 push(@bind,"$key[0]%","% $key[0]%");
 855                                 while ($i<$count){
 856                                         $query .= " and (title like ? or title like ?)";
 857                                         push(@bind,"$key[$i]%","% $key[$i]%");
 858                                         $i++;
 859                                 }
 860                                 $query.=") or ((seriestitle like ? or seriestitle like ?)";
 861                                 push(@bind,"$key[0]%","% $key[0]%");
 862                                 for ($i=1;$i<$count;$i++){
 863                                         $query.=" and (seriestitle like ? or seriestitle like ?)";
 864                                         push(@bind,"$key[$i]%","% $key[$i]%");
 865                                         }
 866                                 $query.=") or ((unititle like ? or unititle like ?)";
 867                                 push(@bind,"$key[0]%","% $key[0]%");
 868                                 for ($i=1;$i<$count;$i++){
 869                                         $query.=" and (unititle like ? or unititle like ?)";
 870                                         push(@bind,"$key[$i]%","% $key[$i]%");
 871                                         }
 872                                 $query .= "))";
 873                         }
 874                         if ($search->{'abstract'} ne ''){
 875                                 $query.= " and (abstract like ?)";
 876                                 push(@bind,"%$search->{'abstract'}%");
 877                         }
 878                         if ($search->{'date-before'} ne ''){
 879                                 $query.= " and (copyrightdate like ?)";
 880                                 push(@bind,"%$search->{'date-before'}%");
 881                         }
 882                         $query.=" group by biblio.biblionumber";
 883                 } else {
 884                         if ($search->{'title'} ne '') {
 885                                 if ($search->{'ttype'} eq 'exact'){
 886                                         $query="select * from biblio
 887                                         where
 888                                         (biblio.title=? or (biblio.unititle = ?
 889                                         or biblio.unititle like ? or
 890                                         biblio.unititle like ? or
 891                                         biblio.unititle like ?) or
 892                                         (biblio.seriestitle = ? or
 893                                         biblio.seriestitle like ? or
 894                                         biblio.seriestitle like ? or
 895                                         biblio.seriestitle like ?)
 896                                         )";
 897                                         @bind=($search->{'title'},$search->{'title'},"$search->{'title'} |%","%| $search->{'title'} |%","%| $search->{'title'}",$search->{'title'},"$search->{'title'} |%","%| $search->{'title'} |%","%| $search->{'title'}");
 898                                 } else {
 899                                         my @key=split(' ',$search->{'title'});
 900                                         my $count=@key;
 901                                         my $i=1;
 902                                         $query="select biblio.biblionumber,author,title,unititle,notes,abstract,serial,seriestitle,copyrightdate,timestamp,subtitle from biblio
 903                                         left join bibliosubtitle on
 904                                         biblio.biblionumber=bibliosubtitle.biblionumber
 905                                         where
 906                                         (((title like ? or title like ?)";
 907                                         @bind=("$key[0]%","% $key[0]%");
 908                                         while ($i<$count){
 909                                                 $query .= " and (title like ? or title like ?)";
 910                                                 push(@bind,"$key[$i]%","% $key[$i]%");
 911                                                 $i++;
 912                                         }
 913                                         $query.=") or ((subtitle like ? or subtitle like ?)";
 914                                         push(@bind,"$key[0]%","% $key[0]%");
 915                                         for ($i=1;$i<$count;$i++){
 916                                                 $query.=" and (subtitle like ? or subtitle like ?)";
 917                                                 push(@bind,"$key[$i]%","% $key[$i]%");
 918                                         }
 919                                         $query.=") or ((seriestitle like ? or seriestitle like ?)";
 920                                         push(@bind,"$key[0]%","% $key[0]%");
 921                                         for ($i=1;$i<$count;$i++){
 922                                                 $query.=" and (seriestitle like ? or seriestitle like ?)";
 923                                                 push(@bind,"$key[$i]%","% $key[$i]%");
 924                                         }
 925                                         $query.=") or ((unititle like ? or unititle like ?)";
 926                                         push(@bind,"$key[0]%","% $key[0]%");
 927                                         for ($i=1;$i<$count;$i++){
 928                                                 $query.=" and (unititle like ? or unititle like ?)";
 929                                                 push(@bind,"$key[$i]%","% $key[$i]%");
 930                                         }
 931                                         $query .= "))";
 932                                 }
 933                                 if ($search->{'abstract'} ne ''){
 934                                         $query.= " and (abstract like ?)";
 935                                         push(@bind,"%$search->{'abstract'}%");
 936                                 }
 937                                 if ($search->{'date-before'} ne ''){
 938                                         $query.= " and (copyrightdate like ?)";
 939                                         push(@bind,"%$search->{'date-before'}%");
 940                                 }
 941                         } elsif ($search->{'class'} ne ''){
 942                                 $query="select * from biblioitems,biblio where biblio.biblionumber=biblioitems.biblionumber";
 943                                 my @temp=split(/\|/,$search->{'class'});
 944                                 my $count=@temp;
 945                                 $query.= " and ( itemtype= ?)";
 946                                 @bind=($temp[0]);
 947                                 for (my $i=1;$i<$count;$i++){
 948                                         $query.=" or itemtype=?";
 949                                         push(@bind,$temp[$i]);
 950                                 }
 951                                 $query.=")";
 952                                 if ($search->{'illustrator'} ne ''){
 953                                         $query.=" and illus like ?";
 954                                         push(@bind,"%".$search->{'illustrator'}."%");
 955                                 }
 956                                 if ($search->{'dewey'} ne ''){
 957                                         $query.=" and biblioitems.dewey like ?";
 958                                         push(@bind,"$search->{'dewey'}%");
 959                                 }
 960                         } elsif ($search->{'dewey'} ne ''){
 961                                 $query="select * from biblioitems,biblio
 962                                 where biblio.biblionumber=biblioitems.biblionumber
 963                                 and biblioitems.dewey like ?";
 964                                 @bind=("$search->{'dewey'}%");
 965                         } elsif ($search->{'illustrator'} ne '') {
 966                                         $query="select * from biblioitems,biblio
 967                                 where biblio.biblionumber=biblioitems.biblionumber
 968                                 and biblioitems.illus like ?";
 969                                         @bind=("%".$search->{'illustrator'}."%");
 970                         } elsif ($search->{'publisher'} ne ''){
 971                                 $query = "Select * from biblio,biblioitems where biblio.biblionumber
 972                                 =biblioitems.biblionumber and (publishercode like ?)";
 973                                 @bind=("%$search->{'publisher'}%");
 974                         } elsif ($search->{'abstract'} ne ''){
 975                                 $query = "Select * from biblio where abstract like ?";
 976                                 @bind=("%$search->{'abstract'}%");
 977                         } elsif ($search->{'date-before'} ne ''){
 978                                 $query = "Select * from biblio where copyrightdate like ?";
 979                                 @bind=("%$search->{'date-before'}%");
 980                         }
 981                         $query .=" group by biblio.biblionumber";
 982                 }
 983         }
 984         if ($type eq 'subject'){
 985                 my @key=split(' ',$search->{'subject'});
 986                 my $count=@key;
 987                 my $i=1;
 988                 $query="select * from bibliosubject, biblioitems where
 989 (bibliosubject.biblionumber = biblioitems.biblionumber) and ( subject like ? or subject like ? or subject like ?)";
 990                 @bind=("$key[0]%","% $key[0]%","%($key[0])%");
 991                 while ($i<$count){
 992                         $query.=" and (subject like ? or subject like ? or subject like ?)";
 993                         push(@bind,"$key[$i]%","% $key[$i]%","%($key[$i])%");
 994                         $i++;
 995                 }
 996
 997                 # FIXME - Wouldn't it be better to fix the database so that if a
 998                 # book has a subject "NZ", then it also gets added the subject
 999                 # "New Zealand"?
1000                 # This can also be generalized by adding a table of subject
1001                 # synonyms to the database: just declare "NZ" to be a synonym for
1002                 # "New Zealand", "SF" a synonym for both "Science fiction" and
1003                 # "Fantastic fiction", etc.
1004
1005                 if (lc($search->{'subject'}) eq 'nz'){
1006                         $query.= " or (subject like 'NEW ZEALAND %' or subject like '% NEW ZEALAND %'
1007                         or subject like '% NEW ZEALAND' or subject like '%(NEW ZEALAND)%' ) ";
1008                 } elsif ( $search->{'subject'} =~ /^nz /i || $search->{'subject'} =~ / nz /i || $search->{'subject'} =~ / nz$/i){
1009                         $query=~ s/ nz/ NEW ZEALAND/ig;
1010                         $query=~ s/nz /NEW ZEALAND /ig;
1011                         $query=~ s/\(nz\)/\(NEW ZEALAND\)/gi;
1012                 }
1013         }
1014         if ($type eq 'precise'){
1015                 if ($search->{'itemnumber'} ne ''){
1016                         $query="select * from items,biblio ";
1017                         my $search2=uc $search->{'itemnumber'};
1018                         $query=$query." where
1019                         items.biblionumber=biblio.biblionumber
1020                         and barcode=?";
1021                         @bind=($search2);
1022                                         # FIXME - .= <<EOT;
1023                 }
1024                 if ($search->{'isbn'} ne ''){
1025                         my $search2=uc $search->{'isbn'};
1026                         my $sth1=$dbh->prepare("select * from biblioitems where isbn=?");
1027                         $sth1->execute($search2);
1028                         my $i2=0;
1029                         while (my $data=$sth1->fetchrow_hashref) {
1030                                 my $sth=$dbh->prepare("select * from biblioitems,biblio where
1031                                         biblio.biblionumber = ?
1032                                         and biblioitems.biblionumber = biblio.biblionumber");
1033                                 $sth->execute($data->{'biblionumber'});
1034                                 # FIXME - There's already a $data in this scope.
1035                                 my $data=$sth->fetchrow_hashref;
1036                                 my ($dewey, $subclass) = ($data->{'dewey'}, $data->{'subclass'});
1037                                 # FIXME - The following assumes that the Dewey code is a
1038                                 # floating-point number. It isn't: it's a string.
1039                                 $dewey=~s/\.*0*$//;
1040                                 ($dewey == 0) && ($dewey='');
1041                                 ($dewey) && ($dewey.=" $subclass");
1042                                 $data->{'dewey'}=$dewey;
1043                                 $results[$i2]=$data;
1044                         #           $results[$i2]="$data->{'author'}\t$data->{'title'}\t$data->{'biblionumber'}\t$data->{'copyrightdate'}\t$dewey\t$data->{'isbn'}\t$data->{'itemtype'}";
1045                                 $i2++;
1046                                 $sth->finish;
1047                         }
1048                         $sth1->finish;
1049                 }
1050         }
1051         if ($type ne 'precise' && $type ne 'subject'){
1052                 if ($search->{'author'} ne ''){
1053                         $query .= " order by biblio.author,title";
1054                 } else {
1055                         $query .= " order by title";
1056                 }
1057         } else {
1058                 if ($type eq 'subject'){
1059                         $query .= " group by subject ";
1060                 }
1061         }
1062         my $sth=$dbh->prepare($query);
1063         $sth->execute(@bind);
1064         my $count=1;
1065         my $i=0;
1066         my $limit= $num+$offset;
1067         while (my $data=$sth->fetchrow_hashref){
1068                 my $query="select classification,dewey,subclass,publishercode from biblioitems where biblionumber=?";
1069                 my @bind=($data->{'biblionumber'});
1070                 if ($search->{'class'} ne ''){
1071                         my @temp=split(/\|/,$search->{'class'});
1072                         my $count=@temp;
1073                         $query.= " and ( itemtype= ?";
1074                         push(@bind,$temp[0]);
1075                         for (my $i=1;$i<$count;$i++){
1076                         $query.=" or itemtype=?";
1077                         push(@bind,$temp[$i]);
1078                         }
1079                         $query.=")";
1080                 }
1081                 if ($search->{'dewey'} ne ''){
1082                         $query.=" and dewey=? ";
1083                         push(@bind,$search->{'dewey'});
1084                 }
1085                 if ($search->{'illustrator'} ne ''){
1086                         $query.=" and illus like ?";
1087                         push(@bind,"%$search->{'illustrator'}%");
1088                 }
1089                 if ($search->{'publisher'} ne ''){
1090                         $query.= " and (publishercode like ?)";
1091                         push(@bind,"%$search->{'publisher'}%");
1092                 }
1093                 my $sti=$dbh->prepare($query);
1094                 $sti->execute(@bind);
1095                 my $classification;
1096                 my $dewey;
1097                 my $subclass;
1098                 my $true=0;
1099                 my $publishercode;
1100                 my $bibitemdata;
1101                 if ($bibitemdata = $sti->fetchrow_hashref()){
1102                         $true=1;
1103                         $classification=$bibitemdata->{'classification'};
1104                         $dewey=$bibitemdata->{'dewey'};
1105                         $subclass=$bibitemdata->{'subclass'};
1106                         $publishercode=$bibitemdata->{'publishercode'};
1107                 }
1108                 #  print STDERR "$dewey $subclass $publishercode\n";
1109                 # FIXME - The Dewey code is a string, not a number.
1110                 $dewey=~s/\.*0*$//;
1111                 ($dewey == 0) && ($dewey='');
1112                 ($dewey) && ($dewey.=" $subclass");
1113                 $data->{'classification'}=$classification;
1114                 $data->{'dewey'}=$dewey;
1115                 $data->{'publishercode'}=$publishercode;
1116                 $sti->finish;
1117                 if ($true == 1){
1118                         if ($count > $offset && $count <= $limit){
1119                                 $results[$i]=$data;
1120                                 $i++;
1121                         }
1122                         $count++;
1123                 }
1124         }
1125         $sth->finish;
1126         $count--;
1127         return($count,@results);
1128 }
1129
1130 sub updatesearchstats{
1131   my ($dbh,$query)=@_;
1132
1133 }
1134
1135 =item subsearch
1136
1137   @results = &subsearch($env, $subject);
1138
1139 Searches for books that have a subject that exactly matches
1140 C<$subject>.
1141
1142 C<&subsearch> returns an array of results. Each element of this array
1143 is a string, containing the book's title, author, and biblionumber,
1144 separated by tabs.
1145
1146 C<$env> is ignored.
1147
1148 =cut
1149 #'
1150 sub subsearch {
1151   my ($env,$subject)=@_;
1152   my $dbh = C4::Context->dbh;
1153   my $sth=$dbh->prepare("Select * from biblio,bibliosubject where
1154   biblio.biblionumber=bibliosubject.biblionumber and
1155   bibliosubject.subject=? group by biblio.biblionumber
1156   order by biblio.title");
1157   $sth->execute($subject);
1158   my $i=0;
1159   my @results;
1160   while (my $data=$sth->fetchrow_hashref){
1161     push @results, $data;
1162     $i++;
1163   }
1164   $sth->finish;
1165   return(@results);
1166 }
1167
1168 =item ItemInfo
1169
1170   @results = &ItemInfo($env, $biblionumber, $type);
1171
1172 Returns information about books with the given biblionumber.
1173
1174 C<$type> may be either C<intra> or anything else. If it is not set to
1175 C<intra>, then the search will exclude lost, very overdue, and
1176 withdrawn items.
1177
1178 C<$env> is ignored.
1179
1180 C<&ItemInfo> returns a list of references-to-hash. Each element
1181 contains a number of keys. Most of them are table items from the
1182 C<biblio>, C<biblioitems>, C<items>, and C<itemtypes> tables in the
1183 Koha database. Other keys include:
1184
1185 =over 4
1186
1187 =item C<$data-E<gt>{branchname}>
1188
1189 The name (not the code) of the branch to which the book belongs.
1190
1191 =item C<$data-E<gt>{datelastseen}>
1192
1193 This is simply C<items.datelastseen>, except that while the date is
1194 stored in YYYY-MM-DD format in the database, here it is converted to
1195 DD/MM/YYYY format. A NULL date is returned as C<//>.
1196
1197 =item C<$data-E<gt>{datedue}>
1198
1199 =item C<$data-E<gt>{class}>
1200
1201 This is the concatenation of C<biblioitems.classification>, the book's
1202 Dewey code, and C<biblioitems.subclass>.
1203
1204 =item C<$data-E<gt>{ocount}>
1205
1206 I think this is the number of copies of the book available.
1207
1208 =item C<$data-E<gt>{order}>
1209
1210 If this is set, it is set to C<One Order>.
1211
1212 =back
1213
1214 =cut
1215 #'
1216 sub ItemInfo {
1217         my ($env,$biblionumber,$type) = @_;
1218         my $dbh   = C4::Context->dbh;
1219         my $query = "SELECT *,items.notforloan as itemnotforloan FROM items, biblio, biblioitems
1220                                         left join itemtypes on biblioitems.itemtype = itemtypes.itemtype
1221                                         WHERE items.biblionumber = ?
1222                                         AND biblioitems.biblioitemnumber = items.biblioitemnumber
1223                                         AND biblio.biblionumber = items.biblionumber";
1224 # buggy : opac & librarian interface can show the same info level & itemstatus should not be hardcoded
1225 #       if ($type ne 'intra'){
1226 #               $query .= " and ((items.itemlost<>1 and items.itemlost <> 2)
1227 #               or items.itemlost is NULL)
1228 #               and (wthdrawn <> 1 or wthdrawn is NULL)";
1229 #       }
1230         $query .= " order by items.dateaccessioned desc";
1231         my $sth=$dbh->prepare($query);
1232         $sth->execute($biblionumber);
1233         my $i=0;
1234         my @results;
1235         while (my $data=$sth->fetchrow_hashref){
1236                 my $datedue = '';
1237                 my $isth=$dbh->prepare("Select issues.*,borrowers.cardnumber from issues,borrowers where itemnumber = ? and returndate is null and issues.borrowernumber=borrowers.borrowernumber");
1238                 $isth->execute($data->{'itemnumber'});
1239                 if (my $idata=$isth->fetchrow_hashref){
1240                 $data->{borrowernumber} = $idata->{borrowernumber};
1241                 $data->{cardnumber} = $idata->{cardnumber};
1242                 $datedue = format_date($idata->{'date_due'});
1243                 }
1244 # buggy : hardcoded & non-translatable
1245 # more : why don't you want to show the datedue if it's very very overdue ?
1246 #               if ($data->{'itemlost'} eq '2'){
1247 #                       $datedue='Very Overdue';
1248 #               }
1249 #               if ($data->{'itemlost'} eq '1'){
1250 #                       $datedue='Lost';
1251 #               }
1252 #               if ($data->{'wthdrawn'} eq '1'){
1253 #                       $datedue="Cancelled";
1254 #               }
1255                 if ($datedue eq ''){
1256         #       $datedue="Available";
1257                         my ($restype,$reserves)=C4::Reserves2::CheckReserves($data->{'itemnumber'});
1258                         if ($restype) {
1259                                 $datedue=$restype;
1260                         }
1261                 }
1262                 $isth->finish;
1263         #get branch information.....
1264                 my $bsth=$dbh->prepare("SELECT * FROM branches WHERE branchcode = ?");
1265                 $bsth->execute($data->{'holdingbranch'});
1266                 if (my $bdata=$bsth->fetchrow_hashref){
1267                         $data->{'branchname'} = $bdata->{'branchname'};
1268                 }
1269                 my $date=format_date($data->{'datelastseen'});
1270                 $data->{'datelastseen'}=$date;
1271                 $data->{'datedue'}=$datedue;
1272         # get notforloan complete status if applicable
1273                 my $sthnflstatus = $dbh->prepare('select authorised_value from marc_subfield_structure where kohafield="items.notforloan"');
1274                 $sthnflstatus->execute;
1275                 my ($authorised_valuecode) = $sthnflstatus->fetchrow;
1276                 if ($authorised_valuecode) {
1277                         $sthnflstatus = $dbh->prepare("select lib from authorised_values where category=? and authorised_value=?");
1278                         $sthnflstatus->execute($authorised_valuecode,$data->{itemnotforloan});
1279                         my ($lib) = $sthnflstatus->fetchrow;
1280                         $data->{notforloan} = $lib;
1281                 }
1282                 $results[$i]=$data;
1283                 $i++;
1284         }
1285         $sth->finish;
1286         #FIXME: ordering/indentation here looks wrong
1287 # buggy : count in $i+1 the info on qty ordered for $i : total shown is real total +1
1288 # useless : Koha 2.2.2 now automatically show the existing number of items
1289 # and if there is no items, and at least one is on order, show "on order".
1290 #       my $sth2=$dbh->prepare("Select * from aqorders where biblionumber=?");
1291 #       $sth2->execute($biblionumber);
1292 #       my $data;
1293 #       my $ocount;
1294 #       if ($data=$sth2->fetchrow_hashref){
1295 #               $ocount=$data->{'quantity'} - $data->{'quantityreceived'};
1296 #               if ($ocount > 0){
1297 #               $data->{'ocount'}=$ocount;
1298 #               $data->{'order'}="One Order";
1299 #               $results[$i]=$data;
1300 #               }
1301 #       }
1302 #       $sth2->finish;
1303         return(@results);
1304 }
1305
1306 =item GetItems
1307
1308   @results = &GetItems($env, $biblionumber);
1309
1310 Returns information about books with the given biblionumber.
1311
1312 C<$env> is ignored.
1313
1314 C<&GetItems> returns an array of strings. Each element is a
1315 tab-separated list of values: biblioitemnumber, itemtype,
1316 classification, Dewey number, subclass, ISBN, volume, number, and
1317 itemdata.
1318
1319 Itemdata, in turn, is a string of the form
1320 "I<barcode>C<[>I<holdingbranch>C<[>I<flags>" where I<flags> contains
1321 the string C<NFL> if the item is not for loan, and C<LOST> if the item
1322 is lost.
1323
1324 =cut
1325 #'
1326 sub GetItems {
1327    my ($env,$biblionumber)=@_;
1328    #debug_msg($env,"GetItems");
1329    my $dbh = C4::Context->dbh;
1330    my $sth=$dbh->prepare("Select * from biblioitems where (biblionumber = ?)");
1331    $sth->execute($biblionumber);
1332    #debug_msg($env,"executed query");
1333    my $i=0;
1334    my @results;
1335    while (my $data=$sth->fetchrow_hashref) {
1336       #debug_msg($env,$data->{'biblioitemnumber'});
1337       my $dewey = $data->{'dewey'};
1338       $dewey =~ s/0+$//;
1339       my $line = $data->{'biblioitemnumber'}."\t".$data->{'itemtype'};
1340       $line .= "\t$data->{'classification'}\t$dewey";
1341       $line .= "\t$data->{'subclass'}\t$data->{isbn}";
1342       $line .= "\t$data->{'volume'}\t$data->{number}";
1343       my $isth= $dbh->prepare("select * from items where biblioitemnumber = ?");
1344       $isth->execute($data->{'biblioitemnumber'});
1345       while (my $idata = $isth->fetchrow_hashref) {
1346         my $iline = $idata->{'barcode'}."[".$idata->{'holdingbranch'}."[";
1347         if ($idata->{'notforloan'} == 1) {
1348           $iline .= "NFL ";
1349         }
1350         if ($idata->{'itemlost'} == 1) {
1351           $iline .= "LOST ";
1352         }
1353         $line .= "\t$iline";
1354       }
1355       $isth->finish;
1356       $results[$i] = $line;
1357       $i++;
1358    }
1359    $sth->finish;
1360    return(@results);
1361 }
1362
1363 =item itemdata
1364
1365   $item = &itemdata($barcode);
1366
1367 Looks up the item with the given barcode, and returns a
1368 reference-to-hash containing information about that item. The keys of
1369 the hash are the fields from the C<items> and C<biblioitems> tables in
1370 the Koha database.
1371
1372 =cut
1373 #'
1374 sub itemdata {
1375   my ($barcode)=@_;
1376   my $dbh = C4::Context->dbh;
1377   my $sth=$dbh->prepare("Select * from items,biblioitems where barcode=?
1378   and items.biblioitemnumber=biblioitems.biblioitemnumber");
1379   $sth->execute($barcode);
1380   my $data=$sth->fetchrow_hashref;
1381   $sth->finish;
1382   return($data);
1383 }
1384
1385 =item bibdata
1386
1387   $data = &bibdata($biblionumber, $type);
1388
1389 Returns information about the book with the given biblionumber.
1390
1391 C<$type> is ignored.
1392
1393 C<&bibdata> returns a reference-to-hash. The keys are the fields in
1394 the C<biblio>, C<biblioitems>, and C<bibliosubtitle> tables in the
1395 Koha database.
1396
1397 In addition, C<$data-E<gt>{subject}> is the list of the book's
1398 subjects, separated by C<" , "> (space, comma, space).
1399
1400 If there are multiple biblioitems with the given biblionumber, only
1401 the first one is considered.
1402
1403 =cut
1404 #'
1405 sub bibdata {
1406         my ($bibnum, $type) = @_;
1407         my $dbh   = C4::Context->dbh;
1408         my $sth   = $dbh->prepare("Select *, biblioitems.notes AS bnotes, biblio.notes
1409                                                                 from biblio, biblioitems
1410                                                                 left join bibliosubtitle on
1411                                                                 biblio.biblionumber = bibliosubtitle.biblionumber
1412                                                                 left join itemtypes on biblioitems.itemtype=itemtypes.itemtype
1413                                                                 where biblio.biblionumber = ?
1414                                                                 and biblioitems.biblionumber = biblio.biblionumber");
1415         $sth->execute($bibnum);
1416         my $data;
1417         $data  = $sth->fetchrow_hashref;
1418         $sth->finish;
1419         # handle management of repeated subtitle
1420         $sth   = $dbh->prepare("Select * from bibliosubtitle where biblionumber = ?");
1421         $sth->execute($bibnum);
1422         my @subtitles;
1423         while (my $dat = $sth->fetchrow_hashref){
1424                 my %line;
1425                 $line{subtitle} = $dat->{subtitle};
1426                 push @subtitles, \%line;
1427         } # while
1428         $data->{subtitles} = \@subtitles;
1429         $sth->finish;
1430         $sth   = $dbh->prepare("Select * from bibliosubject where biblionumber = ?");
1431         $sth->execute($bibnum);
1432         my @subjects;
1433         while (my $dat = $sth->fetchrow_hashref){
1434                 my %line;
1435                 $line{subject} = $dat->{'subject'};
1436                 push @subjects, \%line;
1437         } # while
1438         $data->{subjects} = \@subjects;
1439         $sth->finish;
1440         $sth   = $dbh->prepare("Select * from additionalauthors where biblionumber = ?");
1441         $sth->execute($bibnum);
1442         while (my $dat = $sth->fetchrow_hashref){
1443                 $data->{'additionalauthors'} .= "$dat->{'author'} - ";
1444         } # while
1445         chop $data->{'additionalauthors'};
1446         chop $data->{'additionalauthors'};
1447         chop $data->{'additionalauthors'};
1448         $sth->finish;
1449         return($data);
1450 } # sub bibdata
1451
1452 =item bibitemdata
1453
1454   $itemdata = &bibitemdata($biblioitemnumber);
1455
1456 Looks up the biblioitem with the given biblioitemnumber. Returns a
1457 reference-to-hash. The keys are the fields from the C<biblio>,
1458 C<biblioitems>, and C<itemtypes> tables in the Koha database, except
1459 that C<biblioitems.notes> is given as C<$itemdata-E<gt>{bnotes}>.
1460
1461 =cut
1462 #'
1463 sub bibitemdata {
1464     my ($bibitem) = @_;
1465     my $dbh   = C4::Context->dbh;
1466     my $sth   = $dbh->prepare("Select *,biblioitems.notes as bnotes from biblio, biblioitems,itemtypes where biblio.biblionumber = biblioitems.biblionumber and biblioitemnumber = ? and biblioitems.itemtype = itemtypes.itemtype");
1467     my $data;
1468
1469     $sth->execute($bibitem);
1470
1471     $data = $sth->fetchrow_hashref;
1472
1473     $sth->finish;
1474     return($data);
1475 } # sub bibitemdata
1476
1477 =item subject
1478
1479   ($count, $subjects) = &subject($biblionumber);
1480
1481 Looks up the subjects of the book with the given biblionumber. Returns
1482 a two-element list. C<$subjects> is a reference-to-array, where each
1483 element is a subject of the book, and C<$count> is the number of
1484 elements in C<$subjects>.
1485
1486 =cut
1487 #'
1488 sub subject {
1489   my ($bibnum)=@_;
1490   my $dbh = C4::Context->dbh;
1491   my $sth=$dbh->prepare("Select * from bibliosubject where biblionumber=?");
1492   $sth->execute($bibnum);
1493   my @results;
1494   my $i=0;
1495   while (my $data=$sth->fetchrow_hashref){
1496     $results[$i]=$data;
1497     $i++;
1498   }
1499   $sth->finish;
1500   return($i,\@results);
1501 }
1502
1503 =item addauthor
1504
1505   ($count, $authors) = &addauthors($biblionumber);
1506
1507 Looks up the additional authors for the book with the given
1508 biblionumber.
1509
1510 Returns a two-element list. C<$authors> is a reference-to-array, where
1511 each element is an additional author, and C<$count> is the number of
1512 elements in C<$authors>.
1513
1514 =cut
1515 #'
1516 sub addauthor {
1517   my ($bibnum)=@_;
1518   my $dbh = C4::Context->dbh;
1519   my $sth=$dbh->prepare("Select * from additionalauthors where biblionumber=?");
1520   $sth->execute($bibnum);
1521   my @results;
1522   my $i=0;
1523   while (my $data=$sth->fetchrow_hashref){
1524     $results[$i]=$data;
1525     $i++;
1526   }
1527   $sth->finish;
1528   return($i,\@results);
1529 }
1530
1531 =item subtitle
1532
1533   ($count, $subtitles) = &subtitle($biblionumber);
1534
1535 Looks up the subtitles for the book with the given biblionumber.
1536
1537 Returns a two-element list. C<$subtitles> is a reference-to-array,
1538 where each element is a subtitle, and C<$count> is the number of
1539 elements in C<$subtitles>.
1540
1541 =cut
1542 #'
1543 sub subtitle {
1544   my ($bibnum)=@_;
1545   my $dbh = C4::Context->dbh;
1546   my $sth=$dbh->prepare("Select * from bibliosubtitle where biblionumber=?");
1547   $sth->execute($bibnum);
1548   my @results;
1549   my $i=0;
1550   while (my $data=$sth->fetchrow_hashref){
1551     $results[$i]=$data;
1552     $i++;
1553   }
1554   $sth->finish;
1555   return($i,\@results);
1556 }
1557
1558 =item itemissues
1559
1560   @issues = &itemissues($biblioitemnumber, $biblio);
1561
1562 Looks up information about who has borrowed the bookZ<>(s) with the
1563 given biblioitemnumber.
1564
1565 C<$biblio> is ignored.
1566
1567 C<&itemissues> returns an array of references-to-hash. The keys
1568 include the fields from the C<items> table in the Koha database.
1569 Additional keys include:
1570
1571 =over 4
1572
1573 =item C<date_due>
1574
1575 If the item is currently on loan, this gives the due date.
1576
1577 If the item is not on loan, then this is either "Available" or
1578 "Cancelled", if the item has been withdrawn.
1579
1580 =item C<card>
1581
1582 If the item is currently on loan, this gives the card number of the
1583 patron who currently has the item.
1584
1585 =item C<timestamp0>, C<timestamp1>, C<timestamp2>
1586
1587 These give the timestamp for the last three times the item was
1588 borrowed.
1589
1590 =item C<card0>, C<card1>, C<card2>
1591
1592 The card number of the last three patrons who borrowed this item.
1593
1594 =item C<borrower0>, C<borrower1>, C<borrower2>
1595
1596 The borrower number of the last three patrons who borrowed this item.
1597
1598 =back
1599
1600 =cut
1601 #'
1602 sub itemissues {
1603     my ($bibitem, $biblio)=@_;
1604     my $dbh   = C4::Context->dbh;
1605     # FIXME - If this function die()s, the script will abort, and the
1606     # user won't get anything; depending on how far the script has
1607     # gotten, the user might get a blank page. It would be much better
1608     # to at least print an error message. The easiest way to do this
1609     # is to set $SIG{__DIE__}.
1610     my $sth   = $dbh->prepare("Select * from items where
1611 items.biblioitemnumber = ?")
1612       || die $dbh->errstr;
1613     my $i     = 0;
1614     my @results;
1615
1616     $sth->execute($bibitem)
1617       || die $sth->errstr;
1618
1619     while (my $data = $sth->fetchrow_hashref) {
1620         # Find out who currently has this item.
1621         # FIXME - Wouldn't it be better to do this as a left join of
1622         # some sort? Currently, this code assumes that if
1623         # fetchrow_hashref() fails, then the book is on the shelf.
1624         # fetchrow_hashref() can fail for any number of reasons (e.g.,
1625         # database server crash), not just because no items match the
1626         # search criteria.
1627         my $sth2   = $dbh->prepare("select * from issues,borrowers
1628 where itemnumber = ?
1629 and returndate is NULL
1630 and issues.borrowernumber = borrowers.borrowernumber");
1631
1632         $sth2->execute($data->{'itemnumber'});
1633         if (my $data2 = $sth2->fetchrow_hashref) {
1634             $data->{'date_due'} = $data2->{'date_due'};
1635             $data->{'card'}     = $data2->{'cardnumber'};
1636             $data->{'borrower'}     = $data2->{'borrowernumber'};
1637         } else {
1638             if ($data->{'wthdrawn'} eq '1') {
1639                 $data->{'date_due'} = 'Cancelled';
1640             } else {
1641                 $data->{'date_due'} = 'Available';
1642             } # else
1643         } # else
1644
1645         $sth2->finish;
1646
1647         # Find the last 3 people who borrowed this item.
1648         $sth2 = $dbh->prepare("select * from issues, borrowers
1649                                                 where itemnumber = ?
1650                                                                         and issues.borrowernumber = borrowers.borrowernumber
1651                                                                         and returndate is not NULL
1652                                                                         order by returndate desc,timestamp desc") || die $dbh->errstr;
1653         $sth2->execute($data->{'itemnumber'}) || die $sth2->errstr;
1654         for (my $i2 = 0; $i2 < 2; $i2++) { # FIXME : error if there is less than 3 pple borrowing this item
1655             if (my $data2 = $sth2->fetchrow_hashref) {
1656                 $data->{"timestamp$i2"} = $data2->{'timestamp'};
1657                 $data->{"card$i2"}      = $data2->{'cardnumber'};
1658                 $data->{"borrower$i2"}  = $data2->{'borrowernumber'};
1659             } # if
1660         } # for
1661
1662         $sth2->finish;
1663         $results[$i] = $data;
1664         $i++;
1665     }
1666
1667     $sth->finish;
1668     return(@results);
1669 }
1670
1671 =item itemnodata
1672
1673   $item = &itemnodata($env, $dbh, $biblioitemnumber);
1674
1675 Looks up the item with the given biblioitemnumber.
1676
1677 C<$env> and C<$dbh> are ignored.
1678
1679 C<&itemnodata> returns a reference-to-hash whose keys are the fields
1680 from the C<biblio>, C<biblioitems>, and C<items> tables in the Koha
1681 database.
1682
1683 =cut
1684 #'
1685 sub itemnodata {
1686   my ($env,$dbh,$itemnumber) = @_;
1687   $dbh = C4::Context->dbh;
1688   my $sth=$dbh->prepare("Select * from biblio,items,biblioitems
1689     where items.itemnumber = ?
1690     and biblio.biblionumber = items.biblionumber
1691     and biblioitems.biblioitemnumber = items.biblioitemnumber");
1692 #  print $query;
1693   $sth->execute($itemnumber);
1694   my $data=$sth->fetchrow_hashref;
1695   $sth->finish;
1696   return($data);
1697 }
1698
1699 =item BornameSearch
1700
1701   ($count, $borrowers) = &BornameSearch($env, $searchstring, $type);
1702
1703 Looks up patrons (borrowers) by name.
1704
1705 C<$env> is ignored.
1706
1707 BUGFIX 499: C<$type> is now used to determine type of search.
1708 if $type is "simple", search is performed on the first letter of the
1709 surname only.
1710
1711 C<$searchstring> is a space-separated list of search terms. Each term
1712 must match the beginning a borrower's surname, first name, or other
1713 name.
1714
1715 C<&BornameSearch> returns a two-element list. C<$borrowers> is a
1716 reference-to-array; each element is a reference-to-hash, whose keys
1717 are the fields of the C<borrowers> table in the Koha database.
1718 C<$count> is the number of elements in C<$borrowers>.
1719
1720 =cut
1721 #'
1722 #used by member enquiries from the intranet
1723 #called by member.pl
1724 sub BornameSearch  {
1725         my ($env,$searchstring,$orderby,$type)=@_;
1726         my $dbh = C4::Context->dbh;
1727         my $query = ""; my $count; my @data;
1728         my @bind=();
1729
1730         if($type eq "simple")   # simple search for one letter only
1731         {
1732                 $query="Select * from borrowers where surname like ? order by $orderby";
1733                 @bind=("$searchstring%");
1734         }
1735         else    # advanced search looking in surname, firstname and othernames
1736         {
1737                 @data=split(' ',$searchstring);
1738                 $count=@data;
1739                 $query="Select * from borrowers
1740                 where ((surname like ? or surname like ?
1741                 or firstname  like ? or firstname like ?
1742                 or othernames like ? or othernames like ?)
1743                 ";
1744                 @bind=("$data[0]%","% $data[0]%","$data[0]%","% $data[0]%","$data[0]%","% $data[0]%");
1745                 for (my $i=1;$i<$count;$i++){
1746                         $query=$query." and (".
1747                         " surname like ? or surname like ?
1748                         or firstname  like ? or firstname like ?
1749                         or othernames like ? or othernames like ?)";
1750                         push(@bind,"$data[$i]%","% $data[$i]%","$data[$i]%","% $data[$i]%","$data[$i]%","% $data[$i]%");
1751                                         # FIXME - .= <<EOT;
1752                 }
1753                 $query=$query.") or cardnumber like ?
1754                 order by $orderby";
1755                 push(@bind,$searchstring);
1756                                         # FIXME - .= <<EOT;
1757         }
1758
1759         my $sth=$dbh->prepare($query);
1760 #       warn "Q $orderby : $query";
1761         $sth->execute(@bind);
1762         my @results;
1763         my $cnt=$sth->rows;
1764         while (my $data=$sth->fetchrow_hashref){
1765         push(@results,$data);
1766         }
1767         #  $sth->execute;
1768         $sth->finish;
1769         return ($cnt,\@results);
1770 }
1771
1772 =item borrdata
1773
1774   $borrower = &borrdata($cardnumber, $borrowernumber);
1775
1776 Looks up information about a patron (borrower) by either card number
1777 or borrower number. If $borrowernumber is specified, C<&borrdata>
1778 searches by borrower number; otherwise, it searches by card number.
1779
1780 C<&borrdata> returns a reference-to-hash whose keys are the fields of
1781 the C<borrowers> table in the Koha database.
1782
1783 =cut
1784 #'
1785 sub borrdata {
1786   my ($cardnumber,$bornum)=@_;
1787   $cardnumber = uc $cardnumber;
1788   my $dbh = C4::Context->dbh;
1789   my $sth;
1790   if ($bornum eq ''){
1791     $sth=$dbh->prepare("Select * from borrowers where cardnumber=?");
1792     $sth->execute($cardnumber);
1793   } else {
1794     $sth=$dbh->prepare("Select * from borrowers where borrowernumber=?");
1795   $sth->execute($bornum);
1796   }
1797   my $data=$sth->fetchrow_hashref;
1798   $sth->finish;
1799   if ($data) {
1800         return($data);
1801         } else { # try with firstname
1802                 if ($cardnumber) {
1803                         my $sth=$dbh->prepare("select * from borrowers where firstname=?");
1804                         $sth->execute($cardnumber);
1805                         my $data=$sth->fetchrow_hashref;
1806                         $sth->finish;
1807                         return($data);
1808                 }
1809         }
1810         return undef;
1811 }
1812
1813 =item borrissues
1814
1815   ($count, $issues) = &borrissues($borrowernumber);
1816
1817 Looks up what the patron with the given borrowernumber has borrowed.
1818
1819 C<&borrissues> returns a two-element array. C<$issues> is a
1820 reference-to-array, where each element is a reference-to-hash; the
1821 keys are the fields from the C<issues>, C<biblio>, and C<items> tables
1822 in the Koha database. C<$count> is the number of elements in
1823 C<$issues>.
1824
1825 =cut
1826 #'
1827 sub borrissues {
1828   my ($bornum)=@_;
1829   my $dbh = C4::Context->dbh;
1830   my $sth=$dbh->prepare("Select * from issues,biblio,items where borrowernumber=?
1831    and items.itemnumber=issues.itemnumber
1832         and items.biblionumber=biblio.biblionumber
1833         and issues.returndate is NULL order by date_due");
1834     $sth->execute($bornum);
1835   my @result;
1836   while (my $data = $sth->fetchrow_hashref) {
1837     push @result, $data;
1838   }
1839   $sth->finish;
1840   return(scalar(@result), \@result);
1841 }
1842
1843 =item allissues
1844
1845   ($count, $issues) = &allissues($borrowernumber, $sortkey, $limit);
1846
1847 Looks up what the patron with the given borrowernumber has borrowed,
1848 and sorts the results.
1849
1850 C<$sortkey> is the name of a field on which to sort the results. This
1851 should be the name of a field in the C<issues>, C<biblio>,
1852 C<biblioitems>, or C<items> table in the Koha database.
1853
1854 C<$limit> is the maximum number of results to return.
1855
1856 C<&allissues> returns a two-element array. C<$issues> is a
1857 reference-to-array, where each element is a reference-to-hash; the
1858 keys are the fields from the C<issues>, C<biblio>, C<biblioitems>, and
1859 C<items> tables of the Koha database. C<$count> is the number of
1860 elements in C<$issues>
1861
1862 =cut
1863 #'
1864 sub allissues {
1865   my ($bornum,$order,$limit)=@_;
1866   #FIXME: sanity-check order and limit
1867   my $dbh = C4::Context->dbh;
1868   my $query="Select * from issues,biblio,items,biblioitems
1869   where borrowernumber=? and
1870   items.biblioitemnumber=biblioitems.biblioitemnumber and
1871   items.itemnumber=issues.itemnumber and
1872   items.biblionumber=biblio.biblionumber order by $order";
1873   if ($limit !=0){
1874     $query.=" limit $limit";
1875   }
1876   #print $query;
1877   my $sth=$dbh->prepare($query);
1878   $sth->execute($bornum);
1879   my @result;
1880   my $i=0;
1881   while (my $data=$sth->fetchrow_hashref){
1882     $result[$i]=$data;;
1883     $i++;
1884   }
1885   $sth->finish;
1886   return($i,\@result);
1887 }
1888
1889 =item borrdata2
1890
1891   ($borrowed, $due, $fine) = &borrdata2($env, $borrowernumber);
1892
1893 Returns aggregate data about items borrowed by the patron with the
1894 given borrowernumber.
1895
1896 C<$env> is ignored.
1897
1898 C<&borrdata2> returns a three-element array. C<$borrowed> is the
1899 number of books the patron currently has borrowed. C<$due> is the
1900 number of overdue items the patron currently has borrowed. C<$fine> is
1901 the total fine currently due by the borrower.
1902
1903 =cut
1904 #'
1905 sub borrdata2 {
1906   my ($env,$bornum)=@_;
1907   my $dbh = C4::Context->dbh;
1908   my $query="Select count(*) from issues where borrowernumber='$bornum' and
1909     returndate is NULL";
1910     # print $query;
1911   my $sth=$dbh->prepare($query);
1912   $sth->execute;
1913   my $data=$sth->fetchrow_hashref;
1914   $sth->finish;
1915   $sth=$dbh->prepare("Select count(*) from issues where
1916     borrowernumber='$bornum' and date_due < now() and returndate is NULL");
1917   $sth->execute;
1918   my $data2=$sth->fetchrow_hashref;
1919   $sth->finish;
1920   $sth=$dbh->prepare("Select sum(amountoutstanding) from accountlines where
1921     borrowernumber='$bornum'");
1922   $sth->execute;
1923   my $data3=$sth->fetchrow_hashref;
1924   $sth->finish;
1925
1926 return($data2->{'count(*)'},$data->{'count(*)'},$data3->{'sum(amountoutstanding)'});
1927 }
1928
1929 =item getboracctrecord
1930
1931   ($count, $acctlines, $total) = &getboracctrecord($env, $borrowernumber);
1932
1933 Looks up accounting data for the patron with the given borrowernumber.
1934
1935 C<$env> is ignored.
1936
1937 (FIXME - I'm not at all sure what this is about.)
1938
1939 C<&getboracctrecord> returns a three-element array. C<$acctlines> is a
1940 reference-to-array, where each element is a reference-to-hash; the
1941 keys are the fields of the C<accountlines> table in the Koha database.
1942 C<$count> is the number of elements in C<$acctlines>. C<$total> is the
1943 total amount outstanding for all of the account lines.
1944
1945 =cut
1946 #'
1947 sub getboracctrecord {
1948    my ($env,$params) = @_;
1949    my $dbh = C4::Context->dbh;
1950    my @acctlines;
1951    my $numlines=0;
1952    my $sth=$dbh->prepare("Select * from accountlines where
1953 borrowernumber=? order by date desc,timestamp desc");
1954 #   print $query;
1955    $sth->execute($params->{'borrowernumber'});
1956    my $total=0;
1957    while (my $data=$sth->fetchrow_hashref){
1958    #FIXME before reinstating: insecure?
1959 #      if ($data->{'itemnumber'} ne ''){
1960 #        $query="Select * from items,biblio where items.itemnumber=
1961 #       '$data->{'itemnumber'}' and biblio.biblionumber=items.biblionumber";
1962 #       my $sth2=$dbh->prepare($query);
1963 #       $sth2->execute;
1964 #       my $data2=$sth2->fetchrow_hashref;
1965 #       $sth2->finish;
1966 #       $data=$data2;
1967  #     }
1968       $acctlines[$numlines] = $data;
1969       $numlines++;
1970       $total += $data->{'amountoutstanding'};
1971    }
1972    $sth->finish;
1973    return ($numlines,\@acctlines,$total);
1974 }
1975
1976 =item itemcount2
1977
1978   $counts = &itemcount2($env, $biblionumber, $type);
1979
1980 Counts the number of items with the given biblionumber, broken down by
1981 category.
1982
1983 C<$env> is ignored.
1984
1985 C<$type> may be either C<intra> or anything else. If it is not set to
1986 C<intra>, then the search will exclude lost, very overdue, and
1987 withdrawn items.
1988
1989 C<$&itemcount2> returns a reference-to-hash, with the following fields:
1990
1991 =over 4
1992
1993 =item C<total>
1994
1995 The total number of items with this biblionumber.
1996
1997 =item C<order>
1998
1999 The number of items on order (aqorders.quantity -
2000 aqorders.quantityreceived).
2001
2002 =item I<branchname>
2003
2004 For each branch that has at least one copy of the book, C<$counts>
2005 will have a key with the branch name, giving the number of copies at
2006 that branch.
2007
2008 =back
2009
2010 =cut
2011 #'
2012 sub itemcount2 {
2013   my ($env,$bibnum,$type)=@_;
2014   my $dbh = C4::Context->dbh;
2015   my $query="Select * from items,branches where
2016   biblionumber=? and items.holdingbranch=branches.branchcode";
2017   if ($type ne 'intra'){
2018     $query.=" and ((itemlost <>1 and itemlost <> 2) or itemlost is NULL) and
2019     (wthdrawn <> 1 or wthdrawn is NULL)";
2020   }
2021   my $sth=$dbh->prepare($query);
2022   #  print $query;
2023   $sth->execute($bibnum);
2024   my %counts;
2025   $counts{'total'}=0;
2026   while (my $data=$sth->fetchrow_hashref){
2027     $counts{'total'}++;
2028
2029     my $status;
2030     for my $test (
2031       [
2032         'Item Lost',
2033         'select * from items
2034           where itemnumber=?
2035             and not ((items.itemlost <>1 and items.itemlost <> 2)
2036                       or items.itemlost is NULL)'
2037       ], [
2038         'Withdrawn',
2039         'select * from items
2040           where itemnumber=? and not (wthdrawn <> 1 or wthdrawn is NULL)'
2041       ], [
2042         'On Loan', "select * from issues,items
2043           where issues.itemnumber=? and returndate is NULL
2044             and items.itemnumber=issues.itemnumber"
2045       ],
2046     ) {
2047         my($testlabel, $query2) = @$test;
2048
2049         my $sth2=$dbh->prepare($query2);
2050         $sth2->execute($data->{'itemnumber'});
2051
2052         # FIXME - fetchrow_hashref() can fail for any number of reasons
2053         # (e.g., a database server crash). Perhaps use a left join of some
2054         # sort for this?
2055         $status = $testlabel if $sth2->fetchrow_hashref;
2056         $sth2->finish;
2057     last if defined $status;
2058     }
2059     $status = $data->{'branchname'} unless defined $status;
2060     $counts{$status}++;
2061   }
2062   my $sth2=$dbh->prepare("Select * from aqorders where biblionumber=? and
2063   datecancellationprinted is NULL and quantity > quantityreceived");
2064   $sth2->execute($bibnum);
2065   if (my $data=$sth2->fetchrow_hashref){
2066       $counts{'order'}=$data->{'quantity'} - $data->{'quantityreceived'};
2067   }
2068   $sth2->finish;
2069   $sth->finish;
2070   return (\%counts);
2071 }
2072
2073 =item ItemType
2074
2075   $description = &ItemType($itemtype);
2076
2077 Given an item type code, returns the description for that type.
2078
2079 =cut
2080 #'
2081
2082 # FIXME - I'm pretty sure that after the initial setup, the list of
2083 # item types doesn't change very often. Hence, it seems slow and
2084 # inefficient to make yet another database call to look up information
2085 # that'll only change every few months or years.
2086 #
2087 # Much better, I think, to automatically build a Perl file that can be
2088 # included in those scripts that require it, e.g.:
2089 #       @itemtypes = qw( ART BCD CAS CD F ... );
2090 #       %itemtypedesc = (
2091 #               ART     => "Art Prints",
2092 #               BCD     => "CD-ROM from book",
2093 #               CD      => "Compact disc (WN)",
2094 #               F       => "Free Fiction",
2095 #               ...
2096 #       );
2097 # The web server can then run a cron job to rebuild this file from the
2098 # database every hour or so.
2099 #
2100 # The same thing goes for branches, book funds, book sellers, currency
2101 # rates, printers, stopwords, and perhaps others.
2102 sub ItemType {
2103   my ($type)=@_;
2104   my $dbh = C4::Context->dbh;
2105   my $sth=$dbh->prepare("select description from itemtypes where itemtype=?");
2106   $sth->execute($type);
2107   my $dat=$sth->fetchrow_hashref;
2108   $sth->finish;
2109   return ($dat->{'description'});
2110 }
2111
2112 =item bibitems
2113
2114   ($count, @results) = &bibitems($biblionumber);
2115
2116 Given the biblionumber for a book, C<&bibitems> looks up that book's
2117 biblioitems (different publications of the same book, the audio book
2118 and film versions, etc.).
2119
2120 C<$count> is the number of elements in C<@results>.
2121
2122 C<@results> is an array of references-to-hash; the keys are the fields
2123 of the C<biblioitems> and C<itemtypes> tables of the Koha database. In
2124 addition, C<itemlost> indicates the availability of the item: if it is
2125 "2", then all copies of the item are long overdue; if it is "1", then
2126 all copies are lost; otherwise, there is at least one copy available.
2127
2128 =cut
2129 #'
2130 sub bibitems {
2131     my ($bibnum) = @_;
2132     my $dbh   = C4::Context->dbh;
2133     my $sth   = $dbh->prepare("SELECT biblioitems.*,
2134                         itemtypes.*,
2135                         MIN(items.itemlost)        as itemlost,
2136                         MIN(items.dateaccessioned) as dateaccessioned
2137                           FROM biblioitems, itemtypes, items
2138                          WHERE biblioitems.biblionumber     = ?
2139                            AND biblioitems.itemtype         = itemtypes.itemtype
2140                            AND biblioitems.biblioitemnumber = items.biblioitemnumber
2141                       GROUP BY items.biblioitemnumber");
2142     my $count = 0;
2143     my @results;
2144     $sth->execute($bibnum);
2145     while (my $data = $sth->fetchrow_hashref) {
2146         $results[$count] = $data;
2147         $count++;
2148     } # while
2149     $sth->finish;
2150     return($count, @results);
2151 } # sub bibitems
2152
2153 =item barcodes
2154
2155   @barcodes = &barcodes($biblioitemnumber);
2156
2157 Given a biblioitemnumber, looks up the corresponding items.
2158
2159 Returns an array of references-to-hash; the keys are C<barcode> and
2160 C<itemlost>.
2161
2162 The returned items include very overdue items, but not lost ones.
2163
2164 =cut
2165 #'
2166 sub barcodes{
2167     #called from request.pl
2168     my ($biblioitemnumber)=@_;
2169     my $dbh = C4::Context->dbh;
2170     my $sth=$dbh->prepare("SELECT barcode, itemlost, holdingbranch FROM items
2171                            WHERE biblioitemnumber = ?
2172                              AND (wthdrawn <> 1 OR wthdrawn IS NULL)");
2173     $sth->execute($biblioitemnumber);
2174     my @barcodes;
2175     my $i=0;
2176     while (my $data=$sth->fetchrow_hashref){
2177         $barcodes[$i]=$data;
2178         $i++;
2179     }
2180     $sth->finish;
2181     return(@barcodes);
2182 }
2183
2184 =item getwebsites
2185
2186   ($count, @websites) = &getwebsites($biblionumber);
2187
2188 Looks up the web sites pertaining to the book with the given
2189 biblionumber.
2190
2191 C<$count> is the number of elements in C<@websites>.
2192
2193 C<@websites> is an array of references-to-hash; the keys are the
2194 fields from the C<websites> table in the Koha database.
2195
2196 =cut
2197 #'
2198 sub getwebsites {
2199     my ($biblionumber) = @_;
2200     my $dbh   = C4::Context->dbh;
2201     my $sth   = $dbh->prepare("Select * from websites where biblionumber = ?");
2202     my $count = 0;
2203     my @results;
2204
2205     $sth->execute($biblionumber);
2206     while (my $data = $sth->fetchrow_hashref) {
2207         # FIXME - The URL scheme shouldn't be stripped off, at least
2208         # not here, since it's part of the URL, and will be useful in
2209         # constructing a link to the site. If you don't want the user
2210         # to see the "http://" part, strip that off when building the
2211         # HTML code.
2212         $data->{'url'} =~ s/^http:\/\///;       # FIXME - Leaning toothpick
2213                                                 # syndrome
2214         $results[$count] = $data;
2215         $count++;
2216     } # while
2217
2218     $sth->finish;
2219     return($count, @results);
2220 } # sub getwebsites
2221
2222 =item getwebbiblioitems
2223
2224   ($count, @results) = &getwebbiblioitems($biblionumber);
2225
2226 Given a book's biblionumber, looks up the web versions of the book
2227 (biblioitems with itemtype C<WEB>).
2228
2229 C<$count> is the number of items in C<@results>. C<@results> is an
2230 array of references-to-hash; the keys are the items from the
2231 C<biblioitems> table of the Koha database.
2232
2233 =cut
2234 #'
2235 sub getwebbiblioitems {
2236     my ($biblionumber) = @_;
2237     my $dbh   = C4::Context->dbh;
2238     my $sth   = $dbh->prepare("Select * from biblioitems where biblionumber = ?
2239 and itemtype = 'WEB'");
2240     my $count = 0;
2241     my @results;
2242
2243     $sth->execute($biblionumber);
2244     while (my $data = $sth->fetchrow_hashref) {
2245         $data->{'url'} =~ s/^http:\/\///;
2246         $results[$count] = $data;
2247         $count++;
2248     } # while
2249
2250     $sth->finish;
2251     return($count, @results);
2252 } # sub getwebbiblioitems
2253
2254
2255
2256 =item isbnsearch
2257
2258   ($count, @results) = &isbnsearch($isbn,$title);
2259
2260 Given an isbn and/or a title, returns the biblios having it.
2261 Used in acqui.simple, isbnsearch.pl only
2262
2263 C<$count> is the number of items in C<@results>. C<@results> is an
2264 array of references-to-hash; the keys are the items from the
2265 C<biblioitems> table of the Koha database.
2266
2267 =cut
2268
2269 sub isbnsearch {
2270     my ($isbn,$title) = @_;
2271     my $dbh   = C4::Context->dbh;
2272     my $count = 0;
2273     my ($query,@bind);
2274     my $sth;
2275     my @results;
2276
2277     $query = "Select distinct biblio.*, biblioitems.classification from biblio, biblioitems where
2278                                 biblio.biblionumber = biblioitems.biblionumber";
2279         @bind=();
2280         if ($isbn) {
2281                 $query .= " and isbn like ?";
2282                 @bind=(uc($isbn)."%");
2283         }
2284         if ($title) {
2285                 $query .= " and title like ?";
2286                 @bind=($title."%");
2287         }
2288     $sth   = $dbh->prepare($query);
2289
2290     $sth->execute(@bind);
2291     while (my $data = $sth->fetchrow_hashref) {
2292         $results[$count] = $data;
2293         $count++;
2294     } # while
2295
2296     $sth->finish;
2297     return($count, @results);
2298 } # sub isbnsearch
2299
2300 =item getbranchname
2301
2302   $branchname = &getbranchname($branchcode);
2303
2304 Given the branch code, the function returns the corresponding
2305 branch name for a comprehensive information display
2306
2307 =cut
2308
2309 sub getbranchname
2310 {
2311         my ($branchcode) = @_;
2312         my $dbh = C4::Context->dbh;
2313         my $sth = $dbh->prepare("SELECT branchname FROM branches WHERE branchcode = ?");
2314         $sth->execute($branchcode);
2315         my $branchname = $sth->fetchrow();
2316         $sth->finish();
2317         return $branchname;
2318 } # sub getbranchname
2319
2320 =item getborrowercategory
2321
2322   $description = &getborrowercategory($categorycode);
2323
2324 Given the borrower's category code, the function returns the corresponding
2325 description for a comprehensive information display.
2326
2327 =cut
2328
2329 sub getborrowercategory
2330 {
2331         my ($catcode) = @_;
2332         my $dbh = C4::Context->dbh;
2333         my $sth = $dbh->prepare("SELECT description FROM categories WHERE categorycode = ?");
2334         $sth->execute($catcode);
2335         my $description = $sth->fetchrow();
2336         $sth->finish();
2337         return $description;
2338 } # sub getborrowercategory
2339
2340
2341 END { }       # module clean-up code here (global destructor)
2342
2343 1;
2344 __END__
2345
2346 =back
2347
2348 =head1 AUTHOR
2349
2350 Koha Developement team <info@koha.org>
2351
2352 =cut