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