Adding 2 new fields, called "sort1" and "sort2"
[koha.git] / C4 / Catalogue.pm
1 package C4::Catalogue;
2
3 # Continue working on updateItem!!!!!!
4 #
5 # updateItem is looking not bad.  Need to add addSubfield and deleteSubfield
6 # functions
7 #
8 # Trying to track down $dbh's that aren't disconnected....
9
10
11 # Copyright 2000-2002 Katipo Communications
12 #
13 # This file is part of Koha.
14 #
15 # Koha is free software; you can redistribute it and/or modify it under the
16 # terms of the GNU General Public License as published by the Free Software
17 # Foundation; either version 2 of the License, or (at your option) any later
18 # version.
19 #
20 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
21 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
22 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
23 #
24 # You should have received a copy of the GNU General Public License along with
25 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
26 # Suite 330, Boston, MA  02111-1307 USA
27
28 use strict;
29 require Exporter;
30 use C4::Context;
31 use MARC::Record;
32 use C4::Biblio;
33
34 use vars qw($VERSION @ISA @EXPORT);
35
36 # set the version for version checking
37 $VERSION = 0.01;
38
39 =head1 NAME
40
41 C4::Catalogue - Koha functions for dealing with orders and acquisitions
42
43 =head1 SYNOPSIS
44
45   use C4::Catalogue;
46
47 =head1 DESCRIPTION
48
49 The functions in this module deal with acquisitions, managing book
50 orders, converting money to different currencies, and so forth.
51
52 =head1 FUNCTIONS
53
54 =over 2
55
56 =cut
57
58 @ISA = qw(Exporter);
59 @EXPORT = qw(
60              &basket &newbasket
61
62              &getorders &getallorders &getrecorders
63              &getorder &neworder &delorder
64              &ordersearch
65              &modorder &getsingleorder &invoice &receiveorder
66              &updaterecorder &newordernum
67
68              &bookfunds &bookfundbreakdown &updatecost
69              &curconvert &getcurrencies &updatecurrencies &getcurrency
70
71              &findall &needsmod &branches &updatesup &insertsup
72              &bookseller &breakdown &checkitems
73              &websitesearch &addwebsite &updatewebsite &deletewebsite
74 );
75
76 #
77 #
78 #
79 # BASKETS
80 #
81 #
82 #
83 =item basket
84
85   ($count, @orders) = &basket($basketnumber, $booksellerID);
86
87 Looks up the pending (non-cancelled) orders with the given basket
88 number. If C<$booksellerID> is non-empty, only orders from that seller
89 are returned.
90
91 C<&basket> returns a two-element array. C<@orders> is an array of
92 references-to-hash, whose keys are the fields from the aqorders,
93 biblio, and biblioitems tables in the Koha database. C<$count> is the
94 number of elements in C<@orders>.
95
96 =cut
97 #'
98 sub basket {
99   my ($basketno,$supplier)=@_;
100   my $dbh = C4::Context->dbh;
101   my $query="Select *,biblio.title from aqorders,biblio,biblioitems
102   where basketno='$basketno'
103   and biblio.biblionumber=aqorders.biblionumber and biblioitems.biblioitemnumber
104   =aqorders.biblioitemnumber
105   and (datecancellationprinted is NULL or datecancellationprinted =
106   '0000-00-00')";
107   if ($supplier ne ''){
108     $query.=" and aqorders.booksellerid='$supplier'";
109   }
110   $query.=" order by biblioitems.publishercode";
111   my $sth=$dbh->prepare($query);
112   $sth->execute;
113   my @results;
114 #  print $query;
115   my $i=0;
116   while (my $data=$sth->fetchrow_hashref){
117     $results[$i]=$data;
118     $i++;
119   }
120   $sth->finish;
121   return($i,@results);
122 }
123
124 =item newbasket
125
126   $basket = &newbasket();
127
128 Finds the next unused basket number in the aqorders table of the Koha
129 database, and returns it.
130
131 =cut
132 #'
133 # FIXME - There's a race condition here:
134 #       A calls &newbasket
135 #       B calls &newbasket (gets the same number as A)
136 #       A updates the basket
137 #       B updates the basket, and clobbers A's result.
138 # A better approach might be to create a dummy order (with, say,
139 # requisitionedby == "Dummy-$$" or notes == "dummy <time> <pid>"), and
140 # see which basket number it gets. Then have a cron job periodically
141 # remove out-of-date dummy orders.
142 sub newbasket {
143   my $dbh = C4::Context->dbh;
144   my $sth=$dbh->prepare("Select max(basketno) from aqorders");
145   $sth->execute;
146   my $data=$sth->fetchrow_arrayref;
147   my $basket=$$data[0];
148   $basket++;
149   $sth->finish;
150   return($basket);
151 }
152
153 =item neworder
154
155   &neworder($biblionumber, $title, $ordnum, $basket, $quantity, $listprice,
156         $booksellerid, $who, $notes, $bookfund, $biblioitemnumber, $rrp,
157         $ecost, $gst, $budget, $unitprice, $subscription,
158         $booksellerinvoicenumber);
159
160 Adds a new order to the database. Any argument that isn't described
161 below is the new value of the field with the same name in the aqorders
162 table of the Koha database.
163
164 C<$ordnum> is a "minimum order number." After adding the new entry to
165 the aqorders table, C<&neworder> finds the first entry in aqorders
166 with order number greater than or equal to C<$ordnum>, and adds an
167 entry to the aqorderbreakdown table, with the order number just found,
168 and the book fund ID of the newly-added order.
169
170 C<$budget> is effectively ignored.
171
172 C<$subscription> may be either "yes", or anything else for "no".
173
174 =cut
175 #'
176 sub neworder {
177   my ($bibnum,$title,$ordnum,$basket,$quantity,$listprice,$supplier,$who,$notes,$bookfund,$bibitemnum,$rrp,$ecost,$gst,$budget,$cost,$sub,$invoice,$sort1,$sort2)=@_;
178   if ($budget eq 'now'){
179     $budget="now()";
180   } else {
181     $budget="'2001-07-01'";
182   }
183   if ($sub eq 'yes'){
184     $sub=1;
185   } else {
186     $sub=0;
187   }
188   my $dbh = C4::Context->dbh;
189   my $sth=$dbh->prepare("insert into aqorders (biblionumber,title,basketno,
190   quantity,listprice,booksellerid,entrydate,requisitionedby,authorisedby,notes,
191   biblioitemnumber,rrp,ecost,gst,unitprice,subscription,booksellerinvoicenumber,sort1,sort2)
192   values (?,?,?,?,?,?,now(),?,?,?,?,?,?,?,?,?,?,?,?)");
193   $sth->execute($bibnum,$title,$basket,$quantity,$listprice,$supplier,
194   $who,$who,$notes,$bibitemnum,$rrp,$ecost,$gst,$cost,
195   $sub,$invoice,$sort1,$sort2);
196   $sth->finish;
197   $sth=$dbh->prepare("select * from aqorders where
198   biblionumber=? and basketno=? and ordernumber >=?");
199   $sth->execute($bibnum,$basket,$ordnum);
200   my $data=$sth->fetchrow_hashref;
201   $sth->finish;
202   $ordnum=$data->{'ordernumber'};
203   $sth=$dbh->prepare("insert into aqorderbreakdown (ordernumber,bookfundid) values
204   (?,?)");
205 #  print $query;
206   $sth->execute($ordnum,$bookfund);
207   $sth->finish;
208 }
209
210 =item delorder
211
212   &delorder($biblionumber, $ordernumber);
213
214 Cancel the order with the given order and biblio numbers. It does not
215 delete any entries in the aqorders table, it merely marks them as
216 cancelled.
217
218 If there are no items remaining with the given biblionumber,
219 C<&delorder> also deletes them from the marc_subfield_table and
220 marc_biblio tables of the Koha database.
221
222 =cut
223 #'
224 sub delorder {
225   my ($bibnum,$ordnum)=@_;
226   my $dbh = C4::Context->dbh;
227   my $sth=$dbh->prepare("update aqorders set datecancellationprinted=now()
228   where biblionumber=? and ordernumber=?");
229   $sth->execute($bibnum,$ordnum);
230   $sth->finish;
231   my $count=itemcount($bibnum);
232   if ($count == 0){
233     delbiblio($bibnum);
234   }
235 }
236
237 =item modorder
238
239   &modorder($title, $ordernumber, $quantity, $listprice,
240         $biblionumber, $basketno, $supplier, $who, $notes,
241         $bookfundid, $bibitemnum, $rrp, $ecost, $gst, $budget,
242         $unitprice, $booksellerinvoicenumber);
243
244 Modifies an existing order. Updates the order with order number
245 C<$ordernumber> and biblionumber C<$biblionumber>. All other arguments
246 update the fields with the same name in the aqorders table of the Koha
247 database.
248
249 Entries with order number C<$ordernumber> in the aqorderbreakdown
250 table are also updated to the new book fund ID.
251
252 =cut
253 #'
254 sub modorder {
255   my ($title,$ordnum,$quantity,$listprice,$bibnum,$basketno,$supplier,$who,$notes,$bookfund,$bibitemnum,$rrp,$ecost,$gst,$budget,$cost,$invoice,$sort1,$sort2)=@_;
256   my $dbh = C4::Context->dbh;
257   my $sth=$dbh->prepare("update aqorders set title=?,
258   quantity=?,listprice=?,basketno=?,
259   rrp=?,ecost=?,unitprice=?,
260   booksellerinvoicenumber=?,
261   sort1=?, sort2=?
262   where
263   ordernumber=? and biblionumber=?");
264   $sth->execute($title,$quantity,$listprice,$basketno,$rrp,$ecost,$cost,$invoice,$sort1,$sort2,$ordnum,$bibnum);
265   $sth->finish;
266   $sth=$dbh->prepare("update aqorderbreakdown set bookfundid=? where
267   ordernumber=?");
268   if ($sth->execute($bookfund,$ordnum) == 0) { # zero rows affected [Bug 734]
269     my $query="insert into aqorderbreakdown (ordernumber,bookfundid) values (?,?)";
270     $sth=$dbh->prepare($query);
271     $sth->execute($ordnum,$bookfund);
272   }
273   $sth->finish;
274 }
275
276 =item newordernum
277
278   $order = &newordernum();
279
280 Finds the next unused order number in the aqorders table of the Koha
281 database, and returns it.
282
283 =cut
284 #'
285 # FIXME - Race condition
286 sub newordernum {
287   my $dbh = C4::Context->dbh;
288   my $sth=$dbh->prepare("Select max(ordernumber) from aqorders");
289   $sth->execute;
290   my $data=$sth->fetchrow_arrayref;
291   my $ordnum=$$data[0];
292   $ordnum++;
293   $sth->finish;
294   return($ordnum);
295 }
296
297 =item receiveorder
298
299   &receiveorder($biblionumber, $ordernumber, $quantityreceived, $user,
300         $unitprice, $booksellerinvoicenumber, $biblioitemnumber,
301         $freight, $bookfund, $rrp);
302
303 Updates an order, to reflect the fact that it was received, at least
304 in part. All arguments not mentioned below update the fields with the
305 same name in the aqorders table of the Koha database.
306
307 Updates the order with bibilionumber C<$biblionumber> and ordernumber
308 C<$ordernumber>.
309
310 Also updates the book fund ID in the aqorderbreakdown table.
311
312 =cut
313 #'
314 sub receiveorder {
315   my ($biblio,$ordnum,$quantrec,$user,$cost,$invoiceno,$bibitemno,$freight,$bookfund,$rrp)=@_;
316   my $dbh = C4::Context->dbh;
317   my $sth=$dbh->prepare("update aqorders set quantityreceived=?,datereceived=now(),booksellerinvoicenumber=?,
318                                                                                 biblioitemnumber=?,unitprice=?,freight=?,rrp=?
319                                                 where biblionumber=? and ordernumber=?");
320   $sth->execute($quantrec,$invoiceno,$bibitemno,$cost,$freight,$rrp,$biblio,$ordnum);
321   $sth->finish;
322   $sth=$dbh->prepare("update aqorderbreakdown set bookfundid=? where
323   ordernumber=?");
324   $sth->execute($bookfund,$ordnum);
325   $sth->finish;
326 }
327
328 =item updaterecorder
329
330   &updaterecorder($biblionumber, $ordernumber, $user, $unitprice,
331         $bookfundid, $rrp);
332
333 Updates the order with biblionumber C<$biblionumber> and order number
334 C<$ordernumber>. C<$bookfundid> is the new value for the book fund ID
335 in the aqorderbreakdown table of the Koha database. All other
336 arguments update the fields with the same name in the aqorders table.
337
338 C<$user> is ignored.
339
340 =cut
341 #'
342 sub updaterecorder{
343   my($biblio,$ordnum,$user,$cost,$bookfund,$rrp)=@_;
344   my $dbh = C4::Context->dbh;
345   my $sth=$dbh->prepare("update aqorders set
346   unitprice=?, rrp=?
347   where biblionumber=? and ordernumber=?
348   ");
349   $sth->execute($cost,$rrp,$biblio,$ordnum);
350   $sth->finish;
351   $sth=$dbh->prepare("update aqorderbreakdown set bookfundid=? where ordernumber=?");
352   $sth->execute($bookfund,$ordnum);
353   $sth->finish;
354 }
355
356 #
357 #
358 # ORDERS
359 #
360 #
361
362 =item getorders
363
364   ($count, $orders) = &getorders($booksellerid);
365
366 Finds pending orders from the bookseller with the given ID. Ignores
367 completed and cancelled orders.
368
369 C<$count> is the number of elements in C<@{$orders}>.
370
371 C<$orders> is a reference-to-array; each element is a
372 reference-to-hash with the following fields:
373
374 =over 4
375
376 =item C<count(*)>
377
378 Gives the number of orders in with this basket number.
379
380 =item C<authorizedby>
381
382 =item C<entrydate>
383
384 =item C<basketno>
385
386 These give the value of the corresponding field in the aqorders table
387 of the Koha database.
388
389 =back
390
391 Results are ordered from most to least recent.
392
393 =cut
394 #'
395 sub getorders {
396   my ($supplierid)=@_;
397   my $dbh = C4::Context->dbh;
398   my $sth=$dbh->prepare("Select count(*),authorisedby,entrydate,basketno from aqorders where
399   booksellerid=? and (quantity > quantityreceived or
400   quantityreceived is NULL)
401   and (datecancellationprinted is NULL or datecancellationprinted = '0000-00-00')
402    group by basketno order by entrydate desc");
403   $sth->execute($supplierid);
404   my @results = ();
405   while (my $data=$sth->fetchrow_hashref){
406     push(@results,$data);
407   }
408   $sth->finish;
409   return (scalar(@results),\@results);
410 }
411
412 =item getorder
413
414   ($order, $ordernumber) = &getorder($biblioitemnumber, $biblionumber);
415
416 Looks up the order with the given biblionumber and biblioitemnumber.
417
418 Returns a two-element array. C<$ordernumber> is the order number.
419 C<$order> is a reference-to-hash describing the order; its keys are
420 fields from the biblio, biblioitems, aqorders, and aqorderbreakdown
421 tables of the Koha database.
422
423 =cut
424 #'
425 # FIXME - This is effectively identical to &C4::Biblio::getorder.
426 # Pick one and stick with it.
427 sub getorder{
428   my ($bi,$bib)=@_;
429   my $dbh = C4::Context->dbh;
430   my $sth=$dbh->prepare("Select ordernumber from aqorders where biblionumber=? and biblioitemnumber=?");
431   $sth->execute($bib,$bi);
432   # FIXME - Use fetchrow_array(), since we're only interested in the one
433   # value.
434   my $ordnum=$sth->fetchrow_hashref;
435   $sth->finish;
436   my $order=getsingleorder($ordnum->{'ordernumber'});
437   return ($order,$ordnum->{'ordernumber'});
438 }
439
440 =item getsingleorder
441
442   $order = &getsingleorder($ordernumber);
443
444 Looks up an order by order number.
445
446 Returns a reference-to-hash describing the order. The keys of
447 C<$order> are fields from the biblio, biblioitems, aqorders, and
448 aqorderbreakdown tables of the Koha database.
449
450 =cut
451 #'
452 # FIXME - This is effectively identical to
453 # &C4::Biblio::getsingleorder.
454 # Pick one and stick with it.
455 sub getsingleorder {
456   my ($ordnum)=@_;
457   my $dbh = C4::Context->dbh;
458   my $sth=$dbh->prepare("Select * from biblio,biblioitems,aqorders left join aqorderbreakdown
459   on aqorders.ordernumber=aqorderbreakdown.ordernumber
460   where aqorders.ordernumber=?
461   and biblio.biblionumber=aqorders.biblionumber and
462   biblioitems.biblioitemnumber=aqorders.biblioitemnumber");
463   $sth->execute($ordnum);
464   my $data=$sth->fetchrow_hashref;
465   $sth->finish;
466   return($data);
467 }
468
469 =item getallorders
470
471   ($count, @results) = &getallorders($booksellerid);
472
473 Looks up all of the pending orders from the supplier with the given
474 bookseller ID. Ignores cancelled and completed orders.
475
476 C<$count> is the number of elements in C<@results>. C<@results> is an
477 array of references-to-hash. The keys of each element are fields from
478 the aqorders, biblio, and biblioitems tables of the Koha database.
479
480 C<@results> is sorted alphabetically by book title.
481
482 =cut
483 #'
484 sub getallorders {
485   #gets all orders from a certain supplier, orders them alphabetically
486   my ($supid)=@_;
487   my $dbh = C4::Context->dbh;
488   my @results = ();
489   my $sth=$dbh->prepare("Select * from aqorders,biblio,biblioitems where booksellerid=?
490   and (cancelledby is NULL or cancelledby = '')
491   and (quantityreceived < quantity or quantityreceived is NULL)
492   and biblio.biblionumber=aqorders.biblionumber and biblioitems.biblioitemnumber=
493   aqorders.biblioitemnumber
494   group by aqorders.biblioitemnumber
495   order by
496   biblio.title");
497   $sth->execute($supid);
498   while (my $data=$sth->fetchrow_hashref){
499     push(@results,$data);
500   }
501   $sth->finish;
502   return(scalar(@results),@results);
503 }
504
505 # FIXME - Never used
506 sub getrecorders {
507   #gets all orders from a certain supplier, orders them alphabetically
508   my ($supid)=@_;
509   my $dbh = C4::Context->dbh;
510   my @results= ();
511   my $sth=$dbh->prepare("Select * from aqorders,biblio,biblioitems where booksellerid=?
512   and (cancelledby is NULL or cancelledby = '')
513   and biblio.biblionumber=aqorders.biblionumber and biblioitems.biblioitemnumber=
514   aqorders.biblioitemnumber and
515   aqorders.quantityreceived>0
516   and aqorders.datereceived >=now()
517   group by aqorders.biblioitemnumber
518   order by
519   biblio.title");
520   $sth->execute($supid);
521   while (my $data=$sth->fetchrow_hashref){
522     push(@results,$data);
523   }
524   $sth->finish;
525   return(scalar(@results),@results);
526 }
527
528 =item ordersearch
529
530   ($count, @results) = &ordersearch($search, $biblionumber, $complete);
531
532 Searches for orders.
533
534 C<$search> may take one of several forms: if it is an ISBN,
535 C<&ordersearch> returns orders with that ISBN. If C<$search> is an
536 order number, C<&ordersearch> returns orders with that order number
537 and biblionumber C<$biblionumber>. Otherwise, C<$search> is considered
538 to be a space-separated list of search terms; in this case, all of the
539 terms must appear in the title (matching the beginning of title
540 words).
541
542 If C<$complete> is C<yes>, the results will include only completed
543 orders. In any case, C<&ordersearch> ignores cancelled orders.
544
545 C<&ordersearch> returns an array. C<$count> is the number of elements
546 in C<@results>. C<@results> is an array of references-to-hash with the
547 following keys:
548
549 =over 4
550
551 =item C<author>
552
553 =item C<seriestitle>
554
555 =item C<branchcode>
556
557 =item C<bookfundid>
558
559 =back
560
561 =cut
562 #'
563 sub ordersearch {
564         my ($search,$id,$biblio,$catview) = @_;
565         my $dbh   = C4::Context->dbh;
566         my @data  = split(' ',$search);
567         my @searchterms = ($id);
568         map { push(@searchterms,"$_%","% $_%") } @data;
569         push(@searchterms,$search,$search,$biblio);
570         my $sth=$dbh->prepare("Select *,biblio.title from aqorders,biblioitems,biblio
571                 where aqorders.biblioitemnumber = biblioitems.biblioitemnumber
572                 and aqorders.booksellerid = ?
573                 and biblio.biblionumber=aqorders.biblionumber
574                 and ((datecancellationprinted is NULL)
575                 or (datecancellationprinted = '0000-00-00'))
576                 and (("
577                 .(join(" and ",map { "(biblio.title like ? or biblio.title like ?)" } @data))
578                 .") or biblioitems.isbn=? or (aqorders.ordernumber=? and aqorders.biblionumber=?)) "
579                 .(($catview ne 'yes')?" and (quantityreceived < quantity or quantityreceived is NULL)":"")
580                 ." group by aqorders.ordernumber");
581         $sth->execute(@searchterms);
582         my @results = ();
583         my $sth2=$dbh->prepare("Select * from biblio where biblionumber=?");
584         my $sth3=$dbh->prepare("Select * from aqorderbreakdown where ordernumber=?");
585         while (my $data=$sth->fetchrow_hashref){
586                 $sth2->execute($data->{'biblionumber'});
587                 my $data2=$sth2->fetchrow_hashref;
588                 $data->{'author'}=$data2->{'author'};
589                 $data->{'seriestitle'}=$data2->{'seriestitle'};
590                 $sth3->execute($data->{'ordernumber'});
591                 my $data3=$sth3->fetchrow_hashref;
592                 $data->{'branchcode'}=$data3->{'branchcode'};
593                 $data->{'bookfundid'}=$data3->{'bookfundid'};
594                 push(@results,$data);
595         }
596         $sth->finish;
597         $sth2->finish;
598         $sth3->finish;
599         return(scalar(@results),@results);
600 }
601
602 #
603 #
604 # MONEY
605 #
606 #
607 =item invoice
608
609   ($count, @results) = &invoice($booksellerinvoicenumber);
610
611 Looks up orders by invoice number.
612
613 Returns an array. C<$count> is the number of elements in C<@results>.
614 C<@results> is an array of references-to-hash; the keys of each
615 elements are fields from the aqorders, biblio, and biblioitems tables
616 of the Koha database.
617
618 =cut
619 #'
620 sub invoice {
621   my ($invoice)=@_;
622   my $dbh = C4::Context->dbh;
623   my @results = ();
624   my $sth=$dbh->prepare("Select * from aqorders,biblio,biblioitems where
625   booksellerinvoicenumber=?
626   and biblio.biblionumber=aqorders.biblionumber and biblioitems.biblioitemnumber=
627   aqorders.biblioitemnumber group by aqorders.ordernumber,aqorders.biblioitemnumber");
628   $sth->execute($invoice);
629   while (my $data=$sth->fetchrow_hashref){
630     push(@results,$data);
631   }
632   $sth->finish;
633   return(scalar(@results),@results);
634 }
635
636 =item bookfunds
637
638   ($count, @results) = &bookfunds();
639
640 Returns a list of all book funds.
641
642 C<$count> is the number of elements in C<@results>. C<@results> is an
643 array of references-to-hash, whose keys are fields from the aqbookfund
644 and aqbudget tables of the Koha database. Results are ordered
645 alphabetically by book fund name.
646
647 =cut
648 #'
649 sub bookfunds {
650   my $dbh = C4::Context->dbh;
651   my $sth=$dbh->prepare("Select * from aqbookfund,aqbudget where aqbookfund.bookfundid
652   =aqbudget.bookfundid
653   group by aqbookfund.bookfundid order by bookfundname");
654   $sth->execute;
655   my @results = ();
656   while (my $data=$sth->fetchrow_hashref){
657     push(@results,$data);
658   }
659   $sth->finish;
660   return(scalar(@results),@results);
661 }
662
663 # FIXME - POD. I can't figure out what this function is doing. Then
664 # again, I don't think it's being used (anymore).
665 sub bookfundbreakdown {
666   my ($id)=@_;
667   my $dbh = C4::Context->dbh;
668   my $sth=$dbh->prepare("Select quantity,datereceived,freight,unitprice,listprice,ecost,quantityreceived,subscription
669   from aqorders,aqorderbreakdown where bookfundid=? and
670   aqorders.ordernumber=aqorderbreakdown.ordernumber
671   and (datecancellationprinted is NULL or
672   datecancellationprinted='0000-00-00')");
673   $sth->execute($id);
674   my $comtd=0;
675   my $spent=0;
676   while (my $data=$sth->fetchrow_hashref){
677     if ($data->{'subscription'} == 1){
678       $spent+=$data->{'quantity'}*$data->{'unitprice'};
679     } else {
680       my $leftover=$data->{'quantity'}-$data->{'quantityreceived'};
681       $comtd+=($data->{'ecost'})*$leftover;
682       $spent+=($data->{'unitprice'})*$data->{'quantityreceived'};
683     }
684   }
685   $sth->finish;
686   return($spent,$comtd);
687 }
688
689 =item curconvert
690
691   $foreignprice = &curconvert($currency, $localprice);
692
693 Converts the price C<$localprice> to foreign currency C<$currency> by
694 dividing by the exchange rate, and returns the result.
695
696 If no exchange rate is found, C<&curconvert> assumes the rate is one
697 to one.
698
699 =cut
700 #'
701 sub curconvert {
702   my ($currency,$price)=@_;
703   my $dbh = C4::Context->dbh;
704   my $sth=$dbh->prepare("Select rate from currency where currency=?");
705   $sth->execute($currency);
706   my $cur=($sth->fetchrow_array())[0];
707   $sth->finish;
708   if ($cur==0){
709     $cur=1;
710   }
711   return($price / $cur);
712 }
713
714 =item getcurrencies
715
716   ($count, $currencies) = &getcurrencies();
717
718 Returns the list of all known currencies.
719
720 C<$count> is the number of elements in C<$currencies>. C<$currencies>
721 is a reference-to-array; its elements are references-to-hash, whose
722 keys are the fields from the currency table in the Koha database.
723
724 =cut
725 #'
726 sub getcurrencies {
727   my $dbh = C4::Context->dbh;
728   my $sth=$dbh->prepare("Select * from currency");
729   $sth->execute;
730   my @results = ();
731   while (my $data=$sth->fetchrow_hashref){
732     push(@results,$data);
733   }
734   $sth->finish;
735   return(scalar(@results),\@results);
736 }
737
738 =item updatecurrencies
739
740   &updatecurrencies($currency, $newrate);
741
742 Sets the exchange rate for C<$currency> to be C<$newrate>.
743
744 =cut
745 #'
746 sub updatecurrencies {
747   my ($currency,$rate)=@_;
748   my $dbh = C4::Context->dbh;
749   my $sth=$dbh->prepare("update currency set rate=? where currency=?");
750   $sth->execute($rate,$currency);
751   $sth->finish;
752 }
753
754 # FIXME - This is never used
755 sub updatecost{
756   my($price,$rrp,$itemnum)=@_;
757   my $dbh = C4::Context->dbh;
758   my $sth=$dbh->prepare("update items set price=?,replacementprice=? where itemnumber=?");
759   $sth->execute($price,$rrp,$itemnum);
760   $sth->finish;
761 }
762
763 #
764 #
765 # OTHERS
766 #
767 #
768
769 =item bookseller
770
771   ($count, @results) = &bookseller($searchstring);
772
773 Looks up a book seller. C<$searchstring> may be either a book seller
774 ID, or a string to look for in the book seller's name.
775
776 C<$count> is the number of elements in C<@results>. C<@results> is an
777 array of references-to-hash, whose keys are the fields of of the
778 aqbooksellers table in the Koha database.
779
780 =cut
781 #'
782 sub bookseller {
783   my ($searchstring)=@_;
784   my $dbh = C4::Context->dbh;
785   my $sth=$dbh->prepare("Select * from aqbooksellers where name like ? or id = ?");
786   $sth->execute("$searchstring%",$searchstring);
787   my @results;
788   while (my $data=$sth->fetchrow_hashref){
789     push(@results,$data);
790   }
791   $sth->finish;
792   return(scalar(@results),@results);
793 }
794
795 =item breakdown
796
797   ($count, $results) = &breakdown($ordernumber);
798
799 Looks up an order by order ID, and returns its breakdown.
800
801 C<$count> is the number of elements in C<$results>. C<$results> is a
802 reference-to-array; its elements are references-to-hash, whose keys
803 are the fields of the aqorderbreakdown table in the Koha database.
804
805 =cut
806 #'
807 sub breakdown {
808   my ($id)=@_;
809   my $dbh = C4::Context->dbh;
810   my $sth=$dbh->prepare("Select * from aqorderbreakdown where ordernumber=?");
811   $sth->execute($id);
812   my @results = ();
813   while (my $data=$sth->fetchrow_hashref){
814     push(@results,$data);
815   }
816   $sth->finish;
817   return(scalar(@results),\@results);
818 }
819
820 =item branches
821
822   ($count, @results) = &branches();
823
824 Returns a list of all library branches.
825
826 C<$count> is the number of elements in C<@results>. C<@results> is an
827 array of references-to-hash, whose keys are the fields of the branches
828 table of the Koha database.
829
830 =cut
831 #'
832 sub branches {
833     my $dbh   = C4::Context->dbh;
834     my $sth   = $dbh->prepare("Select * from branches order by branchname");
835     my @results = ();
836
837     $sth->execute();
838     while (my $data = $sth->fetchrow_hashref) {
839         push(@results,$data);
840     } # while
841
842     $sth->finish;
843     return(scalar(@results), @results);
844 } # sub branches
845
846 # FIXME - Never used
847 sub findall {
848   my ($biblionumber)=@_;
849   my $dbh = C4::Context->dbh;
850   my $sth=$dbh->prepare("Select * from biblioitems,items,itemtypes where
851   biblioitems.biblionumber=?
852   and biblioitems.biblioitemnumber=items.biblioitemnumber and
853   itemtypes.itemtype=biblioitems.itemtype
854   order by items.biblioitemnumber");
855   $sth->execute($biblionumber);
856   my @results;
857   while (my $data=$sth->fetchrow_hashref){
858     push(@results,$data);
859   }
860   $sth->finish;
861   return(@results);
862 }
863
864 # FIXME - Never used
865 sub needsmod{
866   my ($bibitemnum,$itemtype)=@_;
867   my $dbh = C4::Context->dbh;
868   my $sth=$dbh->prepare("Select * from biblioitems where biblioitemnumber=?
869   and itemtype=?");
870   $sth->execute($bibitemnum,$itemtype);
871   my $result=0;
872   if (my $data=$sth->fetchrow_hashref){
873     $result=1;
874   }
875   $sth->finish;
876   return($result);
877 }
878
879 =item updatesup
880
881   &updatesup($bookseller);
882
883 Updates the information for a given bookseller. C<$bookseller> is a
884 reference-to-hash whose keys are the fields of the aqbooksellers table
885 in the Koha database. It must contain entries for all of the fields.
886 The entry to modify is determined by C<$bookseller-E<gt>{id}>.
887
888 The easiest way to get all of the necessary fields is to look up a
889 book seller with C<&booksellers>, modify what's necessary, then call
890 C<&updatesup> with the result.
891
892 =cut
893 #'
894 sub updatesup {
895    my ($data)=@_;
896    my $dbh = C4::Context->dbh;
897    my $sth=$dbh->prepare("Update aqbooksellers set
898    name=?,address1=?,address2=?,address3=?,address4=?,postal=?,
899    phone=?,fax=?,url=?,contact=?,contpos=?,contphone=?,contfax=?,contaltphone=?,
900    contemail=?,contnotes=?,active=?,
901    listprice=?, invoiceprice=?,gstreg=?, listincgst=?,
902    invoiceincgst=?, specialty=?,discount=?,invoicedisc=?,
903    nocalc=?
904    where id=?");
905    $sth->execute($data->{'name'},$data->{'address1'},$data->{'address2'},
906    $data->{'address3'},$data->{'address4'},$data->{'postal'},$data->{'phone'},
907    $data->{'fax'},$data->{'url'},$data->{'contact'},$data->{'contpos'},
908    $data->{'contphone'},$data->{'contfax'},$data->{'contaltphone'},
909    $data->{'contemail'},
910    $data->{'contnote'},$data->{'active'},$data->{'listprice'},
911    $data->{'invoiceprice'},$data->{'gstreg'},$data->{'listincgst'},
912    $data->{'invoiceincgst'},$data->{'specialty'},$data->{'discount'},
913    $data->{'invoicedisc'},$data->{'nocalc'},$data->{'id'});
914    $sth->finish;
915 #   print $query;
916 }
917
918 =item insertsup
919
920   $id = &insertsup($bookseller);
921
922 Creates a new bookseller. C<$bookseller> is a reference-to-hash whose
923 keys are the fields of the aqbooksellers table in the Koha database.
924 All fields must be present.
925
926 Returns the ID of the newly-created bookseller.
927
928 =cut
929 #'
930 sub insertsup {
931   my ($data)=@_;
932   my $dbh = C4::Context->dbh;
933   my $sth=$dbh->prepare("Select max(id) from aqbooksellers");
934   $sth->execute;
935   my $data2=$sth->fetchrow_hashref;
936   $sth->finish;
937   $data2->{'max(id)'}++;
938   $sth=$dbh->prepare("Insert into aqbooksellers (id) values (?)");
939   $sth->execute($data2->{'max(id)'});
940   $sth->finish;
941   $data->{'id'}=$data2->{'max(id)'};
942   updatesup($data);
943   return($data->{'id'});
944 }
945
946 =item websitesearch
947
948   ($count, @results) = &websitesearch($keywordlist);
949
950 Looks up biblioitems by URL.
951
952 C<$keywordlist> is a space-separated list of search terms.
953 C<&websitesearch> returns those biblioitems whose URL contains at
954 least one of the search terms.
955
956 C<$count> is the number of elements in C<@results>. C<@results> is an
957 array of references-to-hash, whose keys are the fields of the biblio
958 and biblioitems tables in the Koha database.
959
960 =cut
961 #'
962 sub websitesearch {
963     my ($keywordlist) = @_;
964     my $dbh   = C4::Context->dbh;
965     my $sth;
966     my @results = ();
967     my @keywords = split(/ +/, $keywordlist);
968
969         $sth    = $dbh->prepare("Select distinct biblio.* from biblio, biblioitems where
970         biblio.biblionumber = biblioitems.biblionumber and ("
971                 .(join(") or (",map { "url like ?" } @keywords)).")");
972     $sth->execute(map { s/([%_])/\\\1/g; "%$_%" } @keywords);
973
974     while (my $data = $sth->fetchrow_hashref) {
975         push(@results,$data);
976     } # while
977
978     $sth->finish;
979     return(scalar(@results), @results);
980 } # sub websitesearch
981
982 =item addwebsite
983
984   &addwebsite($website);
985
986 Adds a new web site. C<$website> is a reference-to-hash, with the keys
987 C<biblionumber>, C<title>, C<description>, and C<url>. All of these
988 are mandatory.
989
990 =cut
991 #'
992 sub addwebsite {
993     my ($website) = @_;
994     my $dbh = C4::Context->dbh;
995     my $query;
996
997     # FIXME -
998     #   for (qw( biblionumber title description url )) # and any others
999     #   {
1000     #           $website->{$_} = $dbh->quote($_);
1001     #   }
1002     # Perhaps extend this to building the query as well. This might allow
1003     # some of the fields to be optional.
1004     $website->{'biblionumber'} = $dbh->quote($website->{'biblionumber'});
1005     $website->{'title'}        = $dbh->quote($website->{'title'});
1006     $website->{'description'}  = $dbh->quote($website->{'description'});
1007     $website->{'url'}          = $dbh->quote($website->{'url'});
1008
1009     $query = "Insert into websites set
1010 biblionumber = $website->{'biblionumber'},
1011 title        = $website->{'title'},
1012 description  = $website->{'description'},
1013 url          = $website->{'url'}";
1014
1015     $dbh->do($query);
1016 } # sub website
1017
1018 =item updatewebsite
1019
1020   &updatewebsite($website);
1021
1022 Updates an existing web site. C<$website> is a reference-to-hash with
1023 the keys C<websitenumber>, C<title>, C<description>, and C<url>. All
1024 of these are mandatory. C<$website-E<gt>{websitenumber}> identifies
1025 the entry to update.
1026
1027 =cut
1028 #'
1029 sub updatewebsite {
1030     my ($website) = @_;
1031     my $dbh = C4::Context->dbh;
1032     my $query;
1033
1034     $website->{'title'}      = $dbh->quote($website->{'title'});
1035     $website->{'description'} = $dbh->quote($website->{'description'});
1036     $website->{'url'}        = $dbh->quote($website->{'url'});
1037
1038     $query = "Update websites set
1039 title       = $website->{'title'},
1040 description = $website->{'description'},
1041 url         = $website->{'url'}
1042 where websitenumber = $website->{'websitenumber'}";
1043
1044     $dbh->do($query);
1045 } # sub updatewebsite
1046
1047 =item deletewebsite
1048
1049   &deletewebsite($websitenumber);
1050
1051 Deletes the web site with number C<$websitenumber>.
1052
1053 =cut
1054 #'
1055 sub deletewebsite {
1056     my ($websitenumber) = @_;
1057     my $dbh = C4::Context->dbh;
1058     # FIXME - $query is unneeded
1059     my $query = "Delete from websites where websitenumber = $websitenumber";
1060
1061     $dbh->do($query);
1062 } # sub deletewebsite
1063
1064 END { }       # module clean-up code here (global destructor)
1065
1066 1;
1067 __END__
1068
1069 =back
1070
1071 =head1 AUTHOR
1072
1073 Koha Developement team <info@koha.org>
1074
1075 =cut