Fixing a bug that was breaking adding or modifying suppliers
[wip/koha-chris_n.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.=" group by aqorders.ordernumber";
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 $query="Select max(basketno) from aqorders";
145   my $sth=$dbh->prepare($query);
146   $sth->execute;
147   my $data=$sth->fetchrow_arrayref;
148   my $basket=$$data[0];
149   $basket++;
150   $sth->finish;
151   return($basket);
152 }
153
154 =item neworder
155
156   &neworder($biblionumber, $title, $ordnum, $basket, $quantity, $listprice,
157         $booksellerid, $who, $notes, $bookfund, $biblioitemnumber, $rrp,
158         $ecost, $gst, $budget, $unitprice, $subscription,
159         $booksellerinvoicenumber);
160
161 Adds a new order to the database. Any argument that isn't described
162 below is the new value of the field with the same name in the aqorders
163 table of the Koha database.
164
165 C<$ordnum> is a "minimum order number." After adding the new entry to
166 the aqorders table, C<&neworder> finds the first entry in aqorders
167 with order number greater than or equal to C<$ordnum>, and adds an
168 entry to the aqorderbreakdown table, with the order number just found,
169 and the book fund ID of the newly-added order.
170
171 C<$budget> is effectively ignored.
172
173 C<$subscription> may be either "yes", or anything else for "no".
174
175 =cut
176 #'
177 sub neworder {
178   my ($bibnum,$title,$ordnum,$basket,$quantity,$listprice,$supplier,$who,$notes,$bookfund,$bibitemnum,$rrp,$ecost,$gst,$budget,$cost,$sub,$invoice)=@_;
179   if ($budget eq 'now'){
180     $budget="now()";
181   } else {
182     $budget="'2001-07-01'";
183   }
184   if ($sub eq 'yes'){
185     $sub=1;
186   } else {
187     $sub=0;
188   }
189   my $dbh = C4::Context->dbh;
190   my $query="insert into aqorders (biblionumber,title,basketno,
191   quantity,listprice,booksellerid,entrydate,requisitionedby,authorisedby,notes,
192   biblioitemnumber,rrp,ecost,gst,unitprice,subscription,booksellerinvoicenumber)
193
194   values
195   ($bibnum,'$title',$basket,$quantity,$listprice,'$supplier',now(),
196   '$who','$who','$notes',$bibitemnum,'$rrp','$ecost','$gst','$cost',
197   '$sub','$invoice')";
198   my $sth=$dbh->prepare($query);
199 #  print $query;
200   $sth->execute;
201   $sth->finish;
202   $query="select * from aqorders where
203   biblionumber=$bibnum and basketno=$basket and ordernumber >=$ordnum";
204   $sth=$dbh->prepare($query);
205   $sth->execute;
206   my $data=$sth->fetchrow_hashref;
207   $sth->finish;
208   $ordnum=$data->{'ordernumber'};
209   $query="insert into aqorderbreakdown (ordernumber,bookfundid) values
210   ($ordnum,'$bookfund')";
211   $sth=$dbh->prepare($query);
212 #  print $query;
213   $sth->execute;
214   $sth->finish;
215 }
216
217 =item delorder
218
219   &delorder($biblionumber, $ordernumber);
220
221 Cancel the order with the given order and biblio numbers. It does not
222 delete any entries in the aqorders table, it merely marks them as
223 cancelled.
224
225 If there are no items remaining with the given biblionumber,
226 C<&delorder> also deletes them from the marc_subfield_table and
227 marc_biblio tables of the Koha database.
228
229 =cut
230 #'
231 sub delorder {
232   my ($bibnum,$ordnum)=@_;
233   my $dbh = C4::Context->dbh;
234   my $query="update aqorders set datecancellationprinted=now()
235   where biblionumber='$bibnum' and
236   ordernumber='$ordnum'";
237   my $sth=$dbh->prepare($query);
238   #print $query;
239   $sth->execute;
240   $sth->finish;
241   my $count=itemcount($bibnum);
242   if ($count == 0){
243     delbiblio($bibnum);
244   }
245 }
246
247 =item modorder
248
249   &modorder($title, $ordernumber, $quantity, $listprice,
250         $biblionumber, $basketno, $supplier, $who, $notes,
251         $bookfundid, $bibitemnum, $rrp, $ecost, $gst, $budget,
252         $unitprice, $booksellerinvoicenumber);
253
254 Modifies an existing order. Updates the order with order number
255 C<$ordernumber> and biblionumber C<$biblionumber>. All other arguments
256 update the fields with the same name in the aqorders table of the Koha
257 database.
258
259 Entries with order number C<$ordernumber> in the aqorderbreakdown
260 table are also updated to the new book fund ID.
261
262 =cut
263 #'
264 sub modorder {
265   my ($title,$ordnum,$quantity,$listprice,$bibnum,$basketno,$supplier,$who,$notes,$bookfund,$bibitemnum,$rrp,$ecost,$gst,$budget,$cost,$invoice)=@_;
266   my $dbh = C4::Context->dbh;
267   my $query="update aqorders set title='$title',
268   quantity='$quantity',listprice='$listprice',basketno='$basketno',
269   rrp='$rrp',ecost='$ecost',unitprice='$cost',
270   booksellerinvoicenumber='$invoice'
271   where
272   ordernumber=$ordnum and biblionumber=$bibnum";
273   my $sth=$dbh->prepare($query);
274   $sth->execute;
275   $sth->finish;
276   $query="update aqorderbreakdown set bookfundid=? where
277   ordernumber=?";
278   $sth=$dbh->prepare($query);
279   $sth->execute($bookfund,$ordnum);
280   $sth->finish;
281 }
282
283 =item newordernum
284
285   $order = &newordernum();
286
287 Finds the next unused order number in the aqorders table of the Koha
288 database, and returns it.
289
290 =cut
291 #'
292 # FIXME - Race condition
293 sub newordernum {
294   my $dbh = C4::Context->dbh;
295   my $query="Select max(ordernumber) from aqorders";
296   my $sth=$dbh->prepare($query);
297   $sth->execute;
298   my $data=$sth->fetchrow_arrayref;
299   my $ordnum=$$data[0];
300   $ordnum++;
301   $sth->finish;
302   return($ordnum);
303 }
304
305 =item receiveorder
306
307   &receiveorder($biblionumber, $ordernumber, $quantityreceived, $user,
308         $unitprice, $booksellerinvoicenumber, $biblioitemnumber,
309         $freight, $bookfund, $rrp);
310
311 Updates an order, to reflect the fact that it was received, at least
312 in part. All arguments not mentioned below update the fields with the
313 same name in the aqorders table of the Koha database.
314
315 Updates the order with bibilionumber C<$biblionumber> and ordernumber
316 C<$ordernumber>.
317
318 Also updates the book fund ID in the aqorderbreakdown table.
319
320 =cut
321 #'
322 sub receiveorder {
323   my ($biblio,$ordnum,$quantrec,$user,$cost,$invoiceno,$bibitemno,$freight,$bookfund,$rrp)=@_;
324   my $dbh = C4::Context->dbh;
325   my $query="update aqorders set quantityreceived=?,datereceived=now(),booksellerinvoicenumber=?,
326                                                                                 biblioitemnumber=?,unitprice=?,freight=?,rrp=?
327                                                 where biblionumber=? and ordernumber=?";
328   my $sth=$dbh->prepare($query);
329   $sth->execute($quantrec,$invoiceno,$bibitemno,$cost,$freight,$rrp,$biblio,$ordnum);
330   $sth->finish;
331   $query="update aqorderbreakdown set bookfundid=? where
332   ordernumber=?";
333   $sth=$dbh->prepare($query);
334   $sth->execute($bookfund,$ordnum);
335   $sth->finish;
336 }
337
338 =item updaterecorder
339
340   &updaterecorder($biblionumber, $ordernumber, $user, $unitprice,
341         $bookfundid, $rrp);
342
343 Updates the order with biblionumber C<$biblionumber> and order number
344 C<$ordernumber>. C<$bookfundid> is the new value for the book fund ID
345 in the aqorderbreakdown table of the Koha database. All other
346 arguments update the fields with the same name in the aqorders table.
347
348 C<$user> is ignored.
349
350 =cut
351 #'
352 sub updaterecorder{
353   my($biblio,$ordnum,$user,$cost,$bookfund,$rrp)=@_;
354   my $dbh = C4::Context->dbh;
355   my $query="update aqorders set
356   unitprice='$cost', rrp='$rrp'
357   where biblionumber=$biblio and ordernumber=$ordnum
358   ";
359 #  print $query;
360   my $sth=$dbh->prepare($query);
361   $sth->execute;
362   $sth->finish;
363   $query="update aqorderbreakdown set bookfundid=$bookfund where
364   ordernumber=$ordnum";
365   $sth=$dbh->prepare($query);
366 #  print $query;
367   $sth->execute;
368   $sth->finish;
369 }
370
371 #
372 #
373 # ORDERS
374 #
375 #
376
377 =item getorders
378
379   ($count, $orders) = &getorders($booksellerid);
380
381 Finds pending orders from the bookseller with the given ID. Ignores
382 completed and cancelled orders.
383
384 C<$count> is the number of elements in C<@{$orders}>.
385
386 C<$orders> is a reference-to-array; each element is a
387 reference-to-hash with the following fields:
388
389 =over 4
390
391 =item C<count(*)>
392
393 Gives the number of orders in with this basket number.
394
395 =item C<authorizedby>
396
397 =item C<entrydate>
398
399 =item C<basketno>
400
401 These give the value of the corresponding field in the aqorders table
402 of the Koha database.
403
404 =back
405
406 Results are ordered from most to least recent.
407
408 =cut
409 #'
410 sub getorders {
411   my ($supplierid)=@_;
412   my $dbh = C4::Context->dbh;
413   my $query = "Select count(*),authorisedby,entrydate,basketno from aqorders where
414   booksellerid='$supplierid' and (quantity > quantityreceived or
415   quantityreceived is NULL)
416   and (datecancellationprinted is NULL or datecancellationprinted = '0000-00-00')";
417   $query.=" group by basketno order by entrydate desc";
418   #print $query;
419   my $sth=$dbh->prepare($query);
420   $sth->execute;
421   my @results;
422   my $i=0;
423   while (my $data=$sth->fetchrow_hashref){
424     $results[$i]=$data;
425     $i++;
426   }
427   $sth->finish;
428   return ($i,\@results);
429 }
430
431 =item getorder
432
433   ($order, $ordernumber) = &getorder($biblioitemnumber, $biblionumber);
434
435 Looks up the order with the given biblionumber and biblioitemnumber.
436
437 Returns a two-element array. C<$ordernumber> is the order number.
438 C<$order> is a reference-to-hash describing the order; its keys are
439 fields from the biblio, biblioitems, aqorders, and aqorderbreakdown
440 tables of the Koha database.
441
442 =cut
443 #'
444 # FIXME - This is effectively identical to &C4::Biblio::getorder.
445 # Pick one and stick with it.
446 sub getorder{
447   my ($bi,$bib)=@_;
448   my $dbh = C4::Context->dbh;
449   my $query="Select ordernumber from aqorders where biblionumber=$bib and
450   biblioitemnumber='$bi'";
451   my $sth=$dbh->prepare($query);
452   $sth->execute;
453   # FIXME - Use fetchrow_array(), since we're only interested in the one
454   # value.
455   my $ordnum=$sth->fetchrow_hashref;
456   $sth->finish;
457   my $order=getsingleorder($ordnum->{'ordernumber'});
458 #  print $query;
459   return ($order,$ordnum->{'ordernumber'});
460 }
461
462 =item getsingleorder
463
464   $order = &getsingleorder($ordernumber);
465
466 Looks up an order by order number.
467
468 Returns a reference-to-hash describing the order. The keys of
469 C<$order> are fields from the biblio, biblioitems, aqorders, and
470 aqorderbreakdown tables of the Koha database.
471
472 =cut
473 #'
474 # FIXME - This is effectively identical to
475 # &C4::Biblio::getsingleorder.
476 # Pick one and stick with it.
477 sub getsingleorder {
478   my ($ordnum)=@_;
479   my $dbh = C4::Context->dbh;
480   my $query="Select * from biblio,biblioitems,aqorders,aqorderbreakdown
481   where aqorders.ordernumber='$ordnum'
482   and biblio.biblionumber=aqorders.biblionumber and
483   biblioitems.biblioitemnumber=aqorders.biblioitemnumber and
484   aqorders.ordernumber=aqorderbreakdown.ordernumber";
485   my $sth=$dbh->prepare($query);
486   $sth->execute;
487   my $data=$sth->fetchrow_hashref;
488   $sth->finish;
489   return($data);
490 }
491
492 =item getallorders
493
494   ($count, @results) = &getallorders($booksellerid);
495
496 Looks up all of the pending orders from the supplier with the given
497 bookseller ID. Ignores cancelled and completed orders.
498
499 C<$count> is the number of elements in C<@results>. C<@results> is an
500 array of references-to-hash. The keys of each element are fields from
501 the aqorders, biblio, and biblioitems tables of the Koha database.
502
503 C<@results> is sorted alphabetically by book title.
504
505 =cut
506 #'
507 sub getallorders {
508   #gets all orders from a certain supplier, orders them alphabetically
509   my ($supid)=@_;
510   my $dbh = C4::Context->dbh;
511   my $query="Select * from aqorders,biblio,biblioitems where booksellerid='$supid'
512   and (cancelledby is NULL or cancelledby = '')
513   and (quantityreceived < quantity or quantityreceived is NULL)
514   and biblio.biblionumber=aqorders.biblionumber and biblioitems.biblioitemnumber=
515   aqorders.biblioitemnumber
516   group by aqorders.biblioitemnumber
517   order by
518   biblio.title";
519   my $i=0;
520   my @results;
521   my $sth=$dbh->prepare($query);
522   $sth->execute;
523   while (my $data=$sth->fetchrow_hashref){
524     $results[$i]=$data;
525     $i++;
526   }
527   $sth->finish;
528   return($i,@results);
529 }
530
531 # FIXME - Never used
532 sub getrecorders {
533   #gets all orders from a certain supplier, orders them alphabetically
534   my ($supid)=@_;
535   my $dbh = C4::Context->dbh;
536   my $query="Select * from aqorders,biblio,biblioitems where booksellerid='$supid'
537   and (cancelledby is NULL or cancelledby = '')
538   and biblio.biblionumber=aqorders.biblionumber and biblioitems.biblioitemnumber=
539   aqorders.biblioitemnumber and
540   aqorders.quantityreceived>0
541   and aqorders.datereceived >=now()
542   group by aqorders.biblioitemnumber
543   order by
544   biblio.title";
545   my $i=0;
546   my @results;
547   my $sth=$dbh->prepare($query);
548   $sth->execute;
549   while (my $data=$sth->fetchrow_hashref){
550     $results[$i]=$data;
551     $i++;
552   }
553   $sth->finish;
554   return($i,@results);
555 }
556
557 =item ordersearch
558
559   ($count, @results) = &ordersearch($search, $biblionumber, $complete);
560
561 Searches for orders.
562
563 C<$search> may take one of several forms: if it is an ISBN,
564 C<&ordersearch> returns orders with that ISBN. If C<$search> is an
565 order number, C<&ordersearch> returns orders with that order number
566 and biblionumber C<$biblionumber>. Otherwise, C<$search> is considered
567 to be a space-separated list of search terms; in this case, all of the
568 terms must appear in the title (matching the beginning of title
569 words).
570
571 If C<$complete> is C<yes>, the results will include only completed
572 orders. In any case, C<&ordersearch> ignores cancelled orders.
573
574 C<&ordersearch> returns an array. C<$count> is the number of elements
575 in C<@results>. C<@results> is an array of references-to-hash with the
576 following keys:
577
578 =over 4
579
580 =item C<author>
581
582 =item C<seriestitle>
583
584 =item C<branchcode>
585
586 =item C<bookfundid>
587
588 =back
589
590 =cut
591 #'
592 sub ordersearch {
593         my ($search,$id,$biblio,$catview) = @_;
594         my $dbh   = C4::Context->dbh;
595         my $query = "Select *,biblio.title from aqorders,biblioitems,biblio
596                                                         where aqorders.biblioitemnumber = biblioitems.biblioitemnumber
597                                                                         and aqorders.booksellerid = '$id'
598                                                                         and biblio.biblionumber=aqorders.biblionumber
599                                                                         and ((datecancellationprinted is NULL)
600                                                                         or (datecancellationprinted = '0000-00-00'))
601                                                                         and ((";
602         my @data  = split(' ',$search);
603         my $count = @data;
604         for (my $i = 0; $i < $count; $i++) {
605                 $query .= "(biblio.title like '$data[$i]%' or biblio.title like '% $data[$i]%') and ";
606         }
607         $query=~ s/ and $//;
608                         # FIXME - Redo this properly instead of hacking off the
609                         # trailing 'and'.
610         $query.=" ) or biblioitems.isbn='$search' or (aqorders.ordernumber='$search' and aqorders.biblionumber='$biblio')) ";
611         if ($catview ne 'yes'){
612                 $query.=" and (quantityreceived < quantity or quantityreceived is NULL)";
613         }
614         $query.=" group by aqorders.ordernumber";
615         my $sth=$dbh->prepare($query);
616         $sth->execute;
617         my $i=0;
618         my @results;
619         my $sth2=$dbh->prepare("Select * from biblio where biblionumber=?");
620         my $sth3=$dbh->prepare("Select * from aqorderbreakdown where ordernumber=?");
621         while (my $data=$sth->fetchrow_hashref){
622                 $sth2->execute($data->{'biblionumber'});
623                 my $data2=$sth2->fetchrow_hashref;
624                 $data->{'author'}=$data2->{'author'};
625                 $data->{'seriestitle'}=$data2->{'seriestitle'};
626                 $sth3->execute($data->{'ordernumber'});
627                 my $data3=$sth3->fetchrow_hashref;
628                 $data->{'branchcode'}=$data3->{'branchcode'};
629                 $data->{'bookfundid'}=$data3->{'bookfundid'};
630                 $results[$i]=$data;
631                 $i++;
632         }
633         $sth->finish;
634         $sth2->finish;
635         $sth3->finish;
636         return($i,@results);
637 }
638
639 #
640 #
641 # MONEY
642 #
643 #
644 =item invoice
645
646   ($count, @results) = &invoice($booksellerinvoicenumber);
647
648 Looks up orders by invoice number.
649
650 Returns an array. C<$count> is the number of elements in C<@results>.
651 C<@results> is an array of references-to-hash; the keys of each
652 elements are fields from the aqorders, biblio, and biblioitems tables
653 of the Koha database.
654
655 =cut
656 #'
657 sub invoice {
658   my ($invoice)=@_;
659   my $dbh = C4::Context->dbh;
660   my $query="Select * from aqorders,biblio,biblioitems where
661   booksellerinvoicenumber='$invoice'
662   and biblio.biblionumber=aqorders.biblionumber and biblioitems.biblioitemnumber=
663   aqorders.biblioitemnumber group by aqorders.ordernumber,aqorders.biblioitemnumber";
664   my $i=0;
665   my @results;
666   my $sth=$dbh->prepare($query);
667   $sth->execute;
668   while (my $data=$sth->fetchrow_hashref){
669     $results[$i]=$data;
670     $i++;
671   }
672   $sth->finish;
673   return($i,@results);
674 }
675
676 =item bookfunds
677
678   ($count, @results) = &bookfunds();
679
680 Returns a list of all book funds.
681
682 C<$count> is the number of elements in C<@results>. C<@results> is an
683 array of references-to-hash, whose keys are fields from the aqbookfund
684 and aqbudget tables of the Koha database. Results are ordered
685 alphabetically by book fund name.
686
687 =cut
688 #'
689 sub bookfunds {
690   my $dbh = C4::Context->dbh;
691   my $query="Select * from aqbookfund,aqbudget where aqbookfund.bookfundid
692   =aqbudget.bookfundid
693   group by aqbookfund.bookfundid order by bookfundname";
694   my $sth=$dbh->prepare($query);
695   $sth->execute;
696   my @results;
697   my $i=0;
698   while (my $data=$sth->fetchrow_hashref){
699     $results[$i]=$data;
700     $i++;
701   }
702   $sth->finish;
703   return($i,@results);
704 }
705
706 # FIXME - POD. I can't figure out what this function is doing. Then
707 # again, I don't think it's being used (anymore).
708 sub bookfundbreakdown {
709   my ($id)=@_;
710   my $dbh = C4::Context->dbh;
711   my $query="Select quantity,datereceived,freight,unitprice,listprice,ecost,quantityreceived,subscription
712   from aqorders,aqorderbreakdown where bookfundid='$id' and
713   aqorders.ordernumber=aqorderbreakdown.ordernumber
714   and (datecancellationprinted is NULL or
715   datecancellationprinted='0000-00-00')";
716   my $sth=$dbh->prepare($query);
717   $sth->execute;
718   my $comtd=0;
719   my $spent=0;
720   while (my $data=$sth->fetchrow_hashref){
721     if ($data->{'subscription'} == 1){
722       $spent+=$data->{'quantity'}*$data->{'unitprice'};
723     } else {
724       my $leftover=$data->{'quantity'}-$data->{'quantityreceived'};
725       $comtd+=($data->{'ecost'})*$leftover;
726       $spent+=($data->{'unitprice'})*$data->{'quantityreceived'};
727     }
728   }
729   $sth->finish;
730   return($spent,$comtd);
731 }
732
733 =item curconvert
734
735   $foreignprice = &curconvert($currency, $localprice);
736
737 Converts the price C<$localprice> to foreign currency C<$currency> by
738 dividing by the exchange rate, and returns the result.
739
740 If no exchange rate is found, C<&curconvert> assumes the rate is one
741 to one.
742
743 =cut
744 #'
745 sub curconvert {
746   my ($currency,$price)=@_;
747   my $dbh = C4::Context->dbh;
748   my $query="Select rate from currency where currency='$currency'";
749   my $sth=$dbh->prepare($query);
750   $sth->execute;
751   my $data=$sth->fetchrow_hashref;
752   $sth->finish;
753   my $cur=$data->{'rate'};
754   if ($cur==0){
755     $cur=1;
756   }
757   return($price / $cur);
758 }
759
760 =item getcurrencies
761
762   ($count, $currencies) = &getcurrencies();
763
764 Returns the list of all known currencies.
765
766 C<$count> is the number of elements in C<$currencies>. C<$currencies>
767 is a reference-to-array; its elements are references-to-hash, whose
768 keys are the fields from the currency table in the Koha database.
769
770 =cut
771 #'
772 sub getcurrencies {
773   my $dbh = C4::Context->dbh;
774   my $query="Select * from currency";
775   my $sth=$dbh->prepare($query);
776   $sth->execute;
777   my @results;
778   my $i=0;
779   while (my $data=$sth->fetchrow_hashref){
780     $results[$i]=$data;
781     $i++;
782   }
783   $sth->finish;
784   return($i,\@results);
785 }
786
787 =item updatecurrencies
788
789   &updatecurrencies($currency, $newrate);
790
791 Sets the exchange rate for C<$currency> to be C<$newrate>.
792
793 =cut
794 #'
795 sub updatecurrencies {
796   my ($currency,$rate)=@_;
797   my $dbh = C4::Context->dbh;
798   my $query="update currency set rate=$rate where currency='$currency'";
799   my $sth=$dbh->prepare($query);
800   $sth->execute;
801   $sth->finish;
802 }
803
804 # FIXME - This is never used
805 sub updatecost{
806   my($price,$rrp,$itemnum)=@_;
807   my $dbh = C4::Context->dbh;
808   my $query="update items set price='$price',replacementprice='$rrp'
809   where itemnumber=$itemnum";
810   my $sth=$dbh->prepare($query);
811   $sth->execute;
812   $sth->finish;
813 }
814
815 #
816 #
817 # OTHERS
818 #
819 #
820
821 =item bookseller
822
823   ($count, @results) = &bookseller($searchstring);
824
825 Looks up a book seller. C<$searchstring> may be either a book seller
826 ID, or a string to look for in the book seller's name.
827
828 C<$count> is the number of elements in C<@results>. C<@results> is an
829 array of references-to-hash, whose keys are the fields of of the
830 aqbooksellers table in the Koha database.
831
832 =cut
833 #'
834 sub bookseller {
835   my ($searchstring)=@_;
836   my $dbh = C4::Context->dbh;
837   my $query="Select * from aqbooksellers where name like '$searchstring%' or
838   id = '$searchstring'";
839   my $sth=$dbh->prepare($query);
840   $sth->execute;
841   my @results;
842   my $i=0;
843   while (my $data=$sth->fetchrow_hashref){
844     $results[$i]=$data;
845     $i++;
846   }
847   $sth->finish;
848   return($i,@results);
849 }
850
851 =item breakdown
852
853   ($count, $results) = &breakdown($ordernumber);
854
855 Looks up an order by order ID, and returns its breakdown.
856
857 C<$count> is the number of elements in C<$results>. C<$results> is a
858 reference-to-array; its elements are references-to-hash, whose keys
859 are the fields of the aqorderbreakdown table in the Koha database.
860
861 =cut
862 #'
863 sub breakdown {
864   my ($id)=@_;
865   my $dbh = C4::Context->dbh;
866   my $query="Select * from aqorderbreakdown where ordernumber='$id'";
867   my $sth=$dbh->prepare($query);
868   $sth->execute;
869   my @results;
870   my $i=0;
871   while (my $data=$sth->fetchrow_hashref){
872     $results[$i]=$data;
873     $i++;
874   }
875   $sth->finish;
876   return($i,\@results);
877 }
878
879 =item branches
880
881   ($count, @results) = &branches();
882
883 Returns a list of all library branches.
884
885 C<$count> is the number of elements in C<@results>. C<@results> is an
886 array of references-to-hash, whose keys are the fields of the branches
887 table of the Koha database.
888
889 =cut
890 #'
891 sub branches {
892     my $dbh   = C4::Context->dbh;
893     my $query = "Select * from branches";
894     my $sth   = $dbh->prepare($query);
895     my $i     = 0;
896     my @results;
897
898     $sth->execute;
899     while (my $data = $sth->fetchrow_hashref) {
900         $results[$i] = $data;
901         $i++;
902     } # while
903
904     $sth->finish;
905     return($i, @results);
906 } # sub branches
907
908 # FIXME - Never used
909 sub findall {
910   my ($biblionumber)=@_;
911   my $dbh = C4::Context->dbh;
912   my $query="Select * from biblioitems,items,itemtypes where
913   biblioitems.biblionumber=$biblionumber
914   and biblioitems.biblioitemnumber=items.biblioitemnumber and
915   itemtypes.itemtype=biblioitems.itemtype
916   order by items.biblioitemnumber";
917   my $sth=$dbh->prepare($query);
918   $sth->execute;
919   my @results;
920   my $i;
921   while (my $data=$sth->fetchrow_hashref){
922     $results[$i]=$data;
923     $i++;
924   }
925   $sth->finish;
926   return(@results);
927 }
928
929 # FIXME - Never used
930 sub needsmod{
931   my ($bibitemnum,$itemtype)=@_;
932   my $dbh = C4::Context->dbh;
933   my $query="Select * from biblioitems where biblioitemnumber=$bibitemnum
934   and itemtype='$itemtype'";
935   my $sth=$dbh->prepare($query);
936   $sth->execute;
937   my $result=0;
938   if (my $data=$sth->fetchrow_hashref){
939     $result=1;
940   }
941   $sth->finish;
942   return($result);
943 }
944
945 =item updatesup
946
947   &updatesup($bookseller);
948
949 Updates the information for a given bookseller. C<$bookseller> is a
950 reference-to-hash whose keys are the fields of the aqbooksellers table
951 in the Koha database. It must contain entries for all of the fields.
952 The entry to modify is determined by C<$bookseller-E<gt>{id}>.
953
954 The easiest way to get all of the necessary fields is to look up a
955 book seller with C<&booksellers>, modify what's necessary, then call
956 C<&updatesup> with the result.
957
958 =cut
959 #'
960 sub updatesup {
961    my ($data)=@_;
962    my $dbh = C4::Context->dbh;
963    my $query="Update aqbooksellers set
964    name=?,address1=?,address2=?,address3=?,address4=?,postal=?,
965    phone=?,fax=?,url=?,contact=?,contpos=?,contphone=?,contfax=?,contaltphone=?,
966    contemail=?,contnotes=?,active=?,
967    listprice=?, invoiceprice=?,gstreg=?, listincgst=?,
968    invoiceincgst=?, specialty=?,discount=?,invoicedisc=?,
969    nocalc=?
970    where id=?";
971    my $sth=$dbh->prepare($query);
972    $sth->execute($data->{'name'},$data->{'address1'},$data->{'address2'},
973    $data->{'address3'},$data->{'address4'},$data->{'postal'},$data->{'phone'},
974    $data->{'fax'},$data->{'url'},$data->{'contact'},$data->{'contpos'},
975    $data->{'contphone'},$data->{'contfax'},$data->{'contaltphone'},
976    $data->{'contemail'},
977    $data->{'contnote'},$data->{'active'},$data->{'listprice'},
978    $data->{'invoiceprice'},$data->{'gstreg'},$data->{'listincgst'},
979    $data->{'invoiceincgst'},$data->{'specialty'},$data->{'discount'},
980    $data->{'invoicedisc'},$data->{'nocalc'},$data->{'id'});
981    $sth->finish;
982 #   print $query;
983 }
984
985 =item insertsup
986
987   $id = &insertsup($bookseller);
988
989 Creates a new bookseller. C<$bookseller> is a reference-to-hash whose
990 keys are the fields of the aqbooksellers table in the Koha database.
991 All fields must be present.
992
993 Returns the ID of the newly-created bookseller.
994
995 =cut
996 #'
997 sub insertsup {
998   my ($data)=@_;
999   my $dbh = C4::Context->dbh;
1000   my $sth=$dbh->prepare("Select max(id) from aqbooksellers");
1001   $sth->execute;
1002   my $data2=$sth->fetchrow_hashref;
1003   $sth->finish;
1004   $data2->{'max(id)'}++;
1005   $sth=$dbh->prepare("Insert into aqbooksellers (id) values ($data2->{'max(id)'})");
1006   $sth->execute;
1007   $sth->finish;
1008   $data->{'id'}=$data2->{'max(id)'};
1009   updatesup($data);
1010   return($data->{'id'});
1011 }
1012
1013 =item websitesearch
1014
1015   ($count, @results) = &websitesearch($keywordlist);
1016
1017 Looks up biblioitems by URL.
1018
1019 C<$keywordlist> is a space-separated list of search terms.
1020 C<&websitesearch> returns those biblioitems whose URL contains at
1021 least one of the search terms.
1022
1023 C<$count> is the number of elements in C<@results>. C<@results> is an
1024 array of references-to-hash, whose keys are the fields of the biblio
1025 and biblioitems tables in the Koha database.
1026
1027 =cut
1028 #'
1029 sub websitesearch {
1030     my ($keywordlist) = @_;
1031     my $dbh   = C4::Context->dbh;
1032     my $query = "Select distinct biblio.* from biblio, biblioitems where
1033 biblio.biblionumber = biblioitems.biblionumber and (";
1034     my $count = 0;
1035     my $sth;
1036     my @results;
1037     my @keywords = split(/ +/, $keywordlist);
1038     my $keyword = shift(@keywords);
1039
1040     # FIXME - Can use
1041     #   $query .= join(" and ",
1042     #           apply { url like "%$_%" } @keywords
1043
1044     $keyword =~ s/%/\\%/g;
1045     $keyword =~ s/_/\\_/;
1046     $keyword = "%" . $keyword . "%";
1047     $keyword = $dbh->quote($keyword);
1048     $query  .= " (url like $keyword)";
1049
1050     foreach $keyword (@keywords) {
1051         $keyword =~ s/%/\\%/;
1052         $keyword =~ s/_/\\_/;
1053         $keyword = "%" . $keyword . "%";
1054         $keyword = $dbh->quote($keyword);
1055         $query  .= " or (url like $keyword)";
1056     } # foreach
1057
1058     $query .= ")";
1059     $sth    = $dbh->prepare($query);
1060     $sth->execute;
1061
1062     while (my $data = $sth->fetchrow_hashref) {
1063         $results[$count] = $data;
1064         $count++;
1065     } # while
1066
1067     $sth->finish;
1068     return($count, @results);
1069 } # sub websitesearch
1070
1071 =item addwebsite
1072
1073   &addwebsite($website);
1074
1075 Adds a new web site. C<$website> is a reference-to-hash, with the keys
1076 C<biblionumber>, C<title>, C<description>, and C<url>. All of these
1077 are mandatory.
1078
1079 =cut
1080 #'
1081 sub addwebsite {
1082     my ($website) = @_;
1083     my $dbh = C4::Context->dbh;
1084     my $query;
1085
1086     # FIXME -
1087     #   for (qw( biblionumber title description url )) # and any others
1088     #   {
1089     #           $website->{$_} = $dbh->quote($_);
1090     #   }
1091     # Perhaps extend this to building the query as well. This might allow
1092     # some of the fields to be optional.
1093     $website->{'biblionumber'} = $dbh->quote($website->{'biblionumber'});
1094     $website->{'title'}        = $dbh->quote($website->{'title'});
1095     $website->{'description'}  = $dbh->quote($website->{'description'});
1096     $website->{'url'}          = $dbh->quote($website->{'url'});
1097
1098     $query = "Insert into websites set
1099 biblionumber = $website->{'biblionumber'},
1100 title        = $website->{'title'},
1101 description  = $website->{'description'},
1102 url          = $website->{'url'}";
1103
1104     $dbh->do($query);
1105 } # sub website
1106
1107 =item updatewebsite
1108
1109   &updatewebsite($website);
1110
1111 Updates an existing web site. C<$website> is a reference-to-hash with
1112 the keys C<websitenumber>, C<title>, C<description>, and C<url>. All
1113 of these are mandatory. C<$website-E<gt>{websitenumber}> identifies
1114 the entry to update.
1115
1116 =cut
1117 #'
1118 sub updatewebsite {
1119     my ($website) = @_;
1120     my $dbh = C4::Context->dbh;
1121     my $query;
1122
1123     $website->{'title'}      = $dbh->quote($website->{'title'});
1124     $website->{'description'} = $dbh->quote($website->{'description'});
1125     $website->{'url'}        = $dbh->quote($website->{'url'});
1126
1127     $query = "Update websites set
1128 title       = $website->{'title'},
1129 description = $website->{'description'},
1130 url         = $website->{'url'}
1131 where websitenumber = $website->{'websitenumber'}";
1132
1133     $dbh->do($query);
1134 } # sub updatewebsite
1135
1136 =item deletewebsite
1137
1138   &deletewebsite($websitenumber);
1139
1140 Deletes the web site with number C<$websitenumber>.
1141
1142 =cut
1143 #'
1144 sub deletewebsite {
1145     my ($websitenumber) = @_;
1146     my $dbh = C4::Context->dbh;
1147     # FIXME - $query is unneeded
1148     my $query = "Delete from websites where websitenumber = $websitenumber";
1149
1150     $dbh->do($query);
1151 } # sub deletewebsite
1152
1153 END { }       # module clean-up code here (global destructor)
1154
1155 1;
1156 __END__
1157
1158 =back
1159
1160 =head1 AUTHOR
1161
1162 Koha Developement team <info@koha.org>
1163
1164 =cut