C4/Acquisition.pm

   1 package C4::Acquisition;
   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 C4::Context;
  23 use MARC::Record;
  24 # use C4::Biblio;
  25
  26 use vars qw($VERSION @ISA @EXPORT);
  27
  28 # set the version for version checking
  29 $VERSION = 0.01;
  30
  31 =head1 NAME
  32
  33 C4::Acquisition - Koha functions for dealing with orders and acquisitions
  34
  35 =head1 SYNOPSIS
  36
  37   use C4::Acquisition;
  38
  39 =head1 DESCRIPTION
  40
  41 The functions in this module deal with acquisitions, managing book
  42 orders, converting money to different currencies, and so forth.
  43
  44 =head1 FUNCTIONS
  45
  46 =over 2
  47
  48 =cut
  49
  50 @ISA = qw(Exporter);
  51 @EXPORT = qw(
  52                 &getbasket &getbasketcontent &newbasket &closebasket
  53
  54                 &getorders &getallorders &getrecorders
  55                 &getorder &neworder &delorder
  56                 &ordersearch
  57                 &modorder &getsingleorder &invoice &receiveorder
  58                 &updaterecorder &newordernum
  59
  60                 &bookfunds &curconvert &getcurrencies &bookfundbreakdown
  61                 &updatecurrencies &getcurrency
  62
  63                 &branches &updatesup &insertsup
  64                 &bookseller &breakdown
  65 );
  66
  67 #
  68 #
  69 #
  70 # BASKETS
  71 #
  72 #
  73 #
  74 =item getbasket
  75
  76   $aqbasket = &getbasket($basketnumber);
  77
  78 get all basket informations in aqbasket for a given basket
  79 =cut
  80
  81 sub getbasket {
  82         my ($basketno)=@_;
  83         my $dbh=C4::Context->dbh;
  84         my $sth=$dbh->prepare("select aqbasket.*,borrowers.firstname+' '+borrowers.surname as authorisedbyname from aqbasket left join borrowers on aqbasket.authorisedby=borrowers.borrowernumber where basketno=?");
  85         $sth->execute($basketno);
  86         return($sth->fetchrow_hashref);
  87 }
  88
  89 =item getbasketcontent
  90
  91   ($count, @orders) = &getbasketcontent($basketnumber, $booksellerID);
  92
  93 Looks up the pending (non-cancelled) orders with the given basket
  94 number. If C<$booksellerID> is non-empty, only orders from that seller
  95 are returned.
  96
  97 C<&basket> returns a two-element array. C<@orders> is an array of
  98 references-to-hash, whose keys are the fields from the aqorders,
  99 biblio, and biblioitems tables in the Koha database. C<$count> is the
 100 number of elements in C<@orders>.
 101
 102 =cut
 103 #'
 104 sub getbasketcontent {
 105         my ($basketno,$supplier)=@_;
 106         my $dbh = C4::Context->dbh;
 107         my $query="Select *,biblio.title from aqorders,biblio,biblioitems
 108         where basketno='$basketno'
 109         and biblio.biblionumber=aqorders.biblionumber and biblioitems.biblioitemnumber
 110         =aqorders.biblioitemnumber
 111         and (datecancellationprinted is NULL or datecancellationprinted =
 112         '0000-00-00')";
 113         if ($supplier ne ''){
 114                 $query.=" and aqorders.booksellerid='$supplier'";
 115         }
 116         $query.=" order by biblioitems.publishercode";
 117         my $sth=$dbh->prepare($query);
 118         $sth->execute;
 119         my @results;
 120         #  print $query;
 121         my $i=0;
 122         while (my $data=$sth->fetchrow_hashref){
 123                 $results[$i]=$data;
 124                 $i++;
 125         }
 126         $sth->finish;
 127         return($i,@results);
 128 }
 129
 130 =item newbasket
 131
 132   $basket = &newbasket();
 133
 134 Create a new basket in aqbasket table
 135 =cut
 136
 137 sub newbasket {
 138         my ($booksellerid,$authorisedby) = @_;
 139         my $dbh = C4::Context->dbh;
 140         my $sth=$dbh->do("insert into aqbasket (creationdate,booksellerid,authorisedby) values(now(),'$booksellerid','$authorisedby')");
 141         #find & return basketno MYSQL dependant, but $dbh->last_insert_id always returns null :-(
 142         my $basket = $dbh->{'mysql_insertid'};
 143         return($basket);
 144 }
 145
 146 =item closebasket
 147
 148   &newbasket($basketno);
 149
 150 close a basket (becomes unmodifiable,except for recieves
 151 =cut
 152
 153 sub closebasket {
 154         my ($basketno) = @_;
 155         my $dbh = C4::Context->dbh;
 156         my $sth=$dbh->prepare("update aqbasket set closedate=now() where basketno=?");
 157         $sth->execute($basketno);
 158 }
 159
 160 =item neworder
 161
 162   &neworder($basket, $biblionumber, $title, $quantity, $listprice,
 163         $booksellerid, $who, $notes, $bookfund, $biblioitemnumber, $rrp,
 164         $ecost, $gst, $budget, $unitprice, $subscription,
 165         $booksellerinvoicenumber);
 166
 167 Adds a new order to the database. Any argument that isn't described
 168 below is the new value of the field with the same name in the aqorders
 169 table of the Koha database.
 170
 171 C<$ordnum> is a "minimum order number." After adding the new entry to
 172 the aqorders table, C<&neworder> finds the first entry in aqorders
 173 with order number greater than or equal to C<$ordnum>, and adds an
 174 entry to the aqorderbreakdown table, with the order number just found,
 175 and the book fund ID of the newly-added order.
 176
 177 C<$budget> is effectively ignored.
 178
 179 C<$subscription> may be either "yes", or anything else for "no".
 180
 181 =cut
 182 #'
 183 sub neworder {
 184         my ($basketno,$bibnum,$title,$quantity,$listprice,$booksellerid,$authorisedby,$notes,$bookfund,$bibitemnum,$rrp,$ecost,$gst,$budget,$cost,$sub,$invoice,$sort1,$sort2)=@_;
 185         if ($budget eq 'now'){
 186                 $budget="now()";
 187         } else {
 188                 $budget="'2001-07-01'";
 189         }
 190         if ($sub eq 'yes'){
 191                 $sub=1;
 192         } else {
 193                 $sub=0;
 194         }
 195         # if $basket empty, it's also a new basket, create it
 196         unless ($basketno) {
 197                 $basketno=newbasket($booksellerid,$authorisedby);
 198         }
 199         my $dbh = C4::Context->dbh;
 200         my $sth=$dbh->prepare("insert into aqorders
 201                                                                 (biblionumber,title,basketno,quantity,listprice,notes,
 202                                                                 biblioitemnumber,rrp,ecost,gst,unitprice,subscription,sort1,sort2)
 203                                                                 values (?,?,?,?,?,?,?,?,?,?,?,?,?,?)");
 204         $sth->execute($bibnum,$title,$basketno,$quantity,$listprice,$notes,
 205                                         $bibitemnum,$rrp,$ecost,$gst,$cost,$sub,$sort1,$sort2);
 206         $sth->finish;
 207         #get ordnum MYSQL dependant, but $dbh->last_insert_id returns null
 208         my $ordnum = $dbh->{'mysql_insertid'};
 209         $sth=$dbh->prepare("insert into aqorderbreakdown (ordernumber,bookfundid) values
 210         (?,?)");
 211         $sth->execute($ordnum,$bookfund);
 212         $sth->finish;
 213         return $basketno;
 214 }
 215
 216 =item delorder
 217
 218   &delorder($biblionumber, $ordernumber);
 219
 220 Cancel the order with the given order and biblio numbers. It does not
 221 delete any entries in the aqorders table, it merely marks them as
 222 cancelled.
 223
 224 =cut
 225 #'
 226 sub delorder {
 227   my ($bibnum,$ordnum)=@_;
 228   my $dbh = C4::Context->dbh;
 229   my $sth=$dbh->prepare("update aqorders set datecancellationprinted=now()
 230   where biblionumber=? and ordernumber=?");
 231   $sth->execute($bibnum,$ordnum);
 232   $sth->finish;
 233 }
 234
 235 =item modorder
 236
 237   &modorder($title, $ordernumber, $quantity, $listprice,
 238         $biblionumber, $basketno, $supplier, $who, $notes,
 239         $bookfundid, $bibitemnum, $rrp, $ecost, $gst, $budget,
 240         $unitprice, $booksellerinvoicenumber);
 241
 242 Modifies an existing order. Updates the order with order number
 243 C<$ordernumber> and biblionumber C<$biblionumber>. All other arguments
 244 update the fields with the same name in the aqorders table of the Koha
 245 database.
 246
 247 Entries with order number C<$ordernumber> in the aqorderbreakdown
 248 table are also updated to the new book fund ID.
 249
 250 =cut
 251 #'
 252 sub modorder {
 253   my ($title,$ordnum,$quantity,$listprice,$bibnum,$basketno,$supplier,$who,$notes,$bookfund,$bibitemnum,$rrp,$ecost,$gst,$budget,$cost,$invoice,$sort1,$sort2)=@_;
 254   my $dbh = C4::Context->dbh;
 255   my $sth=$dbh->prepare("update aqorders set title=?,
 256   quantity=?,listprice=?,basketno=?,
 257   rrp=?,ecost=?,unitprice=?,
 258   sort1=?, sort2=?
 259   where
 260   ordernumber=? and biblionumber=?");
 261   $sth->execute($title,$quantity,$listprice,$basketno,$rrp,$ecost,$cost,$sort1,$sort2,$ordnum,$bibnum);
 262   $sth->finish;
 263   $sth=$dbh->prepare("update aqorderbreakdown set bookfundid=? where
 264   ordernumber=?");
 265   if ($sth->execute($bookfund,$ordnum) == 0) { # zero rows affected [Bug 734]
 266     my $query="insert into aqorderbreakdown (ordernumber,bookfundid) values (?,?)";
 267     $sth=$dbh->prepare($query);
 268     $sth->execute($ordnum,$bookfund);
 269   }
 270   $sth->finish;
 271 }
 272
 273 =item newordernum
 274
 275   $order = &newordernum();
 276
 277 Finds the next unused order number in the aqorders table of the Koha
 278 database, and returns it.
 279
 280 =cut
 281 #'
 282 # FIXME - Race condition
 283 sub newordernum {
 284   my $dbh = C4::Context->dbh;
 285   my $sth=$dbh->prepare("Select max(ordernumber) from aqorders");
 286   $sth->execute;
 287   my $data=$sth->fetchrow_arrayref;
 288   my $ordnum=$$data[0];
 289   $ordnum++;
 290   $sth->finish;
 291   return($ordnum);
 292 }
 293
 294 =item receiveorder
 295
 296   &receiveorder($biblionumber, $ordernumber, $quantityreceived, $user,
 297         $unitprice, $booksellerinvoicenumber, $biblioitemnumber,
 298         $freight, $bookfund, $rrp);
 299
 300 Updates an order, to reflect the fact that it was received, at least
 301 in part. All arguments not mentioned below update the fields with the
 302 same name in the aqorders table of the Koha database.
 303
 304 Updates the order with bibilionumber C<$biblionumber> and ordernumber
 305 C<$ordernumber>.
 306
 307 Also updates the book fund ID in the aqorderbreakdown table.
 308
 309 =cut
 310 #'
 311 sub receiveorder {
 312         my ($biblio,$ordnum,$quantrec,$user,$cost,$invoiceno,$freight,$rrp)=@_;
 313         my $dbh = C4::Context->dbh;
 314         my $sth=$dbh->prepare("update aqorders set quantityreceived=?,datereceived=now(),booksellerinvoicenumber=?,
 315                                                                                         unitprice=?,freight=?,rrp=?
 316                                                         where biblionumber=? and ordernumber=?");
 317         $sth->execute($quantrec,$invoiceno,$cost,$freight,$rrp,$biblio,$ordnum);
 318         $sth->finish;
 319 }
 320
 321 =item updaterecorder
 322
 323   &updaterecorder($biblionumber, $ordernumber, $user, $unitprice,
 324         $bookfundid, $rrp);
 325
 326 Updates the order with biblionumber C<$biblionumber> and order number
 327 C<$ordernumber>. C<$bookfundid> is the new value for the book fund ID
 328 in the aqorderbreakdown table of the Koha database. All other
 329 arguments update the fields with the same name in the aqorders table.
 330
 331 C<$user> is ignored.
 332
 333 =cut
 334 #'
 335 sub updaterecorder{
 336   my($biblio,$ordnum,$user,$cost,$bookfund,$rrp)=@_;
 337   my $dbh = C4::Context->dbh;
 338   my $sth=$dbh->prepare("update aqorders set
 339   unitprice=?, rrp=?
 340   where biblionumber=? and ordernumber=?
 341   ");
 342   $sth->execute($cost,$rrp,$biblio,$ordnum);
 343   $sth->finish;
 344   $sth=$dbh->prepare("update aqorderbreakdown set bookfundid=? where ordernumber=?");
 345   $sth->execute($bookfund,$ordnum);
 346   $sth->finish;
 347 }
 348
 349 #
 350 #
 351 # ORDERS
 352 #
 353 #
 354
 355 =item getorders
 356
 357   ($count, $orders) = &getorders($booksellerid);
 358
 359 Finds pending orders from the bookseller with the given ID. Ignores
 360 completed and cancelled orders.
 361
 362 C<$count> is the number of elements in C<@{$orders}>.
 363
 364 C<$orders> is a reference-to-array; each element is a
 365 reference-to-hash with the following fields:
 366
 367 =over 4
 368
 369 =item C<count(*)>
 370
 371 Gives the number of orders in with this basket number.
 372
 373 =item C<authorizedby>
 374
 375 =item C<entrydate>
 376
 377 =item C<basketno>
 378
 379 These give the value of the corresponding field in the aqorders table
 380 of the Koha database.
 381
 382 =back
 383
 384 Results are ordered from most to least recent.
 385
 386 =cut
 387 #'
 388 sub getorders {
 389         my ($supplierid)=@_;
 390         my $dbh = C4::Context->dbh;
 391         my $sth=$dbh->prepare("Select count(*),authorisedby,creationdate,aqbasket.basketno,closedate from aqorders left join aqbasket on
 392         aqbasket.basketno=aqorders.basketno where booksellerid=? and (quantity > quantityreceived or
 393         quantityreceived is NULL)
 394         group by basketno order by aqbasket.basketno");
 395         $sth->execute($supplierid);
 396         my @results = ();
 397         while (my $data=$sth->fetchrow_hashref){
 398                 push(@results,$data);
 399         }
 400         $sth->finish;
 401         return (scalar(@results),\@results);
 402 }
 403
 404 =item getorder
 405
 406   ($order, $ordernumber) = &getorder($biblioitemnumber, $biblionumber);
 407
 408 Looks up the order with the given biblionumber and biblioitemnumber.
 409
 410 Returns a two-element array. C<$ordernumber> is the order number.
 411 C<$order> is a reference-to-hash describing the order; its keys are
 412 fields from the biblio, biblioitems, aqorders, and aqorderbreakdown
 413 tables of the Koha database.
 414
 415 =cut
 416
 417 sub getorder{
 418   my ($bi,$bib)=@_;
 419   my $dbh = C4::Context->dbh;
 420   my $sth=$dbh->prepare("Select ordernumber from aqorders where biblionumber=? and biblioitemnumber=?");
 421   $sth->execute($bib,$bi);
 422   # FIXME - Use fetchrow_array(), since we're only interested in the one
 423   # value.
 424   my $ordnum=$sth->fetchrow_hashref;
 425   $sth->finish;
 426   my $order=getsingleorder($ordnum->{'ordernumber'});
 427   return ($order,$ordnum->{'ordernumber'});
 428 }
 429
 430 =item getsingleorder
 431
 432   $order = &getsingleorder($ordernumber);
 433
 434 Looks up an order by order number.
 435
 436 Returns a reference-to-hash describing the order. The keys of
 437 C<$order> are fields from the biblio, biblioitems, aqorders, and
 438 aqorderbreakdown tables of the Koha database.
 439
 440 =cut
 441
 442 sub getsingleorder {
 443   my ($ordnum)=@_;
 444   my $dbh = C4::Context->dbh;
 445   my $sth=$dbh->prepare("Select * from biblio,biblioitems,aqorders left join aqorderbreakdown
 446   on aqorders.ordernumber=aqorderbreakdown.ordernumber
 447   where aqorders.ordernumber=?
 448   and biblio.biblionumber=aqorders.biblionumber and
 449   biblioitems.biblioitemnumber=aqorders.biblioitemnumber");
 450   $sth->execute($ordnum);
 451   my $data=$sth->fetchrow_hashref;
 452   $sth->finish;
 453   return($data);
 454 }
 455
 456 =item getallorders
 457
 458   ($count, @results) = &getallorders($booksellerid);
 459
 460 Looks up all of the pending orders from the supplier with the given
 461 bookseller ID. Ignores cancelled and completed orders.
 462
 463 C<$count> is the number of elements in C<@results>. C<@results> is an
 464 array of references-to-hash. The keys of each element are fields from
 465 the aqorders, biblio, and biblioitems tables of the Koha database.
 466
 467 C<@results> is sorted alphabetically by book title.
 468
 469 =cut
 470 #'
 471 sub getallorders {
 472   #gets all orders from a certain supplier, orders them alphabetically
 473   my ($supid)=@_;
 474   my $dbh = C4::Context->dbh;
 475   my @results = ();
 476   my $sth=$dbh->prepare("Select * from aqorders,biblio,biblioitems where booksellerid=?
 477   and (cancelledby is NULL or cancelledby = '')
 478   and (quantityreceived < quantity or quantityreceived is NULL)
 479   and biblio.biblionumber=aqorders.biblionumber and biblioitems.biblioitemnumber=
 480   aqorders.biblioitemnumber
 481   group by aqorders.biblioitemnumber
 482   order by
 483   biblio.title");
 484   $sth->execute($supid);
 485   while (my $data=$sth->fetchrow_hashref){
 486     push(@results,$data);
 487   }
 488   $sth->finish;
 489   return(scalar(@results),@results);
 490 }
 491
 492 # FIXME - Never used
 493 sub getrecorders {
 494   #gets all orders from a certain supplier, orders them alphabetically
 495   my ($supid)=@_;
 496   my $dbh = C4::Context->dbh;
 497   my @results= ();
 498   my $sth=$dbh->prepare("Select * from aqorders,biblio,biblioitems where booksellerid=?
 499   and (cancelledby is NULL or cancelledby = '')
 500   and biblio.biblionumber=aqorders.biblionumber and biblioitems.biblioitemnumber=
 501   aqorders.biblioitemnumber and
 502   aqorders.quantityreceived>0
 503   and aqorders.datereceived >=now()
 504   group by aqorders.biblioitemnumber
 505   order by
 506   biblio.title");
 507   $sth->execute($supid);
 508   while (my $data=$sth->fetchrow_hashref){
 509     push(@results,$data);
 510   }
 511   $sth->finish;
 512   return(scalar(@results),@results);
 513 }
 514
 515 =item ordersearch
 516
 517   ($count, @results) = &ordersearch($search, $biblionumber, $complete);
 518
 519 Searches for orders.
 520
 521 C<$search> may take one of several forms: if it is an ISBN,
 522 C<&ordersearch> returns orders with that ISBN. If C<$search> is an
 523 order number, C<&ordersearch> returns orders with that order number
 524 and biblionumber C<$biblionumber>. Otherwise, C<$search> is considered
 525 to be a space-separated list of search terms; in this case, all of the
 526 terms must appear in the title (matching the beginning of title
 527 words).
 528
 529 If C<$complete> is C<yes>, the results will include only completed
 530 orders. In any case, C<&ordersearch> ignores cancelled orders.
 531
 532 C<&ordersearch> returns an array. C<$count> is the number of elements
 533 in C<@results>. C<@results> is an array of references-to-hash with the
 534 following keys:
 535
 536 =over 4
 537
 538 =item C<author>
 539
 540 =item C<seriestitle>
 541
 542 =item C<branchcode>
 543
 544 =item C<bookfundid>
 545
 546 =back
 547
 548 =cut
 549 #'
 550 sub ordersearch {
 551         my ($search,$id,$biblio,$catview) = @_;
 552         my $dbh   = C4::Context->dbh;
 553         my @data  = split(' ',$search);
 554         my @searchterms = ($id);
 555         map { push(@searchterms,"$_%","% $_%") } @data;
 556         push(@searchterms,$search,$search,$biblio);
 557         my $sth=$dbh->prepare("Select *,biblio.title from aqorders,biblioitems,biblio,aqbasket
 558                 where aqorders.biblioitemnumber = biblioitems.biblioitemnumber and
 559                 aqorders.basketno = aqbasket.basketno
 560                 and aqbasket.booksellerid = ?
 561                 and biblio.biblionumber=aqorders.biblionumber
 562                 and ((datecancellationprinted is NULL)
 563                 or (datecancellationprinted = '0000-00-00'))
 564                 and (("
 565                 .(join(" and ",map { "(biblio.title like ? or biblio.title like ?)" } @data))
 566                 .") or biblioitems.isbn=? or (aqorders.ordernumber=? and aqorders.biblionumber=?)) "
 567                 .(($catview ne 'yes')?" and (quantityreceived < quantity or quantityreceived is NULL)":"")
 568                 ." group by aqorders.ordernumber");
 569         $sth->execute(@searchterms);
 570         my @results = ();
 571         my $sth2=$dbh->prepare("Select * from biblio where biblionumber=?");
 572         my $sth3=$dbh->prepare("Select * from aqorderbreakdown where ordernumber=?");
 573         while (my $data=$sth->fetchrow_hashref){
 574                 $sth2->execute($data->{'biblionumber'});
 575                 my $data2=$sth2->fetchrow_hashref;
 576                 $data->{'author'}=$data2->{'author'};
 577                 $data->{'seriestitle'}=$data2->{'seriestitle'};
 578                 $sth3->execute($data->{'ordernumber'});
 579                 my $data3=$sth3->fetchrow_hashref;
 580                 $data->{'branchcode'}=$data3->{'branchcode'};
 581                 $data->{'bookfundid'}=$data3->{'bookfundid'};
 582                 push(@results,$data);
 583         }
 584         $sth->finish;
 585         $sth2->finish;
 586         $sth3->finish;
 587         return(scalar(@results),@results);
 588 }
 589
 590 #
 591 #
 592 # MONEY
 593 #
 594 #
 595 =item invoice
 596
 597   ($count, @results) = &invoice($booksellerinvoicenumber);
 598
 599 Looks up orders by invoice number.
 600
 601 Returns an array. C<$count> is the number of elements in C<@results>.
 602 C<@results> is an array of references-to-hash; the keys of each
 603 elements are fields from the aqorders, biblio, and biblioitems tables
 604 of the Koha database.
 605
 606 =cut
 607 #'
 608 sub invoice {
 609   my ($invoice)=@_;
 610   my $dbh = C4::Context->dbh;
 611   my @results = ();
 612   my $sth=$dbh->prepare("Select * from aqorders,biblio,biblioitems where
 613   booksellerinvoicenumber=?
 614   and biblio.biblionumber=aqorders.biblionumber and biblioitems.biblioitemnumber=
 615   aqorders.biblioitemnumber group by aqorders.ordernumber,aqorders.biblioitemnumber");
 616   $sth->execute($invoice);
 617   while (my $data=$sth->fetchrow_hashref){
 618     push(@results,$data);
 619   }
 620   $sth->finish;
 621   return(scalar(@results),@results);
 622 }
 623
 624 =item bookfunds
 625
 626   ($count, @results) = &bookfunds();
 627
 628 Returns a list of all book funds.
 629
 630 C<$count> is the number of elements in C<@results>. C<@results> is an
 631 array of references-to-hash, whose keys are fields from the aqbookfund
 632 and aqbudget tables of the Koha database. Results are ordered
 633 alphabetically by book fund name.
 634
 635 =cut
 636 #'
 637 sub bookfunds {
 638   my $dbh = C4::Context->dbh;
 639   my $sth=$dbh->prepare("Select * from aqbookfund,aqbudget where aqbookfund.bookfundid
 640   =aqbudget.bookfundid
 641   group by aqbookfund.bookfundid order by bookfundname");
 642   $sth->execute;
 643   my @results = ();
 644   while (my $data=$sth->fetchrow_hashref){
 645     push(@results,$data);
 646   }
 647   $sth->finish;
 648   return(scalar(@results),@results);
 649 }
 650
 651 =item bookfundbreakdown
 652
 653         returns the total comtd & spent for a given bookfund
 654         used in acqui-home.pl
 655 =cut
 656 #'
 657
 658 sub bookfundbreakdown {
 659   my ($id)=@_;
 660   my $dbh = C4::Context->dbh;
 661   my $sth=$dbh->prepare("Select quantity,datereceived,freight,unitprice,listprice,ecost,quantityreceived,subscription
 662   from aqorders,aqorderbreakdown where bookfundid=? and
 663   aqorders.ordernumber=aqorderbreakdown.ordernumber
 664   and (datecancellationprinted is NULL or
 665   datecancellationprinted='0000-00-00')");
 666   $sth->execute($id);
 667   my $comtd=0;
 668   my $spent=0;
 669   while (my $data=$sth->fetchrow_hashref){
 670     if ($data->{'subscription'} == 1){
 671       $spent+=$data->{'quantity'}*$data->{'unitprice'};
 672     } else {
 673       my $leftover=$data->{'quantity'}-$data->{'quantityreceived'};
 674       $comtd+=($data->{'ecost'})*$leftover;
 675       $spent+=($data->{'unitprice'})*$data->{'quantityreceived'};
 676     }
 677   }
 678   $sth->finish;
 679   return($spent,$comtd);
 680 }
 681
 682
 683
 684 =item curconvert
 685
 686   $foreignprice = &curconvert($currency, $localprice);
 687
 688 Converts the price C<$localprice> to foreign currency C<$currency> by
 689 dividing by the exchange rate, and returns the result.
 690
 691 If no exchange rate is found, C<&curconvert> assumes the rate is one
 692 to one.
 693
 694 =cut
 695 #'
 696 sub curconvert {
 697   my ($currency,$price)=@_;
 698   my $dbh = C4::Context->dbh;
 699   my $sth=$dbh->prepare("Select rate from currency where currency=?");
 700   $sth->execute($currency);
 701   my $cur=($sth->fetchrow_array())[0];
 702   $sth->finish;
 703   if ($cur==0){
 704     $cur=1;
 705   }
 706   return($price / $cur);
 707 }
 708
 709 =item getcurrencies
 710
 711   ($count, $currencies) = &getcurrencies();
 712
 713 Returns the list of all known currencies.
 714
 715 C<$count> is the number of elements in C<$currencies>. C<$currencies>
 716 is a reference-to-array; its elements are references-to-hash, whose
 717 keys are the fields from the currency table in the Koha database.
 718
 719 =cut
 720 #'
 721 sub getcurrencies {
 722   my $dbh = C4::Context->dbh;
 723   my $sth=$dbh->prepare("Select * from currency");
 724   $sth->execute;
 725   my @results = ();
 726   while (my $data=$sth->fetchrow_hashref){
 727     push(@results,$data);
 728   }
 729   $sth->finish;
 730   return(scalar(@results),\@results);
 731 }
 732
 733 =item updatecurrencies
 734
 735   &updatecurrencies($currency, $newrate);
 736
 737 Sets the exchange rate for C<$currency> to be C<$newrate>.
 738
 739 =cut
 740 #'
 741 sub updatecurrencies {
 742   my ($currency,$rate)=@_;
 743   my $dbh = C4::Context->dbh;
 744   my $sth=$dbh->prepare("update currency set rate=? where currency=?");
 745   $sth->execute($rate,$currency);
 746   $sth->finish;
 747 }
 748
 749 #
 750 #
 751 # OTHERS
 752 #
 753 #
 754
 755 =item bookseller
 756
 757   ($count, @results) = &bookseller($searchstring);
 758
 759 Looks up a book seller. C<$searchstring> may be either a book seller
 760 ID, or a string to look for in the book seller's name.
 761
 762 C<$count> is the number of elements in C<@results>. C<@results> is an
 763 array of references-to-hash, whose keys are the fields of of the
 764 aqbooksellers table in the Koha database.
 765
 766 =cut
 767 #'
 768 sub bookseller {
 769   my ($searchstring)=@_;
 770   my $dbh = C4::Context->dbh;
 771   my $sth=$dbh->prepare("Select * from aqbooksellers where name like ? or id = ?");
 772   $sth->execute("$searchstring%",$searchstring);
 773   my @results;
 774   while (my $data=$sth->fetchrow_hashref){
 775     push(@results,$data);
 776   }
 777   $sth->finish;
 778   return(scalar(@results),@results);
 779 }
 780
 781 =item breakdown
 782
 783   ($count, $results) = &breakdown($ordernumber);
 784
 785 Looks up an order by order ID, and returns its breakdown.
 786
 787 C<$count> is the number of elements in C<$results>. C<$results> is a
 788 reference-to-array; its elements are references-to-hash, whose keys
 789 are the fields of the aqorderbreakdown table in the Koha database.
 790
 791 =cut
 792 #'
 793 sub breakdown {
 794   my ($id)=@_;
 795   my $dbh = C4::Context->dbh;
 796   my $sth=$dbh->prepare("Select * from aqorderbreakdown where ordernumber=?");
 797   $sth->execute($id);
 798   my @results = ();
 799   while (my $data=$sth->fetchrow_hashref){
 800     push(@results,$data);
 801   }
 802   $sth->finish;
 803   return(scalar(@results),\@results);
 804 }
 805
 806 =item branches
 807
 808   ($count, @results) = &branches();
 809
 810 Returns a list of all library branches.
 811
 812 C<$count> is the number of elements in C<@results>. C<@results> is an
 813 array of references-to-hash, whose keys are the fields of the branches
 814 table of the Koha database.
 815
 816 =cut
 817 #'
 818 sub branches {
 819     my $dbh   = C4::Context->dbh;
 820     my $sth   = $dbh->prepare("Select * from branches order by branchname");
 821     my @results = ();
 822
 823     $sth->execute();
 824     while (my $data = $sth->fetchrow_hashref) {
 825         push(@results,$data);
 826     } # while
 827
 828     $sth->finish;
 829     return(scalar(@results), @results);
 830 } # sub branches
 831
 832 =item updatesup
 833
 834   &updatesup($bookseller);
 835
 836 Updates the information for a given bookseller. C<$bookseller> is a
 837 reference-to-hash whose keys are the fields of the aqbooksellers table
 838 in the Koha database. It must contain entries for all of the fields.
 839 The entry to modify is determined by C<$bookseller-E<gt>{id}>.
 840
 841 The easiest way to get all of the necessary fields is to look up a
 842 book seller with C<&booksellers>, modify what's necessary, then call
 843 C<&updatesup> with the result.
 844
 845 =cut
 846 #'
 847 sub updatesup {
 848    my ($data)=@_;
 849    my $dbh = C4::Context->dbh;
 850    my $sth=$dbh->prepare("Update aqbooksellers set
 851    name=?,address1=?,address2=?,address3=?,address4=?,postal=?,
 852    phone=?,fax=?,url=?,contact=?,contpos=?,contphone=?,contfax=?,contaltphone=?,
 853    contemail=?,contnotes=?,active=?,
 854    listprice=?, invoiceprice=?,gstreg=?, listincgst=?,
 855    invoiceincgst=?, specialty=?,discount=?,invoicedisc=?,
 856    nocalc=?
 857    where id=?");
 858    $sth->execute($data->{'name'},$data->{'address1'},$data->{'address2'},
 859    $data->{'address3'},$data->{'address4'},$data->{'postal'},$data->{'phone'},
 860    $data->{'fax'},$data->{'url'},$data->{'contact'},$data->{'contpos'},
 861    $data->{'contphone'},$data->{'contfax'},$data->{'contaltphone'},
 862    $data->{'contemail'},
 863    $data->{'contnote'},$data->{'active'},$data->{'listprice'},
 864    $data->{'invoiceprice'},$data->{'gstreg'},$data->{'listincgst'},
 865    $data->{'invoiceincgst'},$data->{'specialty'},$data->{'discount'},
 866    $data->{'invoicedisc'},$data->{'nocalc'},$data->{'id'});
 867    $sth->finish;
 868 }
 869
 870 =item insertsup
 871
 872   $id = &insertsup($bookseller);
 873
 874 Creates a new bookseller. C<$bookseller> is a reference-to-hash whose
 875 keys are the fields of the aqbooksellers table in the Koha database.
 876 All fields must be present.
 877
 878 Returns the ID of the newly-created bookseller.
 879
 880 =cut
 881 #'
 882 sub insertsup {
 883   my ($data)=@_;
 884   my $dbh = C4::Context->dbh;
 885   my $sth=$dbh->prepare("Select max(id) from aqbooksellers");
 886   $sth->execute;
 887   my $data2=$sth->fetchrow_hashref;
 888   $sth->finish;
 889   $data2->{'max(id)'}++;
 890   $sth=$dbh->prepare("Insert into aqbooksellers (id) values (?)");
 891   $sth->execute($data2->{'max(id)'});
 892   $sth->finish;
 893   $data->{'id'}=$data2->{'max(id)'};
 894   updatesup($data);
 895   return($data->{'id'});
 896 }
 897
 898 END { }       # module clean-up code here (global destructor)
 899
 900 1;
 901 __END__
 902
 903 =back
 904
 905 =head1 AUTHOR
 906
 907 Koha Developement team <info@koha.org>
 908
 909 =cut