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