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