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
  21 use strict;
  22 use C4::Context;
  23 use C4::Debug;
  24 use C4::Dates qw(format_date format_date_in_iso);
  25 use MARC::Record;
  26 use C4::Suggestions;
  27 use C4::Debug;
  28
  29 use Time::localtime;
  30 use HTML::Entities;
  31
  32 use vars qw($VERSION @ISA @EXPORT);
  33
  34 BEGIN {
  35         # set the version for version checking
  36         $VERSION = 3.01;
  37         require Exporter;
  38         @ISA    = qw(Exporter);
  39         @EXPORT = qw(
  40                 &GetBasket &NewBasket &CloseBasket &CloseBasketgroup &ReOpenBasketgroup &DelBasket &ModBasket
  41                 &ModBasketHeader &GetBasketsByBookseller &GetBasketsByBasketgroup
  42                 &ModBasketgroup &NewBasketgroup &DelBasketgroup &GetBasketgroup
  43                 &GetBasketgroups
  44
  45                 &GetPendingOrders &GetOrder &GetOrders
  46                 &GetOrderNumber &GetLateOrders &NewOrder &DelOrder
  47                 &SearchOrder &GetHistory &GetRecentAcqui
  48                 &ModOrder &ModOrderItem &ModReceiveOrder &ModOrderBiblioitemNumber
  49
  50         &NewOrderItem
  51
  52                 &GetParcels &GetParcel
  53                 &GetContracts &GetContract
  54
  55         &GetOrderFromItemnumber
  56         &GetItemnumbersFromOrder
  57         );
  58 }
  59
  60
  61
  62
  63
  64 sub GetOrderFromItemnumber {
  65     my ($itemnumber) = @_;
  66     my $dbh          = C4::Context->dbh;
  67     my $query        = qq|
  68
  69     SELECT  * from aqorders    LEFT JOIN aqorders_items
  70     ON (     aqorders.ordernumber = aqorders_items.ordernumber   )
  71     WHERE itemnumber = ?  |;
  72
  73     my $sth = $dbh->prepare($query);
  74
  75     $sth->trace(3);
  76
  77     $sth->execute($itemnumber);
  78
  79     my $order = $sth->fetchrow_hashref;
  80         return ( $order  );
  81
  82 }
  83
  84 # Returns the itemnumber(s) associated with the ordernumber given in parameter
  85 sub GetItemnumbersFromOrder {
  86     my ($ordernumber) = @_;
  87     my $dbh          = C4::Context->dbh;
  88     my $query        = "SELECT itemnumber FROM aqorders_items WHERE ordernumber=?";
  89     my $sth = $dbh->prepare($query);
  90     $sth->execute($ordernumber);
  91     my @tab;
  92
  93     while (my $order = $sth->fetchrow_hashref) {
  94         push @tab, $order->{'itemnumber'};
  95     }
  96
  97     return @tab;
  98
  99 }
 100
 101
 102
 103
 104
 105
 106 =head1 NAME
 107
 108 C4::Acquisition - Koha functions for dealing with orders and acquisitions
 109
 110 =head1 SYNOPSIS
 111
 112 use C4::Acquisition;
 113
 114 =head1 DESCRIPTION
 115
 116 The functions in this module deal with acquisitions, managing book
 117 orders, basket and parcels.
 118
 119 =head1 FUNCTIONS
 120
 121 =head2 FUNCTIONS ABOUT BASKETS
 122
 123 =head3 GetBasket
 124
 125 =over 4
 126
 127 $aqbasket = &GetBasket($basketnumber);
 128
 129 get all basket informations in aqbasket for a given basket
 130
 131 return :
 132 informations for a given basket returned as a hashref.
 133
 134 =back
 135
 136 =cut
 137
 138 sub GetBasket {
 139     my ($basketno) = @_;
 140     my $dbh        = C4::Context->dbh;
 141     my $query = "
 142         SELECT  aqbasket.*,
 143                 concat( b.firstname,' ',b.surname) AS authorisedbyname,
 144                 b.branchcode AS branch
 145         FROM    aqbasket
 146         LEFT JOIN borrowers b ON aqbasket.authorisedby=b.borrowernumber
 147         WHERE basketno=?
 148     ";
 149     my $sth=$dbh->prepare($query);
 150     $sth->execute($basketno);
 151     my $basket = $sth->fetchrow_hashref;
 152         return ( $basket );
 153 }
 154
 155 #------------------------------------------------------------#
 156
 157 =head3 NewBasket
 158
 159 =over 4
 160
 161 $basket = &NewBasket( $booksellerid, $authorizedby, $basketname, $basketnote, $basketbooksellernote, $basketcontractnumber );
 162
 163 Create a new basket in aqbasket table
 164
 165 =item C<$booksellerid> is a foreign key in the aqbasket table
 166
 167 =item C<$authorizedby> is the username of who created the basket
 168
 169 The other parameters are optional, see ModBasketHeader for more info on them.
 170
 171 =back
 172
 173 =cut
 174
 175 # FIXME : this function seems to be unused.
 176
 177 sub NewBasket {
 178     my ( $booksellerid, $authorisedby, $basketname, $basketnote, $basketbooksellernote, $basketcontractnumber ) = @_;
 179     my $dbh = C4::Context->dbh;
 180     my $query = "
 181         INSERT INTO aqbasket
 182                 (creationdate,booksellerid,authorisedby)
 183         VALUES  (now(),'$booksellerid','$authorisedby')
 184     ";
 185     my $sth =
 186       $dbh->do($query);
 187 #find & return basketno MYSQL dependant, but $dbh->last_insert_id always returns null :-(
 188     my $basket = $dbh->{'mysql_insertid'};
 189     ModBasketHeader($basket, $basketname || '', $basketnote || '', $basketbooksellernote || '', $basketcontractnumber || undef);
 190     return $basket;
 191 }
 192
 193 #------------------------------------------------------------#
 194
 195 =head3 CloseBasket
 196
 197 =over 4
 198
 199 &CloseBasket($basketno);
 200
 201 close a basket (becomes unmodifiable,except for recieves)
 202
 203 =back
 204
 205 =cut
 206
 207 sub CloseBasket {
 208     my ($basketno) = @_;
 209     my $dbh        = C4::Context->dbh;
 210     my $query = "
 211         UPDATE aqbasket
 212         SET    closedate=now()
 213         WHERE  basketno=?
 214     ";
 215     my $sth = $dbh->prepare($query);
 216     $sth->execute($basketno);
 217 }
 218
 219 #------------------------------------------------------------#
 220
 221 =head3 CloseBasketgroup
 222
 223 =over 4
 224
 225 &CloseBasketgroup($basketgroupno);
 226
 227 close a basketgroup
 228
 229 =back
 230
 231 =cut
 232
 233 sub CloseBasketgroup {
 234     my ($basketgroupno) = @_;
 235     my $dbh        = C4::Context->dbh;
 236     my $sth = $dbh->prepare("
 237         UPDATE aqbasketgroups
 238         SET    closed=1
 239         WHERE  id=?
 240     ");
 241     $sth->execute($basketgroupno);
 242 }
 243
 244 #------------------------------------------------------------#
 245
 246 =head3 ReOpenBaskergroup($basketgroupno)
 247
 248 =over 4
 249
 250 &ReOpenBaskergroup($basketgroupno);
 251
 252 reopen a basketgroup
 253
 254 =back
 255
 256 =cut
 257
 258 sub ReOpenBasketgroup {
 259     my ($basketgroupno) = @_;
 260     my $dbh        = C4::Context->dbh;
 261     my $sth = $dbh->prepare("
 262         UPDATE aqbasketgroups
 263         SET    closed=0
 264         WHERE  id=?
 265     ");
 266     $sth->execute($basketgroupno);
 267 }
 268
 269 #------------------------------------------------------------#
 270
 271
 272 =head3 DelBasket
 273
 274 =over 4
 275
 276 &DelBasket($basketno);
 277
 278 Deletes the basket that has basketno field $basketno in the aqbasket table.
 279
 280 =over 2
 281
 282 =item C<$basketno> is the primary key of the basket in the aqbasket table.
 283
 284 =back
 285
 286 =back
 287
 288 =cut
 289 sub DelBasket {
 290     my ( $basketno ) = @_;
 291     my $query = "DELETE FROM aqbasket WHERE basketno=?";
 292     my $dbh = C4::Context->dbh;
 293     my $sth = $dbh->prepare($query);
 294     $sth->execute($basketno);
 295     $sth->finish;
 296 }
 297
 298 #------------------------------------------------------------#
 299
 300 =head3 ModBasket
 301
 302 =over 4
 303
 304 &ModBasket($basketinfo);
 305
 306 Modifies a basket, using a hashref $basketinfo for the relevant information, only $basketinfo->{'basketno'} is required.
 307
 308 =over 2
 309
 310 =item C<$basketno> is the primary key of the basket in the aqbasket table.
 311
 312 =back
 313
 314 =back
 315
 316 =cut
 317 sub ModBasket {
 318     my $basketinfo = shift;
 319     my $query = "UPDATE aqbasket SET ";
 320     my @params;
 321     foreach my $key (keys %$basketinfo){
 322         if ($key ne 'basketno'){
 323             $query .= "$key=?, ";
 324             push(@params, $basketinfo->{$key} || undef );
 325         }
 326     }
 327 # get rid of the "," at the end of $query
 328     if (substr($query, length($query)-2) eq ', '){
 329         chop($query);
 330         chop($query);
 331         $query .= ' ';
 332     }
 333     $query .= "WHERE basketno=?";
 334     push(@params, $basketinfo->{'basketno'});
 335     my $dbh = C4::Context->dbh;
 336     my $sth = $dbh->prepare($query);
 337     $sth->execute(@params);
 338     $sth->finish;
 339 }
 340
 341 #------------------------------------------------------------#
 342
 343 =head3 ModBasketHeader
 344
 345 =over 4
 346
 347 &ModBasketHeader($basketno, $basketname, $note, $booksellernote, $contractnumber);
 348
 349 Modifies a basket's header.
 350
 351 =over 2
 352
 353 =item C<$basketno> is the "basketno" field in the "aqbasket" table;
 354
 355 =item C<$basketname> is the "basketname" field in the "aqbasket" table;
 356
 357 =item C<$note> is the "note" field in the "aqbasket" table;
 358
 359 =item C<$booksellernote> is the "booksellernote" field in the "aqbasket" table;
 360
 361 =item C<$contractnumber> is the "contractnumber" (foreign) key in the "aqbasket" table.
 362
 363 =back
 364
 365 =back
 366
 367 =cut
 368 sub ModBasketHeader {
 369     my ($basketno, $basketname, $note, $booksellernote, $contractnumber) = @_;
 370     my $query = "UPDATE aqbasket SET basketname=?, note=?, booksellernote=? WHERE basketno=?";
 371     my $dbh = C4::Context->dbh;
 372     my $sth = $dbh->prepare($query);
 373     $sth->execute($basketname,$note,$booksellernote,$basketno);
 374     if ( $contractnumber ) {
 375         my $query2 ="UPDATE aqbasket SET contractnumber=? WHERE basketno=?";
 376         my $sth2 = $dbh->prepare($query2);
 377         $sth2->execute($contractnumber,$basketno);
 378         $sth2->finish;
 379     }
 380     $sth->finish;
 381 }
 382
 383 #------------------------------------------------------------#
 384
 385 =head3 GetBasketsByBookseller
 386
 387 =over 4
 388
 389 @results = &GetBasketsByBookseller($booksellerid, $extra);
 390
 391 Returns a list of hashes of all the baskets that belong to bookseller 'booksellerid'.
 392
 393 =over 2
 394
 395 =item C<$booksellerid> is the 'id' field of the bookseller in the aqbooksellers table
 396
 397 =item C<$extra> is the extra sql parameters, can be
 398
 399   - $extra->{groupby}: group baskets by column
 400        ex. $extra->{groupby} = aqbasket.basketgroupid
 401   - $extra->{orderby}: order baskets by column
 402   - $extra->{limit}: limit number of results (can be helpful for pagination)
 403
 404 =back
 405
 406 =back
 407
 408 =cut
 409
 410 sub GetBasketsByBookseller {
 411     my ($booksellerid, $extra) = @_;
 412     my $query = "SELECT * FROM aqbasket WHERE booksellerid=?";
 413     if ($extra){
 414         if ($extra->{groupby}) {
 415             $query .= " GROUP by $extra->{groupby}";
 416         }
 417         if ($extra->{orderby}){
 418             $query .= " ORDER by $extra->{orderby}";
 419         }
 420         if ($extra->{limit}){
 421             $query .= " LIMIT $extra->{limit}";
 422         }
 423     }
 424     my $dbh = C4::Context->dbh;
 425     my $sth = $dbh->prepare($query);
 426     $sth->execute($booksellerid);
 427     my $results = $sth->fetchall_arrayref({});
 428     $sth->finish;
 429     return $results
 430 }
 431
 432 #------------------------------------------------------------#
 433
 434 =head3 GetBasketsByBasketgroup
 435
 436 =over 4
 437
 438 $baskets = &GetBasketsByBasketgroup($basketgroupid);
 439
 440 =over 2
 441
 442 Returns a reference to all baskets that belong to basketgroup $basketgroupid.
 443
 444 =back
 445
 446 =back
 447
 448 =cut
 449
 450 sub GetBasketsByBasketgroup {
 451     my $basketgroupid = shift;
 452     my $query = "SELECT * FROM aqbasket
 453                 LEFT JOIN aqcontract USING(contractnumber) WHERE basketgroupid=?";
 454     my $dbh = C4::Context->dbh;
 455     my $sth = $dbh->prepare($query);
 456     $sth->execute($basketgroupid);
 457     my $results = $sth->fetchall_arrayref({});
 458     $sth->finish;
 459     return $results
 460 }
 461
 462 #------------------------------------------------------------#
 463
 464 =head3 NewBasketgroup
 465
 466 =over 4
 467
 468 $basketgroupid = NewBasketgroup(\%hashref);
 469
 470 =over 2
 471
 472 Adds a basketgroup to the aqbasketgroups table, and add the initial baskets to it.
 473
 474 $hashref->{'booksellerid'} is the 'id' field of the bookseller in the aqbooksellers table,
 475
 476 $hashref->{'name'} is the 'name' field of the basketgroup in the aqbasketgroups table,
 477
 478 $hashref->{'basketlist'} is a list reference of the 'id's of the baskets that belong to this group,
 479
 480 $hashref->{'closed'} is the 'closed' field of the aqbasketgroups table, it is false if 0, true otherwise.
 481
 482 =back
 483
 484 =back
 485
 486 =cut
 487
 488 sub NewBasketgroup {
 489     my $basketgroupinfo = shift;
 490     die "booksellerid is required to create a basketgroup" unless $basketgroupinfo->{'booksellerid'};
 491     my $query = "INSERT INTO aqbasketgroups (";
 492     my @params;
 493     foreach my $field ('name', 'closed') {
 494         if ( $basketgroupinfo->{$field} ) {
 495             $query .= "$field, ";
 496             push(@params, $basketgroupinfo->{$field});
 497         }
 498     }
 499     $query .= "booksellerid) VALUES (";
 500     foreach (@params) {
 501         $query .= "?, ";
 502     }
 503     $query .= "?)";
 504     push(@params, $basketgroupinfo->{'booksellerid'});
 505     my $dbh = C4::Context->dbh;
 506     my $sth = $dbh->prepare($query);
 507     $sth->execute(@params);
 508     my $basketgroupid = $dbh->{'mysql_insertid'};
 509     if( $basketgroupinfo->{'basketlist'} ) {
 510         foreach my $basketno (@{$basketgroupinfo->{'basketlist'}}) {
 511             my $query2 = "UPDATE aqbasket SET basketgroupid=? WHERE basketno=?";
 512             my $sth2 = $dbh->prepare($query2);
 513             $sth2->execute($basketgroupid, $basketno);
 514         }
 515     }
 516     return $basketgroupid;
 517 }
 518
 519 #------------------------------------------------------------#
 520
 521 =head3 ModBasketgroup
 522
 523 =over 4
 524
 525 ModBasketgroup(\%hashref);
 526
 527 =over 2
 528
 529 Modifies a basketgroup in the aqbasketgroups table, and add the baskets to it.
 530
 531 $hashref->{'id'} is the 'id' field of the basketgroup in the aqbasketgroup table, this parameter is mandatory,
 532
 533 $hashref->{'name'} is the 'name' field of the basketgroup in the aqbasketgroups table,
 534
 535 $hashref->{'basketlist'} is a list reference of the 'id's of the baskets that belong to this group,
 536
 537 $hashref->{'closed'} is the 'closed' field of the aqbasketgroups table, it is false if 0, true otherwise.
 538
 539 =back
 540
 541 =back
 542
 543 =cut
 544
 545 sub ModBasketgroup {
 546     my $basketgroupinfo = shift;
 547     die "basketgroup id is required to edit a basketgroup" unless $basketgroupinfo->{'id'};
 548     my $dbh = C4::Context->dbh;
 549     my $query = "UPDATE aqbasketgroups SET ";
 550     my @params;
 551     foreach my $field (qw(name closed)) {
 552         if ( $basketgroupinfo->{$field} ne undef) {
 553             $query .= "$field=?, ";
 554             push(@params, $basketgroupinfo->{$field});
 555         }
 556     }
 557     chop($query);
 558     chop($query);
 559     $query .= " WHERE id=?";
 560     push(@params, $basketgroupinfo->{'id'});
 561     my $sth = $dbh->prepare($query);
 562     $sth->execute(@params);
 563
 564     $sth = $dbh->prepare('UPDATE aqbasket SET basketgroupid = NULL WHERE basketgroupid = ?');
 565     $sth->execute($basketgroupinfo->{'id'});
 566
 567     if($basketgroupinfo->{'basketlist'} && @{$basketgroupinfo->{'basketlist'}}){
 568         $sth = $dbh->prepare("UPDATE aqbasket SET basketgroupid=? WHERE basketno=?");
 569         foreach my $basketno (@{$basketgroupinfo->{'basketlist'}}) {
 570             $sth->execute($basketgroupinfo->{'id'}, $basketno);
 571             $sth->finish;
 572         }
 573     }
 574     $sth->finish;
 575 }
 576
 577 #------------------------------------------------------------#
 578
 579 =head3 DelBasketgroup
 580
 581 =over 4
 582
 583 DelBasketgroup($basketgroupid);
 584
 585 =over 2
 586
 587 Deletes a basketgroup in the aqbasketgroups table, and removes the reference to it from the baskets,
 588
 589 =item C<$basketgroupid> is the 'id' field of the basket in the aqbasketgroup table
 590
 591 =back
 592
 593 =back
 594
 595 =cut
 596
 597 sub DelBasketgroup {
 598     my $basketgroupid = shift;
 599     die "basketgroup id is required to edit a basketgroup" unless $basketgroupid;
 600     my $query = "DELETE FROM aqbasketgroups WHERE id=?";
 601     my $dbh = C4::Context->dbh;
 602     my $sth = $dbh->prepare($query);
 603     $sth->execute($basketgroupid);
 604     $sth->finish;
 605 }
 606
 607 #------------------------------------------------------------#
 608
 609 =back
 610
 611 =head2 FUNCTIONS ABOUT ORDERS
 612
 613 =over 2
 614
 615 =cut
 616
 617 =head3 GetBasketgroup
 618
 619 =over 4
 620
 621 $basketgroup = &GetBasketgroup($basketgroupid);
 622
 623 =over 2
 624
 625 Returns a reference to the hash containing all infermation about the basketgroup.
 626
 627 =back
 628
 629 =back
 630
 631 =cut
 632
 633 sub GetBasketgroup {
 634     my $basketgroupid = shift;
 635     die "basketgroup id is required to edit a basketgroup" unless $basketgroupid;
 636     my $query = "SELECT * FROM aqbasketgroups WHERE id=?";
 637     my $dbh = C4::Context->dbh;
 638     my $sth = $dbh->prepare($query);
 639     $sth->execute($basketgroupid);
 640     my $result = $sth->fetchrow_hashref;
 641     $sth->finish;
 642     return $result
 643 }
 644
 645 #------------------------------------------------------------#
 646
 647 =head3 GetBasketgroups
 648
 649 =over 4
 650
 651 $basketgroups = &GetBasketgroups($booksellerid);
 652
 653 =over 2
 654
 655 Returns a reference to the array of all the basketgroups of bookseller $booksellerid.
 656
 657 =back
 658
 659 =back
 660
 661 =cut
 662
 663 sub GetBasketgroups {
 664     my $booksellerid = shift;
 665     die "bookseller id is required to edit a basketgroup" unless $booksellerid;
 666     my $query = "SELECT * FROM aqbasketgroups WHERE booksellerid=?";
 667     my $dbh = C4::Context->dbh;
 668     my $sth = $dbh->prepare($query);
 669     $sth->execute($booksellerid);
 670     my $results = $sth->fetchall_arrayref({});
 671     $sth->finish;
 672     return $results
 673 }
 674
 675 #------------------------------------------------------------#
 676
 677 =back
 678
 679 =head2 FUNCTIONS ABOUT ORDERS
 680
 681 =over 2
 682
 683 =cut
 684
 685 #------------------------------------------------------------#
 686
 687 =head3 GetPendingOrders
 688
 689 =over 4
 690
 691 $orders = &GetPendingOrders($booksellerid, $grouped, $owner);
 692
 693 Finds pending orders from the bookseller with the given ID. Ignores
 694 completed and cancelled orders.
 695
 696 C<$booksellerid> contains the bookseller identifier
 697 C<$grouped> contains 0 or 1. 0 means returns the list, 1 means return the total
 698 C<$owner> contains 0 or 1. 0 means any owner. 1 means only the list of orders entered by the user itself.
 699
 700 C<$orders> is a reference-to-array; each element is a
 701 reference-to-hash with the following fields:
 702 C<$grouped> is a boolean that, if set to 1 will group all order lines of the same basket
 703 in a single result line
 704
 705 =over 2
 706
 707 =item C<authorizedby>
 708
 709 =item C<entrydate>
 710
 711 =item C<basketno>
 712
 713 These give the value of the corresponding field in the aqorders table
 714 of the Koha database.
 715
 716 =back
 717
 718 =back
 719
 720 Results are ordered from most to least recent.
 721
 722 =cut
 723
 724 sub GetPendingOrders {
 725     my ($supplierid,$grouped,$owner,$basketno) = @_;
 726     my $dbh = C4::Context->dbh;
 727     my $strsth = "
 728         SELECT    ".($grouped?"count(*),":"")."aqbasket.basketno,
 729                     surname,firstname,aqorders.*,biblio.*,biblioitems.isbn,
 730                     aqbasket.closedate, aqbasket.creationdate, aqbasket.basketname
 731         FROM      aqorders
 732         LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
 733         LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
 734         LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber
 735         LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
 736         WHERE booksellerid=?
 737             AND (quantity > quantityreceived OR quantityreceived is NULL)
 738             AND datecancellationprinted IS NULL
 739             AND (to_days(now())-to_days(closedate) < 180 OR closedate IS NULL)
 740     ";
 741     ## FIXME  Why 180 days ???
 742     my @query_params = ( $supplierid );
 743     my $userenv = C4::Context->userenv;
 744     if ( C4::Context->preference("IndependantBranches") ) {
 745         if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
 746             $strsth .= " and (borrowers.branchcode = ?
 747                           or borrowers.branchcode  = '')";
 748             push @query_params, $userenv->{branch};
 749         }
 750     }
 751     if ($owner) {
 752         $strsth .= " AND aqbasket.authorisedby=? ";
 753         push @query_params, $userenv->{'number'};
 754     }
 755     if ($basketno) {
 756         $strsth .= " AND aqbasket.basketno=? ";
 757         push @query_params, $basketno;
 758     }
 759     $strsth .= " group by aqbasket.basketno" if $grouped;
 760     $strsth .= " order by aqbasket.basketno";
 761
 762     my $sth = $dbh->prepare($strsth);
 763     $sth->execute( @query_params );
 764     my $results = $sth->fetchall_arrayref({});
 765     $sth->finish;
 766     return $results;
 767 }
 768
 769 #------------------------------------------------------------#
 770
 771 =head3 GetOrders
 772
 773 =over 4
 774
 775 @orders = &GetOrders($basketnumber, $orderby);
 776
 777 Looks up the pending (non-cancelled) orders with the given basket
 778 number. If C<$booksellerID> is non-empty, only orders from that seller
 779 are returned.
 780
 781 return :
 782 C<&basket> returns a two-element array. C<@orders> is an array of
 783 references-to-hash, whose keys are the fields from the aqorders,
 784 biblio, and biblioitems tables in the Koha database.
 785
 786 =back
 787
 788 =cut
 789
 790 sub GetOrders {
 791     my ( $basketno, $orderby ) = @_;
 792     my $dbh   = C4::Context->dbh;
 793     my $query  ="
 794          SELECT biblio.*,biblioitems.*,
 795                 aqorders.*,
 796                 aqbudgets.*,
 797                 biblio.title
 798         FROM    aqorders
 799             LEFT JOIN aqbudgets        ON aqbudgets.budget_id = aqorders.budget_id
 800             LEFT JOIN biblio           ON biblio.biblionumber = aqorders.biblionumber
 801             LEFT JOIN biblioitems      ON biblioitems.biblionumber =biblio.biblionumber
 802         WHERE   basketno=?
 803             AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00')
 804     ";
 805
 806     $orderby = "biblioitems.publishercode,biblio.title" unless $orderby;
 807     $query .= " ORDER BY $orderby";
 808     my $sth = $dbh->prepare($query);
 809     $sth->execute($basketno);
 810     my $results = $sth->fetchall_arrayref({});
 811     $sth->finish;
 812     return @$results;
 813 }
 814
 815 #------------------------------------------------------------#
 816
 817 =head3 GetOrderNumber
 818
 819 =over 4
 820
 821 $ordernumber = &GetOrderNumber($biblioitemnumber, $biblionumber);
 822
 823 =back
 824
 825 Looks up the ordernumber with the given biblionumber and biblioitemnumber.
 826
 827 Returns the number of this order.
 828
 829 =over 4
 830
 831 =item C<$ordernumber> is the order number.
 832
 833 =back
 834
 835 =cut
 836 sub GetOrderNumber {
 837     my ( $biblionumber,$biblioitemnumber ) = @_;
 838     my $dbh = C4::Context->dbh;
 839     my $query = "
 840         SELECT ordernumber
 841         FROM   aqorders
 842         WHERE  biblionumber=?
 843         AND    biblioitemnumber=?
 844     ";
 845     my $sth = $dbh->prepare($query);
 846     $sth->execute( $biblionumber, $biblioitemnumber );
 847
 848     return $sth->fetchrow;
 849 }
 850
 851 #------------------------------------------------------------#
 852
 853 =head3 GetOrder
 854
 855 =over 4
 856
 857 $order = &GetOrder($ordernumber);
 858
 859 Looks up an order by order number.
 860
 861 Returns a reference-to-hash describing the order. The keys of
 862 C<$order> are fields from the biblio, biblioitems, aqorders tables of the Koha database.
 863
 864 =back
 865
 866 =cut
 867
 868 sub GetOrder {
 869     my ($ordnum) = @_;
 870     my $dbh      = C4::Context->dbh;
 871     my $query = "
 872         SELECT biblioitems.*, biblio.*, aqorders.*
 873         FROM   aqorders
 874         LEFT JOIN biblio on           biblio.biblionumber=aqorders.biblionumber
 875         LEFT JOIN biblioitems on       biblioitems.biblionumber=aqorders.biblionumber
 876         WHERE aqorders.ordernumber=?
 877
 878     ";
 879     my $sth= $dbh->prepare($query);
 880     $sth->execute($ordnum);
 881     my $data = $sth->fetchrow_hashref;
 882     $sth->finish;
 883     return $data;
 884 }
 885
 886 #------------------------------------------------------------#
 887
 888 =head3 NewOrder
 889
 890 =over 4
 891
 892 &NewOrder(\%hashref);
 893
 894 Adds a new order to the database. Any argument that isn't described
 895 below is the new value of the field with the same name in the aqorders
 896 table of the Koha database.
 897
 898 =over 4
 899
 900 =item $hashref->{'basketno'} is the basketno foreign key in aqorders, it is mandatory
 901
 902
 903 =item $hashref->{'ordnum'} is a "minimum order number."
 904
 905 =item $hashref->{'budgetdate'} is effectively ignored.
 906   If it's undef (anything false) or the string 'now', the current day is used.
 907   Else, the upcoming July 1st is used.
 908
 909 =item $hashref->{'subscription'} may be either "yes", or anything else for "no".
 910
 911 =item $hashref->{'uncertainprice'} may be 0 for "the price is known" or 1 for "the price is uncertain"
 912
 913 The following keys are used: "biblionumber", "title", "basketno", "quantity", "notes", "biblioitemnumber", "rrp", "ecost", "gst", "unitprice", "subscription", "sort1", "sort2", "booksellerinvoicenumber", "listprice", "budgetdate", "purchaseordernumber", "branchcode", "booksellerinvoicenumber", "bookfundid".
 914
 915 =back
 916
 917 =back
 918
 919 =cut
 920
 921 sub NewOrder {
 922     my $orderinfo = shift;
 923 #### ------------------------------
 924     my $dbh = C4::Context->dbh;
 925     my @params;
 926
 927
 928     # if these parameters are missing, we can't continue
 929     for my $key (qw/basketno quantity biblionumber budget_id/) {
 930         die "Mandatory parameter $key missing" unless $orderinfo->{$key};
 931     }
 932
 933     if ( $orderinfo->{'subscription'} eq 'yes' ) {
 934         $orderinfo->{'subscription'} = 1;
 935     } else {
 936         $orderinfo->{'subscription'} = 0;
 937     }
 938
 939     my $query = "INSERT INTO aqorders (";
 940     foreach my $orderinfokey (keys %{$orderinfo}) {
 941         next if $orderinfokey =~ m/branchcode|entrydate/;   # skip branchcode and entrydate, branchcode isnt a vaild col, entrydate we add manually with NOW()
 942         $query .= "$orderinfokey,";
 943         push(@params, $orderinfo->{$orderinfokey});
 944     }
 945
 946     $query .= "entrydate) VALUES (";
 947     foreach (@params) {
 948         $query .= "?,";
 949     }
 950     $query .= " NOW() )";  #ADDING CURRENT DATE TO  'budgetdate, entrydate, purchaseordernumber'...
 951
 952     my $sth = $dbh->prepare($query);
 953
 954     $sth->execute(@params);
 955     $sth->finish;
 956
 957     #get ordnum MYSQL dependant, but $dbh->last_insert_id returns null
 958     my $ordnum = $dbh->{'mysql_insertid'};
 959
 960     $sth->finish;
 961     return ( $orderinfo->{'basketno'}, $ordnum );
 962 }
 963
 964
 965
 966 #------------------------------------------------------------#
 967
 968 =head3 NewOrderItem
 969
 970 =over 4
 971
 972 &NewOrderItem();
 973
 974
 975 =back
 976
 977 =cut
 978
 979 sub NewOrderItem {
 980     #my ($biblioitemnumber,$ordnum, $biblionumber) = @_;
 981     my ($itemnumber, $ordernumber)  = @_;
 982     my $dbh = C4::Context->dbh;
 983     my $query = qq|
 984             INSERT INTO aqorders_items
 985                 (itemnumber, ordernumber)
 986             VALUES (?,?)    |;
 987
 988     my $sth = $dbh->prepare($query);
 989     $sth->execute( $itemnumber, $ordernumber);
 990 }
 991
 992 #------------------------------------------------------------#
 993
 994 =head3 ModOrder
 995
 996 =over 4
 997
 998 &ModOrder(\%hashref);
 999
