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