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