1000 =over 2
1001
1002 Modifies an existing order. Updates the order with order number
1003 $hashref->{'ordernumber'} and biblionumber $hashref->{'biblionumber'}. All other keys of the hash
1004 update the fields with the same name in the aqorders table of the Koha database.
1005
1006 =back
1007
1008 =back
1009
1010 =cut
1011
1012 sub ModOrder {
1013     my $orderinfo = shift;
1014
1015     die "Ordernumber is required"     if $orderinfo->{'ordernumber'} eq  '' ;
1016     die "Biblionumber is required"  if  $orderinfo->{'biblionumber'} eq '';
1017
1018     my $dbh = C4::Context->dbh;
1019     my @params;
1020 #    delete($orderinfo->{'branchcode'});
1021     # the hash contains a lot of entries not in aqorders, so get the columns ...
1022     my $sth = $dbh->prepare("SELECT * FROM aqorders LIMIT 1;");
1023     $sth->execute;
1024     my $colnames = $sth->{NAME};
1025     my $query = "UPDATE aqorders SET ";
1026
1027     foreach my $orderinfokey (grep(!/ordernumber/, keys %$orderinfo)){
1028         # ... and skip hash entries that are not in the aqorders table
1029         # FIXME : probably not the best way to do it (would be better to have a correct hash)
1030         next unless grep(/^$orderinfokey$/, @$colnames);
1031             $query .= "$orderinfokey=?, ";
1032             push(@params, $orderinfo->{$orderinfokey});
1033     }
1034
1035     $query .= "timestamp=NOW()  WHERE  ordernumber=?";
1036 #   push(@params, $specorderinfo{'ordernumber'});
1037     push(@params, $orderinfo->{'ordernumber'} );
1038     $sth = $dbh->prepare($query);
1039     $sth->execute(@params);
1040     $sth->finish;
1041 }
1042
1043 #------------------------------------------------------------#
1044
1045 =head3 ModOrderItem
1046
1047 =over 4
1048
1049 &ModOrderItem(\%hashref);
1050
1051 =over 2
1052
1053 Modifies the itemnumber in the aqorders_items table. The input hash needs three entities:
1054   - itemnumber: the old itemnumber
1055   - ordernumber: the order this item is attached to
1056   - newitemnumber: the new itemnumber we want to attach the line to
1057
1058 =back
1059
1060 =back
1061
1062 =cut
1063
1064 sub ModOrderItem {
1065     my $orderiteminfo = shift;
1066     if (! $orderiteminfo->{'ordernumber'} || ! $orderiteminfo->{'itemnumber'} || ! $orderiteminfo->{'newitemnumber'}){
1067         die "Ordernumber, itemnumber and newitemnumber is required";
1068     }
1069
1070     my $dbh = C4::Context->dbh;
1071
1072     my $query = "UPDATE aqorders_items set itemnumber=? where itemnumber=? and ordernumber=?";
1073     my @params = ($orderiteminfo->{'newitemnumber'}, $orderiteminfo->{'itemnumber'}, $orderiteminfo->{'ordernumber'});
1074     warn $query;
1075     warn Data::Dumper::Dumper(@params);
1076     my $sth = $dbh->prepare($query);
1077     $sth->execute(@params);
1078     return 0;
1079 }
1080
1081 #------------------------------------------------------------#
1082
1083
1084 =head3 ModOrderBibliotemNumber
1085
1086 =over 4
1087
1088 &ModOrderBiblioitemNumber($biblioitemnumber,$ordnum, $biblionumber);
1089
1090 Modifies the biblioitemnumber for an existing order.
1091 Updates the order with order number C<$ordernum> and biblionumber C<$biblionumber>.
1092
1093 =back
1094
1095 =cut
1096
1097 #FIXME: is this used at all?
1098 sub ModOrderBiblioitemNumber {
1099     my ($biblioitemnumber,$ordnum, $biblionumber) = @_;
1100     my $dbh = C4::Context->dbh;
1101     my $query = "
1102       UPDATE aqorders
1103       SET    biblioitemnumber = ?
1104       WHERE  ordernumber = ?
1105       AND biblionumber =  ?";
1106     my $sth = $dbh->prepare($query);
1107     $sth->execute( $biblioitemnumber, $ordnum, $biblionumber );
1108 }
1109
1110 #------------------------------------------------------------#
1111
1112 =head3 ModReceiveOrder
1113
1114 =over 4
1115
1116 &ModReceiveOrder($biblionumber, $ordernumber, $quantityreceived, $user,
1117     $unitprice, $booksellerinvoicenumber, $biblioitemnumber,
1118     $freight, $bookfund, $rrp);
1119
1120 Updates an order, to reflect the fact that it was received, at least
1121 in part. All arguments not mentioned below update the fields with the
1122 same name in the aqorders table of the Koha database.
1123
1124 If a partial order is received, splits the order into two.  The received
1125 portion must have a booksellerinvoicenumber.
1126
1127 Updates the order with bibilionumber C<$biblionumber> and ordernumber
1128 C<$ordernumber>.
1129
1130 =back
1131
1132 =cut
1133
1134
1135 sub ModReceiveOrder {
1136     my (
1137         $biblionumber,    $ordnum,  $quantrec, $user, $cost,
1138         $invoiceno, $freight, $rrp, $budget_id, $datereceived
1139       )
1140       = @_;
1141     my $dbh = C4::Context->dbh;
1142 #     warn "DATE BEFORE : $daterecieved";
1143 #    $daterecieved=POSIX::strftime("%Y-%m-%d",CORE::localtime) unless $daterecieved;
1144 #     warn "DATE REC : $daterecieved";
1145         $datereceived = C4::Dates->output('iso') unless $datereceived;
1146     my $suggestionid = GetSuggestionFromBiblionumber( $dbh, $biblionumber );
1147     if ($suggestionid) {
1148         ModStatus( $suggestionid, 'AVAILABLE', '', $biblionumber );
1149     }
1150
1151         my $sth=$dbh->prepare("
1152         SELECT * FROM   aqorders
1153             WHERE           biblionumber=? AND aqorders.ordernumber=?");
1154
1155     $sth->execute($biblionumber,$ordnum);
1156     my $order = $sth->fetchrow_hashref();
1157     $sth->finish();
1158
1159         if ( $order->{quantity} > $quantrec ) {
1160         $sth=$dbh->prepare("
1161             UPDATE aqorders
1162             SET quantityreceived=?
1163                 , datereceived=?
1164                 , booksellerinvoicenumber=?
1165                 , unitprice=?
1166                 , freight=?
1167                 , rrp=?
1168                 , quantityreceived=?
1169             WHERE biblionumber=? AND ordernumber=?");
1170
1171         $sth->execute($quantrec,$datereceived,$invoiceno,$cost,$freight,$rrp,$quantrec,$biblionumber,$ordnum);
1172         $sth->finish;
1173
1174         # create a new order for the remaining items, and set its bookfund.
1175         foreach my $orderkey ( "linenumber", "allocation" ) {
1176             delete($order->{'$orderkey'});
1177         }
1178         my $newOrder = NewOrder($order);
1179   } else {
1180         $sth=$dbh->prepare("update aqorders
1181                                                         set quantityreceived=?,datereceived=?,booksellerinvoicenumber=?,
1182                                                                 unitprice=?,freight=?,rrp=?
1183                             where biblionumber=? and ordernumber=?");
1184         $sth->execute($quantrec,$datereceived,$invoiceno,$cost,$freight,$rrp,$biblionumber,$ordnum);
1185         $sth->finish;
1186     }
1187     return $datereceived;
1188 }
1189 #------------------------------------------------------------#
1190
1191 =head3 SearchOrder
1192
1193 @results = &SearchOrder($search, $biblionumber, $complete);
1194
1195 Searches for orders.
1196
1197 C<$search> may take one of several forms: if it is an ISBN,
1198 C<&ordersearch> returns orders with that ISBN. If C<$search> is an
1199 order number, C<&ordersearch> returns orders with that order number
1200 and biblionumber C<$biblionumber>. Otherwise, C<$search> is considered
1201 to be a space-separated list of search terms; in this case, all of the
1202 terms must appear in the title (matching the beginning of title
1203 words).
1204
1205 If C<$complete> is C<yes>, the results will include only completed
1206 orders. In any case, C<&ordersearch> ignores cancelled orders.
1207
1208 C<&ordersearch> returns an array.
1209 C<@results> is an array of references-to-hash with the following keys:
1210
1211 =over 4
1212
1213 =item C<author>
1214
1215 =item C<seriestitle>
1216
1217 =item C<branchcode>
1218
1219 =item C<bookfundid>
1220
1221 =back
1222
1223 =cut
1224
1225 sub SearchOrder {
1226 #### -------- SearchOrder-------------------------------
1227     my ($ordernumber, $search, $supplierid, $basket) = @_;
1228
1229     my $dbh = C4::Context->dbh;
1230     my @args = ();
1231     my $query =
1232             "SELECT *
1233             FROM aqorders
1234             LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1235             LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
1236             LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
1237                 WHERE  (datecancellationprinted is NULL)";
1238
1239     if($ordernumber){
1240         $query .= " AND (aqorders.ordernumber=?)";
1241         push @args, $ordernumber;
1242     }
1243     if($search){
1244         $query .= " AND (biblio.title like ? OR biblio.author LIKE ? OR biblioitems.isbn like ?)";
1245         push @args, ("%$search%","%$search%","%$search%");
1246     }
1247     if($supplierid){
1248         $query .= "AND aqbasket.booksellerid = ?";
1249         push @args, $supplierid;
1250     }
1251     if($basket){
1252         $query .= "AND aqorders.basketno = ?";
1253         push @args, $basket;
1254     }
1255
1256     my $sth = $dbh->prepare($query);
1257     $sth->execute(@args);
1258     my $results = $sth->fetchall_arrayref({});
1259     $sth->finish;
1260     return $results;
1261 }
1262
1263 #------------------------------------------------------------#
1264
1265 =head3 DelOrder
1266
1267 =over 4
1268
1269 &DelOrder($biblionumber, $ordernumber);
1270
1271 Cancel the order with the given order and biblio numbers. It does not
1272 delete any entries in the aqorders table, it merely marks them as
1273 cancelled.
1274
1275 =back
1276
1277 =cut
1278
1279 sub DelOrder {
1280     my ( $bibnum, $ordnum ) = @_;
1281     my $dbh = C4::Context->dbh;
1282     my $query = "
1283         UPDATE aqorders
1284         SET    datecancellationprinted=now()
1285         WHERE  biblionumber=? AND ordernumber=?
1286     ";
1287     my $sth = $dbh->prepare($query);
1288     $sth->execute( $bibnum, $ordnum );
1289     $sth->finish;
1290 }
1291
1292 =head2 FUNCTIONS ABOUT PARCELS
1293
1294 =cut
1295
1296 #------------------------------------------------------------#
1297
1298 =head3 GetParcel
1299
1300 =over 4
1301
1302 @results = &GetParcel($booksellerid, $code, $date);
1303
1304 Looks up all of the received items from the supplier with the given
1305 bookseller ID at the given date, for the given code (bookseller Invoice number). Ignores cancelled and completed orders.
1306
1307 C<@results> is an array of references-to-hash. The keys of each element are fields from
1308 the aqorders, biblio, and biblioitems tables of the Koha database.
1309
1310 C<@results> is sorted alphabetically by book title.
1311
1312 =back
1313
1314 =cut
1315
1316 sub GetParcel {
1317     #gets all orders from a certain supplier, orders them alphabetically
1318     my ( $supplierid, $code, $datereceived ) = @_;
1319     my $dbh     = C4::Context->dbh;
1320     my @results = ();
1321     $code .= '%'
1322       if $code;  # add % if we search on a given code (otherwise, let him empty)
1323     my $strsth ="
1324         SELECT  authorisedby,
1325                 creationdate,
1326                 aqbasket.basketno,
1327                 closedate,surname,
1328                 firstname,
1329                 aqorders.biblionumber,
1330                 aqorders.ordernumber,
1331                 aqorders.quantity,
1332                 aqorders.quantityreceived,
1333                 aqorders.unitprice,
1334                 aqorders.listprice,
1335                 aqorders.rrp,
1336                 aqorders.ecost,
1337                 biblio.title
1338         FROM aqorders
1339         LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
1340         LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
1341         LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1342         WHERE
1343             aqbasket.booksellerid = ?
1344             AND aqorders.booksellerinvoicenumber LIKE ?
1345             AND aqorders.datereceived = ? ";
1346
1347     my @query_params = ( $supplierid, $code, $datereceived );
1348     if ( C4::Context->preference("IndependantBranches") ) {
1349         my $userenv = C4::Context->userenv;
1350         if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
1351             $strsth .= " and (borrowers.branchcode = ?
1352                           or borrowers.branchcode  = '')";
1353             push @query_params, $userenv->{branch};
1354         }
1355     }
1356     $strsth .= " ORDER BY aqbasket.basketno";
1357     # ## parcelinformation : $strsth
1358     my $sth = $dbh->prepare($strsth);
1359     $sth->execute( @query_params );
1360     while ( my $data = $sth->fetchrow_hashref ) {
1361         push( @results, $data );
1362     }
1363     # ## countparcelbiblio: scalar(@results)
1364     $sth->finish;
1365
1366     return @results;
1367 }
1368
1369 #------------------------------------------------------------#
1370
1371 =head3 GetParcels
1372
1373 =over 4
1374
1375 $results = &GetParcels($bookseller, $order, $code, $datefrom, $dateto);
1376 get a lists of parcels.
1377
1378 =back
1379
1380 * Input arg :
1381
1382 =over 4
1383
1384 =item $bookseller
1385 is the bookseller this function has to get parcels.
1386
1387 =item $order
1388 To know on what criteria the results list has to be ordered.
1389
1390 =item $code
1391 is the booksellerinvoicenumber.
1392
1393 =item $datefrom & $dateto
1394 to know on what date this function has to filter its search.
1395
1396 * return:
1397 a pointer on a hash list containing parcel informations as such :
1398
1399 =item Creation date
1400
1401 =item Last operation
1402
1403 =item Number of biblio
1404
1405 =item Number of items
1406
1407 =back
1408
1409 =cut
1410
1411 sub GetParcels {
1412     my ($bookseller,$order, $code, $datefrom, $dateto) = @_;
1413     my $dbh    = C4::Context->dbh;
1414     my @query_params = ();
1415     my $strsth ="
1416         SELECT  aqorders.booksellerinvoicenumber,
1417                 datereceived,purchaseordernumber,
1418                 count(DISTINCT biblionumber) AS biblio,
1419                 sum(quantity) AS itemsexpected,
1420                 sum(quantityreceived) AS itemsreceived
1421         FROM   aqorders LEFT JOIN aqbasket ON aqbasket.basketno = aqorders.basketno
1422         WHERE aqbasket.booksellerid = $bookseller and datereceived IS NOT NULL
1423     ";
1424
1425     if ( defined $code ) {
1426         $strsth .= ' and aqorders.booksellerinvoicenumber like ? ';
1427         # add a % to the end of the code to allow stemming.
1428         push @query_params, "$code%";
1429     }
1430
1431     if ( defined $datefrom ) {
1432         $strsth .= ' and datereceived >= ? ';
1433         push @query_params, $datefrom;
1434     }
1435
1436     if ( defined $dateto ) {
1437         $strsth .=  'and datereceived <= ? ';
1438         push @query_params, $dateto;
1439     }
1440
1441     $strsth .= "group by aqorders.booksellerinvoicenumber,datereceived ";
1442
1443     # can't use a placeholder to place this column name.
1444     # but, we could probably be checking to make sure it is a column that will be fetched.
1445     $strsth .= "order by $order " if ($order);
1446
1447     my $sth = $dbh->prepare($strsth);
1448
1449     $sth->execute( @query_params );
1450     my $results = $sth->fetchall_arrayref({});
1451     $sth->finish;
1452     return @$results;
1453 }
1454
1455 #------------------------------------------------------------#
1456
1457 =head3 GetLateOrders
1458
1459 =over 4
1460
1461 @results = &GetLateOrders;
1462
1463 Searches for bookseller with late orders.
1464
1465 return:
1466 the table of supplier with late issues. This table is full of hashref.
1467
1468 =back
1469
1470 =cut
1471
1472 sub GetLateOrders {
1473     my $delay      = shift;
1474     my $supplierid = shift;
1475     my $branch     = shift;
1476
1477     my $dbh = C4::Context->dbh;
1478
1479     #BEWARE, order of parenthesis and LEFT JOIN is important for speed
1480     my $dbdriver = C4::Context->config("db_scheme") || "mysql";
1481
1482     my @query_params = ($delay);        # delay is the first argument regardless
1483         my $select = "
1484       SELECT aqbasket.basketno,
1485           aqorders.ordernumber,
1486           DATE(aqbasket.closedate)  AS orderdate,
1487           aqorders.rrp              AS unitpricesupplier,
1488           aqorders.ecost            AS unitpricelib,
1489           aqbudgets.budget_name     AS budget,
1490           borrowers.branchcode      AS branch,
1491           aqbooksellers.name        AS supplier,
1492           biblio.author,
1493           biblioitems.publishercode AS publisher,
1494           biblioitems.publicationyear,
1495         ";
1496         my $from = "
1497       FROM (((
1498           (aqorders LEFT JOIN biblio     ON biblio.biblionumber         = aqorders.biblionumber)
1499           LEFT JOIN biblioitems          ON biblioitems.biblionumber    = biblio.biblionumber)
1500           LEFT JOIN aqbudgets            ON aqorders.budget_id          = aqbudgets.budget_id),
1501           (aqbasket LEFT JOIN borrowers  ON aqbasket.authorisedby       = borrowers.borrowernumber)
1502           LEFT JOIN aqbooksellers        ON aqbasket.booksellerid       = aqbooksellers.id
1503           WHERE aqorders.basketno = aqbasket.basketno
1504           AND ( (datereceived = '' OR datereceived IS NULL)
1505               OR (aqorders.quantityreceived < aqorders.quantity)
1506           )
1507     ";
1508         my $having = "";
1509     if ($dbdriver eq "mysql") {
1510                 $select .= "
1511            aqorders.quantity - IFNULL(aqorders.quantityreceived,0)                 AS quantity,
1512           (aqorders.quantity - IFNULL(aqorders.quantityreceived,0)) * aqorders.rrp AS subtotal,
1513           DATEDIFF(CURDATE( ),closedate) AS latesince
1514                 ";
1515         $from .= " AND (closedate <= DATE_SUB(CURDATE( ),INTERVAL ? DAY)) ";
1516                 $having = "
1517          HAVING quantity          <> 0
1518             AND unitpricesupplier <> 0
1519             AND unitpricelib      <> 0
1520                 ";
1521     } else {
1522                 # FIXME: account for IFNULL as above
1523         $select .= "
1524                 aqorders.quantity                AS quantity,
1525                 aqorders.quantity * aqorders.rrp AS subtotal,
1526                 (CURDATE - closedate)            AS latesince
1527                 ";
1528         $from .= " AND (closedate <= (CURDATE -(INTERVAL ? DAY)) ";
1529     }
1530     if (defined $supplierid) {
1531                 $from .= ' AND aqbasket.booksellerid = ? ';
1532         push @query_params, $supplierid;
1533     }
1534     if (defined $branch) {
1535         $from .= ' AND borrowers.branchcode LIKE ? ';
1536         push @query_params, $branch;
1537     }
1538     if (C4::Context->preference("IndependantBranches")
1539              && C4::Context->userenv
1540              && C4::Context->userenv->{flags} != 1 ) {
1541         $from .= ' AND borrowers.branchcode LIKE ? ';
1542         push @query_params, C4::Context->userenv->{branch};
1543     }
1544         my $query = "$select $from $having\nORDER BY latesince, basketno, borrowers.branchcode, supplier";
1545         $debug and print STDERR "GetLateOrders query: $query\nGetLateOrders args: " . join(" ",@query_params);
1546     my $sth = $dbh->prepare($query);
1547     $sth->execute(@query_params);
1548     my @results;
1549     while (my $data = $sth->fetchrow_hashref) {
1550         $data->{orderdate} = format_date($data->{orderdate});
1551         push @results, $data;
1552     }
1553     return @results;
1554 }
1555
1556 #------------------------------------------------------------#
1557
1558 =head3 GetHistory
1559
1560 =over 4
1561
1562 (\@order_loop, $total_qty, $total_price, $total_qtyreceived) = GetHistory( $title, $author, $name, $from_placed_on, $to_placed_on );
1563
1564   Retreives some acquisition history information
1565
1566   returns:
1567     $order_loop is a list of hashrefs that each look like this:
1568               {
1569                 'author'           => 'Twain, Mark',
1570                 'basketno'         => '1',
1571                 'biblionumber'     => '215',
1572                 'count'            => 1,
1573                 'creationdate'     => 'MM/DD/YYYY',
1574                 'datereceived'     => undef,
1575                 'ecost'            => '1.00',
1576                 'id'               => '1',
1577                 'invoicenumber'    => undef,
1578                 'name'             => '',
1579                 'ordernumber'      => '1',
1580                 'quantity'         => 1,
1581                 'quantityreceived' => undef,
1582                 'title'            => 'The Adventures of Huckleberry Finn'
1583               }
1584     $total_qty is the sum of all of the quantities in $order_loop
1585     $total_price is the cost of each in $order_loop times the quantity
1586     $total_qtyreceived is the sum of all of the quantityreceived entries in $order_loop
1587
1588 =back
1589
1590 =cut
1591
1592 sub GetHistory {
1593     my ( $title, $author, $name, $from_placed_on, $to_placed_on ) = @_;
1594     my @order_loop;
1595     my $total_qty         = 0;
1596     my $total_qtyreceived = 0;
1597     my $total_price       = 0;
1598
1599 # don't run the query if there are no parameters (list would be too long for sure !)
1600     if ( $title || $author || $name || $from_placed_on || $to_placed_on ) {
1601         my $dbh   = C4::Context->dbh;
1602         my $query ="
1603             SELECT
1604                 biblio.title,
1605                 biblio.author,
1606                 aqorders.basketno,
1607                 name,aqbasket.creationdate,
1608                 aqorders.datereceived,
1609                 aqorders.quantity,
1610                 aqorders.quantityreceived,
1611                 aqorders.ecost,
1612                 aqorders.ordernumber,
1613                 aqorders.booksellerinvoicenumber as invoicenumber,
1614                 aqbooksellers.id as id,
1615                 aqorders.biblionumber
1616             FROM aqorders
1617             LEFT JOIN aqbasket ON aqorders.basketno=aqbasket.basketno
1618             LEFT JOIN aqbooksellers ON aqbasket.booksellerid=aqbooksellers.id
1619             LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber";
1620
1621         $query .= " LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber"
1622           if ( C4::Context->preference("IndependantBranches") );
1623
1624         $query .= " WHERE (datecancellationprinted is NULL or datecancellationprinted='0000-00-00') ";
1625
1626         my @query_params  = ();
1627
1628         if ( defined $title ) {
1629             $query .= " AND biblio.title LIKE ? ";
1630             push @query_params, "%$title%";
1631         }
1632
1633         if ( defined $author ) {
1634             $query .= " AND biblio.author LIKE ? ";
1635             push @query_params, "%$author%";
1636         }
1637
1638         if ( defined $name ) {
1639             $query .= " AND name LIKE ? ";
1640             push @query_params, "%$name%";
1641         }
1642
1643         if ( defined $from_placed_on ) {
1644             $query .= " AND creationdate >= ? ";
1645             push @query_params, $from_placed_on;
1646         }
1647
1648         if ( defined $to_placed_on ) {
1649             $query .= " AND creationdate <= ? ";
1650             push @query_params, $to_placed_on;
1651         }
1652
1653         if ( C4::Context->preference("IndependantBranches") ) {
1654             my $userenv = C4::Context->userenv;
1655             if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
1656                 $query .= " AND (borrowers.branchcode = ? OR borrowers.branchcode ='' ) ";
1657                 push @query_params, $userenv->{branch};
1658             }
1659         }
1660         $query .= " ORDER BY booksellerid";
1661         my $sth = $dbh->prepare($query);
1662         $sth->execute( @query_params );
1663         my $cnt = 1;
1664         while ( my $line = $sth->fetchrow_hashref ) {
1665             $line->{count} = $cnt++;
1666             $line->{toggle} = 1 if $cnt % 2;
1667             push @order_loop, $line;
1668             $line->{creationdate} = format_date( $line->{creationdate} );
1669             $line->{datereceived} = format_date( $line->{datereceived} );
1670             $total_qty         += $line->{'quantity'};
1671             $total_qtyreceived += $line->{'quantityreceived'};
1672             $total_price       += $line->{'quantity'} * $line->{'ecost'};
1673         }
1674     }
1675     return \@order_loop, $total_qty, $total_price, $total_qtyreceived;
1676 }
1677
1678 =head2 GetRecentAcqui
1679
1680    $results = GetRecentAcqui($days);
1681
1682    C<$results> is a ref to a table which containts hashref
1683
1684 =cut
1685
1686 sub GetRecentAcqui {
1687     my $limit  = shift;
1688     my $dbh    = C4::Context->dbh;
1689     my $query = "
1690         SELECT *
1691         FROM   biblio
1692         ORDER BY timestamp DESC
1693         LIMIT  0,".$limit;
1694
1695     my $sth = $dbh->prepare($query);
1696     $sth->execute;
1697     my $results = $sth->fetchall_arrayref({});
1698     return $results;
1699 }
1700
1701 =head3 GetContracts
1702
1703 =over 4
1704
1705 $contractlist = &GetContracts($booksellerid, $activeonly);
1706
1707 Looks up the contracts that belong to a bookseller
1708
1709 Returns a list of contracts
1710
1711 =item C<$booksellerid> is the "id" field in the "aqbooksellers" table.
1712
1713 =item C<$activeonly> if exists get only contracts that are still active.
1714
1715 =back
1716
1717 =cut
1718 sub GetContracts {
1719     my ( $booksellerid, $activeonly ) = @_;
1720     my $dbh = C4::Context->dbh;
1721     my $query;
1722     if (! $activeonly) {
1723         $query = "
1724             SELECT *
1725             FROM   aqcontract
1726             WHERE  booksellerid=?
1727         ";
1728     } else {
1729         $query = "SELECT *
1730             FROM aqcontract
1731             WHERE booksellerid=?
1732                 AND contractenddate >= CURDATE( )";
1733     }
1734     my $sth = $dbh->prepare($query);
1735     $sth->execute( $booksellerid );
1736     my @results;
1737     while (my $data = $sth->fetchrow_hashref ) {
1738         push(@results, $data);
1739     }
1740     $sth->finish;
1741     return @results;
1742 }
1743
1744 #------------------------------------------------------------#
1745
1746 =head3 GetContract
1747
1748 =over 4
1749
1750 $contract = &GetContract($contractID);
1751
1752 Looks up the contract that has PRIMKEY (contractnumber) value $contractID
1753
1754 Returns a contract
1755
1756 =back
1757
1758 =cut
1759 sub GetContract {
1760     my ( $contractno ) = @_;
1761     my $dbh = C4::Context->dbh;
1762     my $query = "
1763         SELECT *
1764         FROM   aqcontract
1765         WHERE  contractnumber=?
1766         ";
1767
1768     my $sth = $dbh->prepare($query);
1769     $sth->execute( $contractno );
1770     my $result = $sth->fetchrow_hashref;
1771     return $result;
1772 }
1773
1774 1;
1775 __END__
1776
1777 =head1 AUTHOR
1778
1779 Koha Developement team <info@koha.org>
1780
1781 =cut