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