C4/Search.pm

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