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 C4::Date;
  24 use MARC::Record;
  25 use C4::Suggestions;
  26 # use C4::Biblio;
  27
  28 use vars qw($VERSION @ISA @EXPORT);
  29
  30 # set the version for version checking
  31 $VERSION = do { my @v = '$Revision$' =~ /\d+/g;shift(@v) . "." . join("_", map {sprintf "%03d", $_ } @v); };
  32
  33 =head1 NAME
  34
  35 C4::Acquisition - Koha functions for dealing with orders and acquisitions
  36
  37 =head1 SYNOPSIS
  38
  39   use C4::Acquisition;
  40
  41 =head1 DESCRIPTION
  42
  43 The functions in this module deal with acquisitions, managing book
  44 orders, converting money to different currencies, and so forth.
  45
  46 =head1 FUNCTIONS
  47
  48 =over 2
  49
  50 =cut
  51
  52 @ISA = qw(Exporter);
  53 @EXPORT = qw(
  54                 &getbasket &getbasketcontent &newbasket &closebasket
  55
  56                 &getorders &getallorders &getrecorders
  57                 &getorder &neworder &delorder
  58                 &ordersearch &histsearch
  59                 &modorder &getsingleorder &invoice &receiveorder
  60                 &updaterecorder &newordernum
  61                 &getsupplierlistwithlateorders
  62                 &getlateorders
  63                 &getparcels &getparcelinformation
  64                 &bookfunds &curconvert &getcurrencies &bookfundbreakdown
  65                 &updatecurrencies &getcurrency
  66                 &updatesup &insertsup
  67                 &bookseller &breakdown
  68 );
  69
  70 #
  71 #
  72 #
  73 # BASKETS
  74 #
  75 #
  76 #
  77 =item getbasket
  78
  79   $aqbasket = &getbasket($basketnumber);
  80
  81 get all basket informations in aqbasket for a given basket
  82 =cut
  83
  84 sub getbasket {
  85         my ($basketno)=@_;
  86         my $dbh=C4::Context->dbh;
  87         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=?");
  88         $sth->execute($basketno);
  89         return($sth->fetchrow_hashref);
  90 }
  91
  92 =item getbasketcontent
  93
  94   ($count, @orders) = &getbasketcontent($basketnumber, $booksellerID);
  95
  96 Looks up the pending (non-cancelled) orders with the given basket
  97 number. If C<$booksellerID> is non-empty, only orders from that seller
  98 are returned.
  99
 100 C<&basket> returns a two-element array. C<@orders> is an array of
 101 references-to-hash, whose keys are the fields from the aqorders,
 102 biblio, and biblioitems tables in the Koha database. C<$count> is the
 103 number of elements in C<@orders>.
 104
 105 =cut
 106 #'
 107 sub getbasketcontent {
 108         my ($basketno,$supplier,$orderby)=@_;
 109         my $dbh = C4::Context->dbh;
 110         my $query="Select aqorderbreakdown.*,biblio.*,biblioitems.*,aqorders.*,biblio.title from aqorders,biblio,biblioitems
 111         left join aqorderbreakdown on aqorderbreakdown.ordernumber=aqorders.ordernumber
 112         where basketno='$basketno'
 113         and biblio.biblionumber=aqorders.biblionumber and biblioitems.biblioitemnumber
 114         =aqorders.biblioitemnumber
 115         and (datecancellationprinted is NULL or datecancellationprinted =
 116         '0000-00-00')";
 117         if ($supplier ne ''){
 118                 $query.=" and aqorders.booksellerid='$supplier'";
 119         }
 120
 121         $orderby="biblioitems.publishercode" unless $orderby;
 122         $query.=" order by $orderby";
 123         my $sth=$dbh->prepare($query);
 124         $sth->execute;
 125         my @results;
 126         #  print $query;
 127         my $i=0;
 128         while (my $data=$sth->fetchrow_hashref){
 129                 $results[$i]=$data;
 130                 $i++;
 131         }
 132         $sth->finish;
 133         return($i,@results);
 134 }
 135
 136 =item newbasket
 137
 138   $basket = &newbasket();
 139
 140 Create a new basket in aqbasket table
 141 =cut
 142
 143 sub newbasket {
 144         my ($booksellerid,$authorisedby) = @_;
 145         my $dbh = C4::Context->dbh;
 146         my $sth=$dbh->do("insert into aqbasket (creationdate,booksellerid,authorisedby) values(now(),'$booksellerid','$authorisedby')");
 147         #find & return basketno MYSQL dependant, but $dbh->last_insert_id always returns null :-(
 148         my $basket = $dbh->{'mysql_insertid'};
 149         return($basket);
 150 }
 151
 152 =item closebasket
 153
 154   &newbasket($basketno);
 155
 156 close a basket (becomes unmodifiable,except for recieves
 157 =cut
 158
 159 sub closebasket {
 160         my ($basketno) = @_;
 161         my $dbh = C4::Context->dbh;
 162         my $sth=$dbh->prepare("update aqbasket set closedate=now() where basketno=?");
 163         $sth->execute($basketno);
 164 }
 165
 166 =item neworder
 167
 168   &neworder($basket, $biblionumber, $title, $quantity, $listprice,
 169         $booksellerid, $who, $notes, $bookfund, $biblioitemnumber, $rrp,
 170         $ecost, $gst, $budget, $unitprice, $subscription,
 171         $booksellerinvoicenumber);
 172
 173 Adds a new order to the database. Any argument that isn't described
 174 below is the new value of the field with the same name in the aqorders
 175 table of the Koha database.
 176
 177 C<$ordnum> is a "minimum order number." After adding the new entry to
 178 the aqorders table, C<&neworder> finds the first entry in aqorders
 179 with order number greater than or equal to C<$ordnum>, and adds an
 180 entry to the aqorderbreakdown table, with the order number just found,
 181 and the book fund ID of the newly-added order.
 182
 183 C<$budget> is effectively ignored.
 184
 185 C<$subscription> may be either "yes", or anything else for "no".
 186
 187 =cut
 188 #'
 189 sub neworder {
 190         my ($basketno,$bibnum,$title,$quantity,$listprice,$booksellerid,$authorisedby,$notes,$bookfund,$bibitemnum,$rrp,$ecost,$gst,$budget,$cost,$sub,$invoice,$sort1,$sort2)=@_;
 191         if ($budget eq 'now'){
 192                 $budget="now()";
 193         } else {
 194                 $budget="'2001-07-01'";
 195         }
 196         if ($sub eq 'yes'){
 197                 $sub=1;
 198         } else {
 199                 $sub=0;
 200         }
 201         # if $basket empty, it's also a new basket, create it
 202         unless ($basketno) {
 203                 $basketno=newbasket($booksellerid,$authorisedby);
 204         }
 205         my $dbh = C4::Context->dbh;
 206         my $sth=$dbh->prepare("insert into aqorders
 207                                                                 (biblionumber,title,basketno,quantity,listprice,notes,
 208                                                                 biblioitemnumber,rrp,ecost,gst,unitprice,subscription,sort1,sort2)
 209                                                                 values (?,?,?,?,?,?,?,?,?,?,?,?,?,?)");
 210         $sth->execute($bibnum,$title,$basketno,$quantity,$listprice,$notes,
 211                                         $bibitemnum,$rrp,$ecost,$gst,$cost,$sub,$sort1,$sort2);
 212         $sth->finish;
 213         #get ordnum MYSQL dependant, but $dbh->last_insert_id returns null
 214         my $ordnum = $dbh->{'mysql_insertid'};
 215         $sth=$dbh->prepare("insert into aqorderbreakdown (ordernumber,bookfundid) values
 216         (?,?)");
 217         $sth->execute($ordnum,$bookfund);
 218         $sth->finish;
 219         return $basketno;
 220 }
 221
 222 =item delorder
 223
 224   &delorder($biblionumber, $ordernumber);
 225
 226 Cancel the order with the given order and biblio numbers. It does not
 227 delete any entries in the aqorders table, it merely marks them as
 228 cancelled.
 229
 230 =cut
 231 #'
 232 sub delorder {
 233   my ($bibnum,$ordnum)=@_;
 234   my $dbh = C4::Context->dbh;
 235   my $sth=$dbh->prepare("update aqorders set datecancellationprinted=now()
 236   where biblionumber=? and ordernumber=?");
 237   $sth->execute($bibnum,$ordnum);
 238   $sth->finish;
 239 }
 240
 241 =item modorder
 242
 243   &modorder($title, $ordernumber, $quantity, $listprice,
 244         $biblionumber, $basketno, $supplier, $who, $notes,
 245         $bookfundid, $bibitemnum, $rrp, $ecost, $gst, $budget,
 246         $unitprice, $booksellerinvoicenumber);
 247
 248 Modifies an existing order. Updates the order with order number
 249 C<$ordernumber> and biblionumber C<$biblionumber>. All other arguments
 250 update the fields with the same name in the aqorders table of the Koha
 251 database.
 252
 253 Entries with order number C<$ordernumber> in the aqorderbreakdown
 254 table are also updated to the new book fund ID.
 255
 256 =cut
 257 #'
 258 sub modorder {
 259   my ($title,$ordnum,$quantity,$listprice,$bibnum,$basketno,$supplier,$who,$notes,$bookfund,$bibitemnum,$rrp,$ecost,$gst,$budget,$cost,$invoice,$sort1,$sort2)=@_;
 260   my $dbh = C4::Context->dbh;
 261   my $sth=$dbh->prepare("update aqorders set title=?,
 262   quantity=?,listprice=?,basketno=?,
 263   rrp=?,ecost=?,unitprice=?,booksellerinvoicenumber=?,
 264   notes=?,sort1=?, sort2=?
 265   where
 266   ordernumber=? and biblionumber=?");
 267   $sth->execute($title,$quantity,$listprice,$basketno,$rrp,$ecost,$cost,$invoice,$notes,$sort1,$sort2,$ordnum,$bibnum);
 268   $sth->finish;
 269   $sth=$dbh->prepare("update aqorderbreakdown set bookfundid=? where
 270   ordernumber=?");
 271   unless ($sth->execute($bookfund,$ordnum)) { # zero rows affected [Bug 734]
 272     my $query="insert into aqorderbreakdown (ordernumber,bookfundid) values (?,?)";
 273     $sth=$dbh->prepare($query);
 274     $sth->execute($ordnum,$bookfund);
 275   }
 276   $sth->finish;
 277 }
 278
 279 =item newordernum
 280
 281   $order = &newordernum();
 282
 283 Finds the next unused order number in the aqorders table of the Koha
 284 database, and returns it.
 285
 286 =cut
 287 #'
 288 # FIXME - Race condition
 289 sub newordernum {
 290   my $dbh = C4::Context->dbh;
 291   my $sth=$dbh->prepare("Select max(ordernumber) from aqorders");
 292   $sth->execute;
 293   my $data=$sth->fetchrow_arrayref;
 294   my $ordnum=$$data[0];
 295   $ordnum++;
 296   $sth->finish;
 297   return($ordnum);
 298 }
 299
 300 =item receiveorder
 301
 302   &receiveorder($biblionumber, $ordernumber, $quantityreceived, $user,
 303         $unitprice, $booksellerinvoicenumber, $biblioitemnumber,
 304         $freight, $bookfund, $rrp);
 305
 306 Updates an order, to reflect the fact that it was received, at least
 307 in part. All arguments not mentioned below update the fields with the
 308 same name in the aqorders table of the Koha database.
 309
 310 Updates the order with bibilionumber C<$biblionumber> and ordernumber
 311 C<$ordernumber>.
 312
 313 Also updates the book fund ID in the aqorderbreakdown table.
 314
 315 =cut
 316 #'
 317 sub receiveorder {
 318         my ($biblio,$ordnum,$quantrec,$user,$cost,$invoiceno,$freight,$rrp)=@_;
 319         my $dbh = C4::Context->dbh;
 320         my $sth=$dbh->prepare("update aqorders set quantityreceived=?,datereceived=now(),booksellerinvoicenumber=?,
 321                                                                                         unitprice=?,freight=?,rrp=?
 322                                                         where biblionumber=? and ordernumber=?");
 323         my $suggestionid = findsuggestion_from_biblionumber($dbh,$biblio);
 324         if ($suggestionid) {
 325                 changestatus($suggestionid,'AVAILABLE','',$biblio);
 326         }
 327         $sth->execute($quantrec,$invoiceno,$cost,$freight,$rrp,$biblio,$ordnum);
 328         $sth->finish;
 329 }
 330
 331 =item updaterecorder
 332
 333   &updaterecorder($biblionumber, $ordernumber, $user, $unitprice,
 334         $bookfundid, $rrp);
 335
 336 Updates the order with biblionumber C<$biblionumber> and order number
 337 C<$ordernumber>. C<$bookfundid> is the new value for the book fund ID
 338 in the aqorderbreakdown table of the Koha database. All other
 339 arguments update the fields with the same name in the aqorders table.
 340
 341 C<$user> is ignored.
 342
 343 =cut
 344 #'
 345 sub updaterecorder{
 346   my($biblio,$ordnum,$user,$cost,$bookfund,$rrp)=@_;
 347   my $dbh = C4::Context->dbh;
 348   my $sth=$dbh->prepare("update aqorders set
 349   unitprice=?, rrp=?
 350   where biblionumber=? and ordernumber=?
 351   ");
 352   $sth->execute($cost,$rrp,$biblio,$ordnum);
 353   $sth->finish;
 354   $sth=$dbh->prepare("update aqorderbreakdown set bookfundid=? where ordernumber=?");
 355   $sth->execute($bookfund,$ordnum);
 356   $sth->finish;
 357 }
 358
 359 #
 360 #
 361 # ORDERS
 362 #
 363 #
 364
 365 =item getorders
 366
 367   ($count, $orders) = &getorders($booksellerid);
 368
 369 Finds pending orders from the bookseller with the given ID. Ignores
 370 completed and cancelled orders.
 371
 372 C<$count> is the number of elements in C<@{$orders}>.
 373
 374 C<$orders> is a reference-to-array; each element is a
 375 reference-to-hash with the following fields:
 376
 377 =over 4
 378
 379 =item C<count(*)>
 380
 381 Gives the number of orders in with this basket number.
 382
 383 =item C<authorizedby>
 384
 385 =item C<entrydate>
 386
 387 =item C<basketno>
 388
 389 These give the value of the corresponding field in the aqorders table
 390 of the Koha database.
 391
 392 =back
 393
 394 Results are ordered from most to least recent.
 395
 396 =cut
 397 #'
 398 sub getorders {
 399         my ($supplierid)=@_;
 400         my $dbh = C4::Context->dbh;
 401         my $strsth ="Select count(*),authorisedby,creationdate,aqbasket.basketno,
 402 closedate,surname,firstname,aqorders.title
 403 from aqorders
 404 left join aqbasket on aqbasket.basketno=aqorders.basketno
 405 left join borrowers on aqbasket.authorisedby=borrowers.borrowernumber
 406 where booksellerid=? and (quantity > quantityreceived or
 407 quantityreceived is NULL) and datecancellationprinted is NULL and (to_days(now())-to_days(closedate) < 180 or closedate is null)";
 408         if (C4::Context->preference("IndependantBranches")) {
 409                 my $userenv = C4::Context->userenv;
 410                 if (($userenv)&&($userenv->{flags} != 1)){
 411                         $strsth .= " and (borrowers.branchcode = '".$userenv->{branch}."' or borrowers.branchcode ='')";
 412                 }
 413         }
 414         $strsth.=" group by basketno order by aqbasket.basketno";
 415         my $sth=$dbh->prepare($strsth);
 416         $sth->execute($supplierid);
 417         my @results = ();
 418         while (my $data=$sth->fetchrow_hashref){
 419                 push(@results,$data);
 420         }
 421         $sth->finish;
 422         return (scalar(@results),\@results);
 423 }
 424
 425 =item getorder
 426
 427   ($order, $ordernumber) = &getorder($biblioitemnumber, $biblionumber);
 428
 429 Looks up the order with the given biblionumber and biblioitemnumber.
 430
 431 Returns a two-element array. C<$ordernumber> is the order number.
 432 C<$order> is a reference-to-hash describing the order; its keys are
 433 fields from the biblio, biblioitems, aqorders, and aqorderbreakdown
 434 tables of the Koha database.
 435
 436 =cut
 437
 438 sub getorder{
 439   my ($bi,$bib)=@_;
 440   my $dbh = C4::Context->dbh;
 441   my $sth=$dbh->prepare("Select ordernumber from aqorders where biblionumber=? and biblioitemnumber=?");
 442   $sth->execute($bib,$bi);
 443   # FIXME - Use fetchrow_array(), since we're only interested in the one
 444   # value.
 445   my $ordnum=$sth->fetchrow_hashref;
 446   $sth->finish;
 447   my $order=getsingleorder($ordnum->{'ordernumber'});
 448   return ($order,$ordnum->{'ordernumber'});
 449 }
 450
 451 =item getsingleorder
 452
 453   $order = &getsingleorder($ordernumber);
 454
 455 Looks up an order by order number.
 456
 457 Returns a reference-to-hash describing the order. The keys of
 458 C<$order> are fields from the biblio, biblioitems, aqorders, and
 459 aqorderbreakdown tables of the Koha database.
 460
 461 =cut
 462
 463 sub getsingleorder {
 464   my ($ordnum)=@_;
 465   my $dbh = C4::Context->dbh;
 466   my $sth=$dbh->prepare("Select * from biblio,biblioitems,aqorders left join aqorderbreakdown
 467   on aqorders.ordernumber=aqorderbreakdown.ordernumber
 468   where aqorders.ordernumber=?
 469   and biblio.biblionumber=aqorders.biblionumber and
 470   biblioitems.biblioitemnumber=aqorders.biblioitemnumber");
 471   $sth->execute($ordnum);
 472   my $data=$sth->fetchrow_hashref;
 473   $sth->finish;
 474   return($data);
 475 }
 476
 477 =item getallorders
 478
 479   ($count, @results) = &getallorders($booksellerid);
 480
 481 Looks up all of the pending orders from the supplier with the given
 482 bookseller ID. Ignores cancelled and completed orders.
 483
 484 C<$count> is the number of elements in C<@results>. C<@results> is an
 485 array of references-to-hash. The keys of each element are fields from
 486 the aqorders, biblio, and biblioitems tables of the Koha database.
 487
 488 C<@results> is sorted alphabetically by book title.
 489
 490 =cut
 491 #'
 492 sub getallorders {
 493   #gets all orders from a certain supplier, orders them alphabetically
 494   my ($supplierid)=@_;
 495   my $dbh = C4::Context->dbh;
 496   my @results = ();
 497         my $strsth ="Select count(*),authorisedby,creationdate,aqbasket.basketno,
 498 closedate,surname,firstname,aqorders.biblionumber,aqorders.title, aqorders.ordernumber
 499 from aqorders
 500 left join aqbasket on aqbasket.basketno=aqorders.basketno
 501 left join borrowers on aqbasket.authorisedby=borrowers.borrowernumber
 502 where booksellerid=? and (quantity > quantityreceived or
 503 quantityreceived is NULL) and datecancellationprinted is NULL ";
 504
 505         if (C4::Context->preference("IndependantBranches")) {
 506                 my $userenv = C4::Context->userenv;
 507                 if (($userenv) &&($userenv->{flags} != 1)){
 508                         $strsth .= " and (borrowers.branchcode = '".$userenv->{branch}."' or borrowers.branchcode ='')";
 509                 }
 510         }
 511         $strsth.=" group by basketno order by aqbasket.basketno";
 512         my $sth=$dbh->prepare($strsth);
 513   $sth->execute($supplierid);
 514   while (my $data=$sth->fetchrow_hashref){
 515     push(@results,$data);
 516   }
 517   $sth->finish;
 518   return(scalar(@results),@results);
 519 }
 520 =item getparcelinformation
 521
 522   ($count, @results) = &getparcelinformation($booksellerid, $code, $date);
 523
 524 Looks up all of the received items from the supplier with the given
 525 bookseller ID at the given date, for the given code. Ignores cancelled and completed orders.
 526
 527 C<$count> is the number of elements in C<@results>. C<@results> is an
 528 array of references-to-hash. The keys of each element are fields from
 529 the aqorders, biblio, and biblioitems tables of the Koha database.
 530
 531 C<@results> is sorted alphabetically by book title.
 532
 533 =cut
 534 #'
 535 sub getparcelinformation {
 536   #gets all orders from a certain supplier, orders them alphabetically
 537   my ($supplierid,$code, $datereceived)=@_;
 538   my $dbh = C4::Context->dbh;
 539   my @results = ();
 540   $code .='%' if $code; # add % if we search on a given code (otherwise, let him empty)
 541         my $strsth ="Select authorisedby,creationdate,aqbasket.basketno,closedate,surname,firstname,aqorders.biblionumber,aqorders.title,aqorders.ordernumber, aqorders.quantity, aqorders.quantityreceived, aqorders.unitprice, aqorders.listprice, aqorders.rrp, aqorders.ecost from aqorders,aqbasket left join borrowers on aqbasket.authorisedby=borrowers.borrowernumber where aqbasket.basketno=aqorders.basketno and aqbasket.booksellerid=? and aqorders.booksellerinvoicenumber like  \"$code\" and aqorders.datereceived= \'$datereceived\'";
 542
 543         if (C4::Context->preference("IndependantBranches")) {
 544                 my $userenv = C4::Context->userenv;
 545                 if (($userenv) &&($userenv->{flags} != 1)){
 546                         $strsth .= " and (borrowers.branchcode = '".$userenv->{branch}."' or borrowers.branchcode ='')";
 547                 }
 548         }
 549         $strsth.=" order by aqbasket.basketno";
 550         ### parcelinformation : $strsth
 551         my $sth=$dbh->prepare($strsth);
 552   $sth->execute($supplierid);
 553   while (my $data=$sth->fetchrow_hashref){
 554     push(@results,$data);
 555   }
 556   my $count =scalar(@results);
 557   ### countparcelbiblio: $count
 558   $sth->finish;
 559
 560   return(scalar(@results),@results);
 561 }
 562 =item getsupplierlistwithlateorders
 563
 564   %results = &getsupplierlistwithlateorders;
 565
 566 Searches for suppliers with late orders.
 567
 568 =cut
 569 #'
 570 sub getsupplierlistwithlateorders {
 571         my $delay=shift;
 572         my $dbh = C4::Context->dbh;
 573 #FIXME NOT quite sure that this operation is valid for DBMs different from Mysql, HOPING so
 574 #should be tested with other DBMs
 575
 576         my $strsth;
 577         my $dbdriver = C4::Context->config("db_scheme")||"mysql";
 578         if ($dbdriver eq "mysql"){
 579                 $strsth="SELECT DISTINCT aqbasket.booksellerid, aqbooksellers.name
 580                                         FROM aqorders, aqbasket
 581                                         LEFT JOIN aqbooksellers ON aqbasket.booksellerid = aqbooksellers.id
 582                                         WHERE aqorders.basketno = aqbasket.basketno AND
 583                                         (closedate < DATE_SUB(CURDATE( ),INTERVAL $delay DAY) AND (datereceived = '' or datereceived is null))
 584                                         ";
 585         }else {
 586                 $strsth="SELECT DISTINCT aqbasket.booksellerid, aqbooksellers.name
 587                         FROM aqorders, aqbasket
 588                         LEFT JOIN aqbooksellers ON aqbasket.aqbooksellerid = aqbooksellers.id
 589                         WHERE aqorders.basketno = aqbasket.basketno AND
 590                         (closedate < (CURDATE( )-(INTERVAL $delay DAY))) AND (datereceived = '' or datereceived is null))
 591                         ";
 592         }
 593 #       warn "C4::Acquisition getsupplierlistwithlateorders : ".$strsth;
 594         my $sth = $dbh->prepare($strsth);
 595         $sth->execute;
 596         my %supplierlist;
 597         while (my ($id,$name) = $sth->fetchrow) {
 598                 $supplierlist{$id} = $name;
 599         }
 600         return %supplierlist;
 601 }
 602
 603 =item getlateorders
 604
 605   %results = &getlateorders;
 606
 607 Searches for suppliers with late orders.
 608
 609 =cut
 610 #'
 611 sub getlateorders {
 612         my $delay=shift;
 613         my $supplierid = shift;
 614         my $branch = shift;
 615
 616         my $dbh = C4::Context->dbh;
 617 #BEWARE, order of parenthesis and LEFT JOIN is important for speed
 618         my $strsth;
 619         my $dbdriver = C4::Context->config("db_scheme")||"mysql";
 620 #       warn " $dbdriver";
 621         if ($dbdriver eq "mysql"){
 622                 $strsth ="SELECT aqbasket.basketno,
 623                                         DATE(aqbasket.closedate) as orderdate, aqorders.quantity - IFNULL(aqorders.quantityreceived,0) as quantity, aqorders.rrp as unitpricesupplier,aqorders.ecost as unitpricelib,
 624                                         (aqorders.quantity - IFNULL(aqorders.quantityreceived,0)) * aqorders.rrp as subtotal, aqbookfund.bookfundname as budget, borrowers.branchcode as branch,
 625                                         aqbooksellers.name as supplier,
 626                                         aqorders.title, biblio.author, biblioitems.publishercode as publisher, biblioitems.publicationyear,
 627                                         DATEDIFF(CURDATE( ),closedate) AS latesince
 628                                         FROM
 629                                                 ((      (
 630                                                                 (aqorders LEFT JOIN biblio on biblio.biblionumber = aqorders.biblionumber) LEFT JOIN biblioitems on  biblioitems.biblionumber=biblio.biblionumber
 631                                                         )  LEFT JOIN aqorderbreakdown on aqorders.ordernumber = aqorderbreakdown.ordernumber
 632                                                 ) LEFT JOIN aqbookfund on aqorderbreakdown.bookfundid = aqbookfund.bookfundid
 633                                                 ),(aqbasket LEFT JOIN borrowers on aqbasket.authorisedby = borrowers.borrowernumber) LEFT JOIN aqbooksellers ON aqbasket.booksellerid = aqbooksellers.id
 634                                         WHERE aqorders.basketno = aqbasket.basketno AND (closedate < DATE_SUB(CURDATE( ),INTERVAL $delay DAY))
 635                                         AND ((datereceived = '' OR datereceived is null) OR (aqorders.quantityreceived < aqorders.quantity) ) ";
 636                 $strsth .= " AND aqbasket.booksellerid = $supplierid " if ($supplierid);
 637                 $strsth .= " AND borrowers.branchcode like \'".$branch."\'" if ($branch);
 638                 $strsth .= " AND borrowers.branchcode like \'".C4::Context->userenv->{branch}."\'" if (C4::Context->preference("IndependantBranches") && C4::Context->userenv && C4::Context->userenv->{flags}!=1);
 639                 $strsth .= " HAVING quantity<>0 AND unitpricesupplier<>0 AND unitpricelib<>0 ORDER BY latesince,basketno,borrowers.branchcode, supplier ";
 640         } else {
 641                 $strsth ="SELECT aqbasket.basketno,
 642                                         DATE(aqbasket.closedate) as orderdate,
 643                                         aqorders.quantity, aqorders.rrp as unitpricesupplier,aqorders.ecost as unitpricelib, aqorders.quantity * aqorders.rrp as subtotal
 644                                         aqbookfund.bookfundname as budget, borrowers.branchcode as branch,
 645                                         aqbooksellers.name as supplier,
 646                                         biblio.title, biblio.author, biblioitems.publishercode as publisher, biblioitems.publicationyear,
 647                                         (CURDATE -  closedate) AS latesince
 648                                         FROM
 649                                                 ((      (
 650                                                                 (aqorders LEFT JOIN biblio on biblio.biblionumber = aqorders.biblionumber) LEFT JOIN biblioitems on  biblioitems.biblionumber=biblio.biblionumber
 651                                                         )  LEFT JOIN aqorderbreakdown on aqorders.ordernumber = aqorderbreakdown.ordernumber
 652                                                 ) LEFT JOIN aqbookfund on aqorderbreakdown.bookfundid = aqbookfund.bookfundid
 653                                                 ),(aqbasket LEFT JOIN borrowers on aqbasket.authorisedby = borrowers.borrowernumber) LEFT JOIN aqbooksellers ON aqbasket.booksellerid = aqbooksellers.id
 654                                         WHERE aqorders.basketno = aqbasket.basketno AND (closedate < (CURDATE -(INTERVAL $delay DAY))
 655                                         AND ((datereceived = '' OR datereceived is null) OR (aqorders.quantityreceived < aqorders.quantity) ) ";
 656                 $strsth .= " AND aqbasket.booksellerid = $supplierid " if ($supplierid);
 657                 $strsth .= " AND borrowers.branchcode like \'".$branch."\'" if ($branch);
 658                 $strsth .= " AND borrowers.branchcode like \'".C4::Context->userenv->{branch}."\'" if (C4::Context->preference("IndependantBranches") && C4::Context->userenv->{flags}!=1);
 659                 $strsth .= " ORDER BY latesince,basketno,borrowers.branchcode, supplier";
 660         }
 661         warn "C4::Acquisition : getlateorders SQL:".$strsth;
 662         my $sth = $dbh->prepare($strsth);
 663         $sth->execute;
 664         my @results;
 665         my $hilighted = 1;
 666         while (my $data = $sth->fetchrow_hashref) {
 667                 $data->{hilighted}=$hilighted if ($hilighted>0);
 668                 $data->{orderdate} = format_date($data->{orderdate});
 669                 push @results, $data;
 670                 $hilighted= -$hilighted;
 671         }
 672         $sth->finish;
 673         return(scalar(@results),@results);
 674 }
 675
 676 # FIXME - Never used
 677 sub getrecorders {
 678   #gets all orders from a certain supplier, orders them alphabetically
 679   my ($supid)=@_;
 680   my $dbh = C4::Context->dbh;
 681   my @results= ();
 682   my $sth=$dbh->prepare("Select * from aqorders,biblio,biblioitems where booksellerid=?
 683   and (cancelledby is NULL or cancelledby = '')
 684   and biblio.biblionumber=aqorders.biblionumber and biblioitems.biblioitemnumber=
 685   aqorders.biblioitemnumber and
 686   aqorders.quantityreceived>0
 687   and aqorders.datereceived >=now()
 688   group by aqorders.biblioitemnumber
 689   order by
 690   biblio.title");
 691   $sth->execute($supid);
 692   while (my $data=$sth->fetchrow_hashref){
 693     push(@results,$data);
 694   }
 695   $sth->finish;
 696   return(scalar(@results),@results);
 697 }
 698
 699 =item ordersearch
 700
 701   ($count, @results) = &ordersearch($search, $biblionumber, $complete);
 702
 703 Searches for orders.
 704
 705 C<$search> may take one of several forms: if it is an ISBN,
 706 C<&ordersearch> returns orders with that ISBN. If C<$search> is an
 707 order number, C<&ordersearch> returns orders with that order number
 708 and biblionumber C<$biblionumber>. Otherwise, C<$search> is considered
 709 to be a space-separated list of search terms; in this case, all of the
 710 terms must appear in the title (matching the beginning of title
 711 words).
 712
 713 If C<$complete> is C<yes>, the results will include only completed
 714 orders. In any case, C<&ordersearch> ignores cancelled orders.
 715
 716 C<&ordersearch> returns an array. C<$count> is the number of elements
 717 in C<@results>. C<@results> is an array of references-to-hash with the
 718 following keys:
 719
 720 =over 4
 721
 722 =item C<author>
 723
 724 =item C<seriestitle>
 725
 726 =item C<branchcode>
 727
 728 =item C<bookfundid>
 729
 730 =back
 731
 732 =cut
 733 #'
 734 sub ordersearch {
 735         my ($search,$id,$biblio,$catview) = @_;
 736         my $dbh   = C4::Context->dbh;
 737         my @data  = split(' ',$search);
 738         my @searchterms = ($id);
 739         map { push(@searchterms,"$_%","% $_%") } @data;
 740         push(@searchterms,$search,$search,$biblio);
 741         my $sth=$dbh->prepare("Select biblio.*,biblioitems.*,aqorders.*,aqbasket.*,biblio.title from aqorders,biblioitems,biblio,aqbasket
 742                 where aqorders.biblioitemnumber = biblioitems.biblioitemnumber and
 743                 aqorders.basketno = aqbasket.basketno
 744                 and aqbasket.booksellerid = ?
 745                 and biblio.biblionumber=aqorders.biblionumber
 746                 and ((datecancellationprinted is NULL)
 747                 or (datecancellationprinted = '0000-00-00'))
 748                 and (("
 749                 .(join(" and ",map { "(biblio.title like ? or biblio.title like ?)" } @data))
 750                 .") or biblioitems.isbn=? or (aqorders.ordernumber=? and aqorders.biblionumber=?)) "
 751                 .(($catview ne 'yes')?" and (quantityreceived < quantity or quantityreceived is NULL)":"")
 752                 ." group by aqorders.ordernumber");
 753         $sth->execute(@searchterms);
 754         my @results = ();
 755         my $sth2=$dbh->prepare("Select * from biblio where biblionumber=?");
 756         my $sth3=$dbh->prepare("Select * from aqorderbreakdown where ordernumber=?");
 757         while (my $data=$sth->fetchrow_hashref){
 758                 $sth2->execute($data->{'biblionumber'});
 759                 my $data2=$sth2->fetchrow_hashref;
 760                 $data->{'author'}=$data2->{'author'};
 761                 $data->{'seriestitle'}=$data2->{'seriestitle'};
 762                 $sth3->execute($data->{'ordernumber'});
 763                 my $data3=$sth3->fetchrow_hashref;
 764                 $data->{'branchcode'}=$data3->{'branchcode'};
 765                 $data->{'bookfundid'}=$data3->{'bookfundid'};
 766                 push(@results,$data);
 767         }
 768         $sth->finish;
 769         $sth2->finish;
 770         $sth3->finish;
 771         return(scalar(@results),@results);
 772 }
 773
 774
 775 sub histsearch {
 776         my ($title,$author,$name,$from_placed_on,$to_placed_on)=@_;
 777         my @order_loop;
 778         my $total_qty=0;
 779         my $total_qtyreceived=0;
 780         my $total_price=0;
 781         # don't run the query if there are no parameters (list would be too long for sure !
 782         if ($title || $author || $name || $from_placed_on || $to_placed_on) {
 783                 my $dbh= C4::Context->dbh;
 784                 my $query = "select biblio.title,biblio.author,aqorders.basketno,name,aqbasket.creationdate,aqorders.datereceived, aqorders.quantity, aqorders.quantityreceived, aqorders.ecost from aqorders,aqbasket,aqbooksellers,biblio";
 785                 $query .= ",borrowers " if (C4::Context->preference("IndependantBranches"));
 786                 $query .=" where aqorders.basketno=aqbasket.basketno and aqbasket.booksellerid=aqbooksellers.id and biblio.biblionumber=aqorders.biblionumber ";
 787                 $query .= " and aqbasket.authorisedby=borrowers.borrowernumber" if (C4::Context->preference("IndependantBranches"));
 788                 $query .= " and biblio.title like ".$dbh->quote("%".$title."%") if $title;
 789                 $query .= " and biblio.author like ".$dbh->quote("%".$author."%") if $author;
 790                 $query .= " and name like ".$dbh->quote("%".$name."%") if $name;
 791                 $query .= " and creationdate >" .$dbh->quote($from_placed_on) if $from_placed_on;
 792                 $query .= " and creationdate<".$dbh->quote($to_placed_on) if $to_placed_on;
 793                 if (C4::Context->preference("IndependantBranches")) {
 794                         my $userenv = C4::Context->userenv;
 795                         if (($userenv) &&($userenv->{flags} != 1)){
 796                                 $query .= " and (borrowers.branchcode = '".$userenv->{branch}."' or borrowers.branchcode ='')";
 797                         }
 798                 }
 799                 $query .=" order by booksellerid";
 800                 warn "query histearch: ".$query;
 801                 my $sth = $dbh->prepare($query);
 802                 $sth->execute;
 803                 my $cnt=1;
 804                 while (my $line = $sth->fetchrow_hashref) {
 805                         $line->{count}=$cnt++;
 806                         $line->{toggle}=1 if $cnt %2;
 807                         push @order_loop, $line;
 808                         $line->{creationdate} = format_date($line->{creationdate});
 809                         $line->{datereceived} = format_date($line->{datereceived});
 810                         $total_qty += $line->{'quantity'};
 811                         $total_qtyreceived += $line->{'quantityreceived'};
 812                         $total_price += $line->{'quantity'}*$line->{'ecost'};
 813                 }
 814         }
 815         return \@order_loop,$total_qty,$total_price,$total_qtyreceived;
 816 }
 817
 818 #
 819 #
 820 # MONEY
 821 #
 822 #
 823 =item invoice
 824
 825   ($count, @results) = &invoice($booksellerinvoicenumber);
 826
 827 Looks up orders by invoice number.
 828
 829 Returns an array. C<$count> is the number of elements in C<@results>.
 830 C<@results> is an array of references-to-hash; the keys of each
 831 elements are fields from the aqorders, biblio, and biblioitems tables
 832 of the Koha database.
 833
 834 =cut
 835 #'
 836 sub invoice {
 837   my ($invoice)=@_;
 838   my $dbh = C4::Context->dbh;
 839   my @results = ();
 840   my $sth=$dbh->prepare("Select * from aqorders,biblio,biblioitems where
 841   booksellerinvoicenumber=?
 842   and biblio.biblionumber=aqorders.biblionumber and biblioitems.biblioitemnumber=
 843   aqorders.biblioitemnumber group by aqorders.ordernumber,aqorders.biblioitemnumber");
 844   $sth->execute($invoice);
 845   while (my $data=$sth->fetchrow_hashref){
 846     push(@results,$data);
 847   }
 848   $sth->finish;
 849   return(scalar(@results),@results);
 850 }
 851
 852 =item bookfunds
 853
 854   ($count, @results) = &bookfunds();
 855
 856 Returns a list of all book funds.
 857
 858 C<$count> is the number of elements in C<@results>. C<@results> is an
 859 array of references-to-hash, whose keys are fields from the aqbookfund
 860 and aqbudget tables of the Koha database. Results are ordered
 861 alphabetically by book fund name.
 862
 863 =cut
 864 #'
 865 sub bookfunds {
 866   my ($branch)=@_;
 867   my $dbh = C4::Context->dbh;
 868   my $userenv = C4::Context->userenv;
 869   my $branch = $userenv->{branch};
 870   my $strsth;
 871
 872   if (!($branch eq '')) {
 873       $strsth="Select * from aqbookfund,aqbudget where aqbookfund.bookfundid
 874       =aqbudget.bookfundid and startdate<now() and enddate>now() and (aqbookfund.branchcode is null or aqbookfund.branchcode='' or aqbookfund.branchcode= ? )
 875       group by aqbookfund.bookfundid order by bookfundname";
 876   } else {
 877       $strsth="Select * from aqbookfund,aqbudget where aqbookfund.bookfundid
 878       =aqbudget.bookfundid and startdate<now() and enddate>now()
 879       group by aqbookfund.bookfundid order by bookfundname";
 880   }
 881   my $sth=$dbh->prepare($strsth);
 882   if (!($branch eq '')){
 883       $sth->execute($branch);
 884   } else {
 885       $sth->execute;
 886   }
 887   my @results = ();
 888   while (my $data=$sth->fetchrow_hashref){
 889     push(@results,$data);
 890   }
 891   $sth->finish;
 892   return(scalar(@results),@results);
 893 }
 894
 895 =item bookfundbreakdown
 896
 897         returns the total comtd & spent for a given bookfund, and a given year
 898         used in acqui-home.pl
 899 =cut
 900 #'
 901
 902 sub bookfundbreakdown {
 903   my ($id, $year)=@_;
 904   my $dbh = C4::Context->dbh;
 905   my $sth=$dbh->prepare("SELECT startdate, enddate, quantity, datereceived, freight, unitprice, listprice, ecost, quantityreceived, subscription
 906 FROM aqorders, aqorderbreakdown, aqbudget, aqbasket
 907 WHERE aqorderbreakdown.bookfundid = ?
 908 AND aqorders.ordernumber = aqorderbreakdown.ordernumber
 909 AND (
 910 datecancellationprinted IS NULL
 911 OR datecancellationprinted = '0000-00-00'
 912 )
 913 AND aqbudget.bookfundid = aqorderbreakdown.bookfundid
 914 AND aqbasket.basketno = aqorders.basketno
 915 AND aqbasket.creationdate >= startdate
 916 AND enddate >= aqbasket.creationdate
 917 and startdate<=now() and enddate>=now()");
 918   $sth->execute($id);
 919   my $comtd=0;
 920   my $spent=0;
 921   while (my $data=$sth->fetchrow_hashref){
 922     if ($data->{'subscription'} == 1){
 923       $spent+=$data->{'quantity'}*$data->{'unitprice'};
 924     } else {
 925       my $leftover=$data->{'quantity'}-$data->{'quantityreceived'};
 926       $comtd+=($data->{'ecost'})*$leftover;
 927       $spent+=($data->{'unitprice'})*$data->{'quantityreceived'};
 928     }
 929   }
 930   $sth->finish;
 931   return($spent,$comtd);
 932 }
 933
 934
 935
 936 =item curconvert
 937
 938   $foreignprice = &curconvert($currency, $localprice);
 939
 940 Converts the price C<$localprice> to foreign currency C<$currency> by
 941 dividing by the exchange rate, and returns the result.
 942
 943 If no exchange rate is found, C<&curconvert> assumes the rate is one
 944 to one.
 945
 946 =cut
 947 #'
 948 sub curconvert {
 949   my ($currency,$price)=@_;
 950   my $dbh = C4::Context->dbh;
 951   my $sth=$dbh->prepare("Select rate from currency where currency=?");
 952   $sth->execute($currency);
 953   my $cur=($sth->fetchrow_array())[0];
 954   $sth->finish;
 955   if ($cur==0){
 956     $cur=1;
 957   }
 958   return($price / $cur);
 959 }
 960
 961 =item getcurrencies
 962
 963   ($count, $currencies) = &getcurrencies();
 964
 965 Returns the list of all known currencies.
 966
 967 C<$count> is the number of elements in C<$currencies>. C<$currencies>
 968 is a reference-to-array; its elements are references-to-hash, whose
 969 keys are the fields from the currency table in the Koha database.
 970
 971 =cut
 972 #'
 973 sub getcurrencies {
 974   my $dbh = C4::Context->dbh;
 975   my $sth=$dbh->prepare("Select * from currency");
 976   $sth->execute;
 977   my @results = ();
 978   while (my $data=$sth->fetchrow_hashref){
 979     push(@results,$data);
 980   }
 981   $sth->finish;
 982   return(scalar(@results),\@results);
 983 }
 984
 985 =item updatecurrencies
 986
 987   &updatecurrencies($currency, $newrate);
 988
 989 Sets the exchange rate for C<$currency> to be C<$newrate>.
 990
 991 =cut
 992 #'
 993 sub updatecurrencies {
 994   my ($currency,$rate)=@_;
 995   my $dbh = C4::Context->dbh;
 996   my $sth=$dbh->prepare("update currency set rate=? where currency=?");
 997   $sth->execute($rate,$currency);
 998   $sth->finish;
 999 }
1000
1001 #
1002 #
1003 # OTHERS
1004 #
1005 #
1006
1007 =item bookseller
1008
1009   ($count, @results) = &bookseller($searchstring);
1010
1011 Looks up a book seller. C<$searchstring> may be either a book seller
1012 ID, or a string to look for in the book seller's name.
1013
1014 C<$count> is the number of elements in C<@results>. C<@results> is an
1015 array of references-to-hash, whose keys are the fields of of the
1016 aqbooksellers table in the Koha database.
1017
1018 =cut
1019 #'
1020 sub bookseller {
1021   my ($searchstring)=@_;
1022   my $dbh = C4::Context->dbh;
1023   my $sth=$dbh->prepare("Select * from aqbooksellers where name like ? or id = ?");
1024   $sth->execute("$searchstring%",$searchstring);
1025   my @results;
1026   while (my $data=$sth->fetchrow_hashref){
1027     push(@results,$data);
1028   }
1029   $sth->finish;
1030   return(scalar(@results),@results);
1031 }
1032
1033 =item breakdown
1034
1035   ($count, $results) = &breakdown($ordernumber);
1036
1037 Looks up an order by order ID, and returns its breakdown.
1038
1039 C<$count> is the number of elements in C<$results>. C<$results> is a
1040 reference-to-array; its elements are references-to-hash, whose keys
1041 are the fields of the aqorderbreakdown table in the Koha database.
1042
1043 =cut
1044 #'
1045 sub breakdown {
1046   my ($id)=@_;
1047   my $dbh = C4::Context->dbh;
1048   my $sth=$dbh->prepare("Select * from aqorderbreakdown where ordernumber=?");
1049   $sth->execute($id);
1050   my @results = ();
1051   while (my $data=$sth->fetchrow_hashref){
1052     push(@results,$data);
1053   }
1054   $sth->finish;
1055   return(scalar(@results),\@results);
1056 }
1057
1058
1059 =item branches
1060
1061   ($count, @results) = &branches();
1062
1063 Returns a list of all library branches.
1064
1065 C<$count> is the number of elements in C<@results>. C<@results> is an
1066 array of references-to-hash, whose keys are the fields of the branches
1067 table of the Koha database.
1068
1069 =cut
1070 #'
1071 sub branches {
1072     my $dbh   = C4::Context->dbh;
1073         my $sth;
1074         if (C4::Context->preference("IndependantBranches") && (C4::Context->userenv) && (C4::Context->userenv->{flags} != 1)){
1075                 my $strsth ="Select * from branches ";
1076                 $strsth.= " WHERE branchcode = ".$dbh->quote(C4::Context->userenv->{branch});
1077                 $strsth.= " order by branchname";
1078                 warn "C4::Acquisition->branches : ".$strsth;
1079                 $sth=$dbh->prepare($strsth);
1080         } else {
1081         $sth = $dbh->prepare("Select * from branches order by branchname");
1082         }
1083     my @results = ();
1084
1085     $sth->execute();
1086     while (my $data = $sth->fetchrow_hashref) {
1087         push(@results,$data);
1088     } # while
1089
1090     $sth->finish;
1091     return(scalar(@results), @results);
1092 } # sub branches
1093
1094 =item updatesup
1095
1096   &updatesup($bookseller);
1097
1098 Updates the information for a given bookseller. C<$bookseller> is a
1099 reference-to-hash whose keys are the fields of the aqbooksellers table
1100 in the Koha database. It must contain entries for all of the fields.
1101 The entry to modify is determined by C<$bookseller-E<gt>{id}>.
1102
1103 The easiest way to get all of the necessary fields is to look up a
1104 book seller with C<&booksellers>, modify what's necessary, then call
1105 C<&updatesup> with the result.
1106
1107 =cut
1108 #'
1109 sub updatesup {
1110    my ($data)=@_;
1111    my $dbh = C4::Context->dbh;
1112    my $sth=$dbh->prepare("Update aqbooksellers set
1113    name=?,address1=?,address2=?,address3=?,address4=?,postal=?,
1114    phone=?,fax=?,url=?,contact=?,contpos=?,contphone=?,contfax=?,contaltphone=?,
1115    contemail=?,contnotes=?,active=?,
1116    listprice=?, invoiceprice=?,gstreg=?, listincgst=?,
1117    invoiceincgst=?, specialty=?,discount=?,invoicedisc=?,
1118    nocalc=?
1119    where id=?");
1120    $sth->execute($data->{'name'},$data->{'address1'},$data->{'address2'},
1121    $data->{'address3'},$data->{'address4'},$data->{'postal'},$data->{'phone'},
1122    $data->{'fax'},$data->{'url'},$data->{'contact'},$data->{'contpos'},
1123    $data->{'contphone'},$data->{'contfax'},$data->{'contaltphone'},
1124    $data->{'contemail'},
1125    $data->{'contnote'},$data->{'active'},$data->{'listprice'},
1126    $data->{'invoiceprice'},$data->{'gstreg'},$data->{'listincgst'},
1127    $data->{'invoiceincgst'},$data->{'specialty'},$data->{'discount'},
1128    $data->{'invoicedisc'},$data->{'nocalc'},$data->{'id'});
1129    $sth->finish;
1130 }
1131
1132 =item insertsup
1133
1134   $id = &insertsup($bookseller);
1135
1136 Creates a new bookseller. C<$bookseller> is a reference-to-hash whose
1137 keys are the fields of the aqbooksellers table in the Koha database.
1138 All fields must be present.
1139
1140 Returns the ID of the newly-created bookseller.
1141
1142 =cut
1143 #'
1144 sub insertsup {
1145   my ($data)=@_;
1146   my $dbh = C4::Context->dbh;
1147   my $sth=$dbh->prepare("Select max(id) from aqbooksellers");
1148   $sth->execute;
1149   my $data2=$sth->fetchrow_hashref;
1150   $sth->finish;
1151   $data2->{'max(id)'}++;
1152   $sth=$dbh->prepare("Insert into aqbooksellers (id) values (?)");
1153   $sth->execute($data2->{'max(id)'});
1154   $sth->finish;
1155   $data->{'id'}=$data2->{'max(id)'};
1156   updatesup($data);
1157   return($data->{'id'});
1158 }
1159
1160 =item getparcels
1161
1162   ($count, $results) = &getparcels($dbh, $bookseller, $order, $limit);
1163
1164 get a lists of parcels
1165 Returns the count of parcels returned and a pointer on a hash list containing parcel informations as such :
1166                 Creation date
1167                 Last operation
1168                 Number of biblio
1169                 Number of items
1170
1171
1172 =cut
1173 #'
1174 sub getparcels {
1175   my ($bookseller, $order, $code,$datefrom,$dateto, $limit)=@_;
1176         my $dbh = C4::Context->dbh;
1177         my $strsth = "SELECT aqorders.booksellerinvoicenumber, datereceived, count(DISTINCT biblionumber) as biblio, sum(quantity) as itemsexpected, sum(quantityreceived) as itemsreceived from aqorders, aqbasket where aqbasket.basketno = aqorders.basketno and aqbasket.booksellerid = $bookseller and datereceived is not null ";
1178         $strsth .= "and aqorders.booksellerinvoicenumber like \"$code%\" " if ($code);
1179         $strsth .= "and datereceived >=".$dbh->quote($datefrom)." " if ($datefrom);
1180         $strsth .= "and datereceived <=".$dbh->quote($dateto)." " if ($dateto);
1181         $strsth .= "group by aqorders.booksellerinvoicenumber,datereceived ";
1182         $strsth .= "order by $order " if ($order);
1183         $strsth .= " LIMIT 0,$limit" if ($limit);
1184         my $sth=$dbh->prepare($strsth);
1185 ###     getparcels:  $strsth
1186         $sth->execute;
1187         my @results;
1188         while (my $data2=$sth->fetchrow_hashref) {
1189                 push @results, $data2;
1190         }
1191
1192    $sth->finish;
1193    return(scalar(@results), @results);
1194 }
1195
1196 END { }       # module clean-up code here (global destructor)
1197
1198 1;
1199 __END__
1200
1201 =back
1202
1203 =head1 AUTHOR
1204
1205 Koha Developement team <info@koha.org>
1206
1207 =cut