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