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