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->{'closed'} is the 'closed' field of the aqbasketgroups table, it is false if 0, true otherwise.
 484
 485 =back
 486
 487 =back
 488
 489 =cut
 490
 491 sub NewBasketgroup {
 492     my $basketgroupinfo = shift;
 493     die "booksellerid is required to create a basketgroup" unless $basketgroupinfo->{'booksellerid'};
 494     my $query = "INSERT INTO aqbasketgroups (";
 495     my @params;
 496     foreach my $field ('name', 'closed') {
 497         if ( $basketgroupinfo->{$field} ) {
 498             $query .= "$field, ";
 499             push(@params, $basketgroupinfo->{$field});
 500         }
 501     }
 502     $query .= "booksellerid) VALUES (";
 503     foreach (@params) {
 504         $query .= "?, ";
 505     }
 506     $query .= "?)";
 507     push(@params, $basketgroupinfo->{'booksellerid'});
 508     my $dbh = C4::Context->dbh;
 509     my $sth = $dbh->prepare($query);
 510     $sth->execute(@params);
 511     my $basketgroupid = $dbh->{'mysql_insertid'};
 512     if( $basketgroupinfo->{'basketlist'} ) {
 513         foreach my $basketno (@{$basketgroupinfo->{'basketlist'}}) {
 514             my $query2 = "UPDATE aqbasket SET basketgroupid=? WHERE basketno=?";
 515             my $sth2 = $dbh->prepare($query2);
 516             $sth2->execute($basketgroupid, $basketno);
 517         }
 518     }
 519     return $basketgroupid;
 520 }
 521
 522 #------------------------------------------------------------#
 523
 524 =head3 ModBasketgroup
 525
 526 =over 4
 527
 528 ModBasketgroup(\%hashref);
 529
 530 =over 2
 531
 532 Modifies a basketgroup in the aqbasketgroups table, and add the baskets to it.
 533
 534 $hashref->{'id'} is the 'id' field of the basketgroup in the aqbasketgroup table, this parameter is mandatory,
 535
 536 $hashref->{'name'} is the 'name' field of the basketgroup in the aqbasketgroups table,
 537
 538 $hashref->{'basketlist'} is a list reference of the 'id's of the baskets that belong to this group,
 539
 540 $hashref->{'closed'} is the 'closed' field of the aqbasketgroups table, it is false if 0, true otherwise.
 541
 542 =back
 543
 544 =back
 545
 546 =cut
 547
 548 sub ModBasketgroup {
 549     my $basketgroupinfo = shift;
 550     die "basketgroup id is required to edit a basketgroup" unless $basketgroupinfo->{'id'};
 551     my $dbh = C4::Context->dbh;
 552     my $query = "UPDATE aqbasketgroups SET ";
 553     my @params;
 554     foreach my $field (qw(name closed)) {
 555         if ( $basketgroupinfo->{$field} ne undef) {
 556             $query .= "$field=?, ";
 557             push(@params, $basketgroupinfo->{$field});
 558         }
 559     }
 560     chop($query);
 561     chop($query);
 562     $query .= " WHERE id=?";
 563     push(@params, $basketgroupinfo->{'id'});
 564     my $sth = $dbh->prepare($query);
 565     $sth->execute(@params);
 566
 567     $sth = $dbh->prepare('UPDATE aqbasket SET basketgroupid = NULL WHERE basketgroupid = ?');
 568     $sth->execute($basketgroupinfo->{'id'});
 569
 570     if($basketgroupinfo->{'basketlist'} && @{$basketgroupinfo->{'basketlist'}}){
 571         $sth = $dbh->prepare("UPDATE aqbasket SET basketgroupid=? WHERE basketno=?");
 572         foreach my $basketno (@{$basketgroupinfo->{'basketlist'}}) {
 573             $sth->execute($basketgroupinfo->{'id'}, $basketno);
 574             $sth->finish;
 575         }
 576     }
 577     $sth->finish;
 578 }
 579
 580 #------------------------------------------------------------#
 581
 582 =head3 DelBasketgroup
 583
 584 =over 4
 585
 586 DelBasketgroup($basketgroupid);
 587
 588 =over 2
 589
 590 Deletes a basketgroup in the aqbasketgroups table, and removes the reference to it from the baskets,
 591
 592 =item C<$basketgroupid> is the 'id' field of the basket in the aqbasketgroup table
 593
 594 =back
 595
 596 =back
 597
 598 =cut
 599
 600 sub DelBasketgroup {
 601     my $basketgroupid = shift;
 602     die "basketgroup id is required to edit a basketgroup" unless $basketgroupid;
 603     my $query = "DELETE FROM aqbasketgroups WHERE id=?";
 604     my $dbh = C4::Context->dbh;
 605     my $sth = $dbh->prepare($query);
 606     $sth->execute($basketgroupid);
 607     $sth->finish;
 608 }
 609
 610 #------------------------------------------------------------#
 611
 612 =back
 613
 614 =head2 FUNCTIONS ABOUT ORDERS
 615
 616 =over 2
 617
 618 =cut
 619
 620 =head3 GetBasketgroup
 621
 622 =over 4
 623
 624 $basketgroup = &GetBasketgroup($basketgroupid);
 625
 626 =over 2
 627
 628 Returns a reference to the hash containing all infermation about the basketgroup.
 629
 630 =back
 631
 632 =back
 633
 634 =cut
 635
 636 sub GetBasketgroup {
 637     my $basketgroupid = shift;
 638     die "basketgroup id is required to edit a basketgroup" unless $basketgroupid;
 639     my $query = "SELECT * FROM aqbasketgroups WHERE id=?";
 640     my $dbh = C4::Context->dbh;
 641     my $sth = $dbh->prepare($query);
 642     $sth->execute($basketgroupid);
 643     my $result = $sth->fetchrow_hashref;
 644     $sth->finish;
 645     return $result
 646 }
 647
 648 #------------------------------------------------------------#
 649
 650 =head3 GetBasketgroups
 651
 652 =over 4
 653
 654 $basketgroups = &GetBasketgroups($booksellerid);
 655
 656 =over 2
 657
 658 Returns a reference to the array of all the basketgroups of bookseller $booksellerid.
 659
 660 =back
 661
 662 =back
 663
 664 =cut
 665
 666 sub GetBasketgroups {
 667     my $booksellerid = shift;
 668     die "bookseller id is required to edit a basketgroup" unless $booksellerid;
 669     my $query = "SELECT * FROM aqbasketgroups WHERE booksellerid=?";
 670     my $dbh = C4::Context->dbh;
 671     my $sth = $dbh->prepare($query);
 672     $sth->execute($booksellerid);
 673     my $results = $sth->fetchall_arrayref({});
 674     $sth->finish;
 675     return $results
 676 }
 677
 678 #------------------------------------------------------------#
 679
 680 =back
 681
 682 =head2 FUNCTIONS ABOUT ORDERS
 683
 684 =over 2
 685
 686 =cut
 687
 688 #------------------------------------------------------------#
 689
 690 =head3 GetPendingOrders
 691
 692 =over 4
 693
 694 $orders = &GetPendingOrders($booksellerid, $grouped, $owner);
 695
 696 Finds pending orders from the bookseller with the given ID. Ignores
 697 completed and cancelled orders.
 698
 699 C<$booksellerid> contains the bookseller identifier
 700 C<$grouped> contains 0 or 1. 0 means returns the list, 1 means return the total
 701 C<$owner> contains 0 or 1. 0 means any owner. 1 means only the list of orders entered by the user itself.
 702
 703 C<$orders> is a reference-to-array; each element is a
 704 reference-to-hash with the following fields:
 705 C<$grouped> is a boolean that, if set to 1 will group all order lines of the same basket
 706 in a single result line
 707
 708 =over 2
 709
 710 =item C<authorizedby>
 711
 712 =item C<entrydate>
 713
 714 =item C<basketno>
 715
 716 These give the value of the corresponding field in the aqorders table
 717 of the Koha database.
 718
 719 =back
 720
 721 =back
 722
 723 Results are ordered from most to least recent.
 724
 725 =cut
 726
 727 sub GetPendingOrders {
 728     my ($supplierid,$grouped,$owner,$basketno) = @_;
 729     my $dbh = C4::Context->dbh;
 730     my $strsth = "
 731         SELECT    ".($grouped?"count(*),":"")."aqbasket.basketno,
 732                     surname,firstname,aqorders.*,biblio.*,biblioitems.isbn,
 733                     aqbasket.closedate, aqbasket.creationdate, aqbasket.basketname
 734         FROM      aqorders
 735         LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
 736         LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
 737         LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber
 738         LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
 739         WHERE booksellerid=?
 740             AND (quantity > quantityreceived OR quantityreceived is NULL)
 741             AND datecancellationprinted IS NULL
 742             AND (to_days(now())-to_days(closedate) < 180 OR closedate IS NULL)
 743     ";
 744     ## FIXME  Why 180 days ???
 745     my @query_params = ( $supplierid );
 746     my $userenv = C4::Context->userenv;
 747     if ( C4::Context->preference("IndependantBranches") ) {
 748         if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
 749             $strsth .= " and (borrowers.branchcode = ?
 750                         or borrowers.branchcode  = '')";
 751             push @query_params, $userenv->{branch};
 752         }
 753     }
 754     if ($owner) {
 755         $strsth .= " AND aqbasket.authorisedby=? ";
 756         push @query_params, $userenv->{'number'};
 757     }
 758     if ($basketno) {
 759         $strsth .= " AND aqbasket.basketno=? ";
 760         push @query_params, $basketno;
 761     }
 762     $strsth .= " group by aqbasket.basketno" if $grouped;
 763     $strsth .= " order by aqbasket.basketno";
 764
 765     my $sth = $dbh->prepare($strsth);
 766     $sth->execute( @query_params );
 767     my $results = $sth->fetchall_arrayref({});
 768     $sth->finish;
 769     return $results;
 770 }
 771
 772 #------------------------------------------------------------#
 773
 774 =head3 GetOrders
 775
 776 =over 4
 777
 778 @orders = &GetOrders($basketnumber, $orderby);
 779
 780 Looks up the pending (non-cancelled) orders with the given basket
 781 number. If C<$booksellerID> is non-empty, only orders from that seller
 782 are returned.
 783
 784 return :
 785 C<&basket> returns a two-element array. C<@orders> is an array of
 786 references-to-hash, whose keys are the fields from the aqorders,
 787 biblio, and biblioitems tables in the Koha database.
 788
 789 =back
 790
 791 =cut
 792
 793 sub GetOrders {
 794     my ( $basketno, $orderby ) = @_;
 795     my $dbh   = C4::Context->dbh;
 796     my $query  ="
 797         SELECT biblio.*,biblioitems.*,
 798                 aqorders.*,
 799                 aqbudgets.*,
 800                 biblio.title
 801         FROM    aqorders
 802             LEFT JOIN aqbudgets        ON aqbudgets.budget_id = aqorders.budget_id
 803             LEFT JOIN biblio           ON biblio.biblionumber = aqorders.biblionumber
 804             LEFT JOIN biblioitems      ON biblioitems.biblionumber =biblio.biblionumber
 805         WHERE   basketno=?
 806             AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00')
 807     ";
 808
 809     $orderby = "biblioitems.publishercode,biblio.title" unless $orderby;
 810     $query .= " ORDER BY $orderby";
 811     my $sth = $dbh->prepare($query);
 812     $sth->execute($basketno);
 813     my $results = $sth->fetchall_arrayref({});
 814     $sth->finish;
 815     return @$results;
 816 }
 817
 818 #------------------------------------------------------------#
 819
 820 =head3 GetOrderNumber
 821
 822 =over 4
 823
 824 $ordernumber = &GetOrderNumber($biblioitemnumber, $biblionumber);
 825
 826 =back
 827
 828 Looks up the ordernumber with the given biblionumber and biblioitemnumber.
 829
 830 Returns the number of this order.
 831
 832 =over 4
 833
 834 =item C<$ordernumber> is the order number.
 835
 836 =back
 837
 838 =cut
 839 sub GetOrderNumber {
 840     my ( $biblionumber,$biblioitemnumber ) = @_;
 841     my $dbh = C4::Context->dbh;
 842     my $query = "
 843         SELECT ordernumber
 844         FROM   aqorders
 845         WHERE  biblionumber=?
 846         AND    biblioitemnumber=?
 847     ";
 848     my $sth = $dbh->prepare($query);
 849     $sth->execute( $biblionumber, $biblioitemnumber );
 850
 851     return $sth->fetchrow;
 852 }
 853
 854 #------------------------------------------------------------#
 855
 856 =head3 GetOrder
 857
 858 =over 4
 859
 860 $order = &GetOrder($ordernumber);
 861
 862 Looks up an order by order number.
 863
 864 Returns a reference-to-hash describing the order. The keys of
 865 C<$order> are fields from the biblio, biblioitems, aqorders tables of the Koha database.
 866
 867 =back
 868
 869 =cut
 870
 871 sub GetOrder {
 872     my ($ordernumber) = @_;
 873     my $dbh      = C4::Context->dbh;
 874     my $query = "
 875         SELECT biblioitems.*, biblio.*, aqorders.*
 876         FROM   aqorders
 877         LEFT JOIN biblio on           biblio.biblionumber=aqorders.biblionumber
 878         LEFT JOIN biblioitems on       biblioitems.biblionumber=aqorders.biblionumber
 879         WHERE aqorders.ordernumber=?
 880
 881     ";
 882     my $sth= $dbh->prepare($query);
 883     $sth->execute($ordernumber);
 884     my $data = $sth->fetchrow_hashref;
 885     $sth->finish;
 886     return $data;
 887 }
 888
 889 #------------------------------------------------------------#
 890
 891 =head3 NewOrder
 892
 893 =over 4
 894
 895 &NewOrder(\%hashref);
 896
 897 Adds a new order to the database. Any argument that isn't described
 898 below is the new value of the field with the same name in the aqorders
 899 table of the Koha database.
 900
 901 =over 4
 902
 903 =item $hashref->{'basketno'} is the basketno foreign key in aqorders, it is mandatory
 904
 905
 906 =item $hashref->{'ordernumber'} is a "minimum order number."
 907
 908 =item $hashref->{'budgetdate'} is effectively ignored.
 909 If it's undef (anything false) or the string 'now', the current day is used.
 910 Else, the upcoming July 1st is used.
 911
 912 =item $hashref->{'subscription'} may be either "yes", or anything else for "no".
 913
 914 =item $hashref->{'uncertainprice'} may be 0 for "the price is known" or 1 for "the price is uncertain"
 915
 916 =item defaults entrydate to Now
 917
 918 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".
 919
 920 =back
 921
 922 =back
 923
 924 =cut
 925
 926 sub NewOrder {
 927     my $orderinfo = shift;
 928 #### ------------------------------
 929     my $dbh = C4::Context->dbh;
 930     my @params;
 931
 932
 933     # if these parameters are missing, we can't continue
 934     for my $key (qw/basketno quantity biblionumber budget_id/) {
 935         die "Mandatory parameter $key missing" unless $orderinfo->{$key};
 936     }
 937
 938     if ( $orderinfo->{'subscription'} eq 'yes' ) {
 939         $orderinfo->{'subscription'} = 1;
 940     } else {
 941         $orderinfo->{'subscription'} = 0;
 942     }
 943     $orderinfo->{'entrydate'} ||= C4::Dates->new()->output("iso");
 944
 945     my $ordernumber=InsertInTable("aqorders",$orderinfo);
 946     return ( $orderinfo->{'basketno'}, $ordernumber );
 947 }
 948
 949
 950
 951 #------------------------------------------------------------#
 952
 953 =head3 NewOrderItem
 954
 955 =over 4
 956
 957 &NewOrderItem();
 958
 959
 960 =back
 961
 962 =cut
 963
 964 sub NewOrderItem {
 965     #my ($biblioitemnumber,$ordernumber, $biblionumber) = @_;
 966     my ($itemnumber, $ordernumber)  = @_;
 967     my $dbh = C4::Context->dbh;
 968     my $query = qq|
 969             INSERT INTO aqorders_items
 970                 (itemnumber, ordernumber)
 971             VALUES (?,?)    |;
 972
 973     my $sth = $dbh->prepare($query);
 974     $sth->execute( $itemnumber, $ordernumber);
 975 }
 976
 977 #------------------------------------------------------------#
 978
 979 =head3 ModOrder
 980
 981 =over 4
 982
 983 &ModOrder(\%hashref);
 984
 985 =over 2
 986
 987 Modifies an existing order. Updates the order with order number
 988 $hashref->{'ordernumber'} and biblionumber $hashref->{'biblionumber'}. All other keys of the hash
 989 update the fields with the same name in the aqorders table of the Koha database.
 990
 991 =back
 992
 993 =back
 994
 995 =cut
 996
 997 sub ModOrder {
 998     my $orderinfo = shift;
 999
1000     die "Ordernumber is required"     if $orderinfo->{'ordernumber'} eq  '' ;
1001     die "Biblionumber is required"  if  $orderinfo->{'biblionumber'} eq '';
1002
1003     my $dbh = C4::Context->dbh;
1004     my @params;
1005 #    delete($orderinfo->{'branchcode'});
1006     # the hash contains a lot of entries not in aqorders, so get the columns ...
1007     my $sth = $dbh->prepare("SELECT * FROM aqorders LIMIT 1;");
1008     $sth->execute;
1009     my $colnames = $sth->{NAME};
1010     my $query = "UPDATE aqorders SET ";
1011
1012     foreach my $orderinfokey (grep(!/ordernumber/, keys %$orderinfo)){
1013         # ... and skip hash entries that are not in the aqorders table
1014         # FIXME : probably not the best way to do it (would be better to have a correct hash)
1015         next unless grep(/^$orderinfokey$/, @$colnames);
1016             $query .= "$orderinfokey=?, ";
1017             push(@params, $orderinfo->{$orderinfokey});
1018     }
1019
1020     $query .= "timestamp=NOW()  WHERE  ordernumber=?";
1021 #   push(@params, $specorderinfo{'ordernumber'});
1022     push(@params, $orderinfo->{'ordernumber'} );
1023     $sth = $dbh->prepare($query);
1024     $sth->execute(@params);
1025     $sth->finish;
1026 }
1027
1028 #------------------------------------------------------------#
1029
1030 =head3 ModOrderItem
1031
1032 =over 4
1033
1034 &ModOrderItem(\%hashref);
1035
1036 =over 2
1037
1038 Modifies the itemnumber in the aqorders_items table. The input hash needs three entities:
1039 - itemnumber: the old itemnumber
1040 - ordernumber: the order this item is attached to
1041 - newitemnumber: the new itemnumber we want to attach the line to
1042
1043 =back
1044
1045 =back
1046
1047 =cut
1048
1049 sub ModOrderItem {
1050     my $orderiteminfo = shift;
1051     if (! $orderiteminfo->{'ordernumber'} || ! $orderiteminfo->{'itemnumber'} || ! $orderiteminfo->{'newitemnumber'}){
1052         die "Ordernumber, itemnumber and newitemnumber is required";
1053     }
1054
1055     my $dbh = C4::Context->dbh;
1056
1057     my $query = "UPDATE aqorders_items set itemnumber=? where itemnumber=? and ordernumber=?";
1058     my @params = ($orderiteminfo->{'newitemnumber'}, $orderiteminfo->{'itemnumber'}, $orderiteminfo->{'ordernumber'});
1059     warn $query;
1060     warn Data::Dumper::Dumper(@params);
1061     my $sth = $dbh->prepare($query);
1062     $sth->execute(@params);
1063     return 0;
1064 }
1065
1066 #------------------------------------------------------------#
1067
1068
1069 =head3 ModOrderBibliotemNumber
1070
1071 =over 4
1072
1073 &ModOrderBiblioitemNumber($biblioitemnumber,$ordernumber, $biblionumber);
1074
1075 Modifies the biblioitemnumber for an existing order.
1076 Updates the order with order number C<$ordernum> and biblionumber C<$biblionumber>.
1077
1078 =back
1079
1080 =cut
1081
1082 #FIXME: is this used at all?
1083 sub ModOrderBiblioitemNumber {
1084     my ($biblioitemnumber,$ordernumber, $biblionumber) = @_;
1085     my $dbh = C4::Context->dbh;
1086     my $query = "
1087     UPDATE aqorders
1088     SET    biblioitemnumber = ?
1089     WHERE  ordernumber = ?
1090     AND biblionumber =  ?";
1091     my $sth = $dbh->prepare($query);
1092     $sth->execute( $biblioitemnumber, $ordernumber, $biblionumber );
1093 }
1094
1095 #------------------------------------------------------------#
1096
1097 =head3 ModReceiveOrder
1098
1099 =over 4
1100
1101 &ModReceiveOrder($biblionumber, $ordernumber, $quantityreceived, $user,
1102     $unitprice, $booksellerinvoicenumber, $biblioitemnumber,
1103     $freight, $bookfund, $rrp);
1104
1105 Updates an order, to reflect the fact that it was received, at least
1106 in part. All arguments not mentioned below update the fields with the
1107 same name in the aqorders table of the Koha database.
1108
1109 If a partial order is received, splits the order into two.  The received
1110 portion must have a booksellerinvoicenumber.
1111
1112 Updates the order with bibilionumber C<$biblionumber> and ordernumber
1113 C<$ordernumber>.
1114
1115 =back
1116
1117 =cut
1118
1119
1120 sub ModReceiveOrder {
1121     my (
1122         $biblionumber,    $ordernumber,  $quantrec, $user, $cost,
1123         $invoiceno, $freight, $rrp, $budget_id, $datereceived
1124     )
1125     = @_;
1126     my $dbh = C4::Context->dbh;
1127 #     warn "DATE BEFORE : $daterecieved";
1128 #    $daterecieved=POSIX::strftime("%Y-%m-%d",CORE::localtime) unless $daterecieved;
1129 #     warn "DATE REC : $daterecieved";
1130     $datereceived = C4::Dates->output('iso') unless $datereceived;
1131     my $suggestionid = GetSuggestionFromBiblionumber( $dbh, $biblionumber );
1132     if ($suggestionid) {
1133         ModStatus( $suggestionid, 'AVAILABLE', '', $biblionumber );
1134     }
1135
1136     my $sth=$dbh->prepare("
1137         SELECT * FROM   aqorders
1138         WHERE           biblionumber=? AND aqorders.ordernumber=?");
1139
1140     $sth->execute($biblionumber,$ordernumber);
1141     my $order = $sth->fetchrow_hashref();
1142     $sth->finish();
1143
1144     if ( $order->{quantity} > $quantrec ) {
1145         $sth=$dbh->prepare("
1146             UPDATE aqorders
1147             SET quantityreceived=?
1148                 , datereceived=?
1149                 , booksellerinvoicenumber=?
1150                 , unitprice=?
1151                 , freight=?
1152                 , rrp=?
1153                 , quantityreceived=?
1154             WHERE biblionumber=? AND ordernumber=?");
1155
1156         $sth->execute($quantrec,$datereceived,$invoiceno,$cost,$freight,$rrp,$quantrec,$biblionumber,$ordernumber);
1157         $sth->finish;
1158
1159         # create a new order for the remaining items, and set its bookfund.
1160         foreach my $orderkey ( "linenumber", "allocation" ) {
1161             delete($order->{'$orderkey'});
1162         }
1163         my $newOrder = NewOrder($order);
1164 } else {
1165         $sth=$dbh->prepare("update aqorders
1166                             set quantityreceived=?,datereceived=?,booksellerinvoicenumber=?,
1167                                 unitprice=?,freight=?,rrp=?
1168                             where biblionumber=? and ordernumber=?");
1169         $sth->execute($quantrec,$datereceived,$invoiceno,$cost,$freight,$rrp,$biblionumber,$ordernumber);
1170         $sth->finish;
1171     }
1172     return $datereceived;
1173 }
1174 #------------------------------------------------------------#
1175
1176 =head3 SearchOrder
1177
1178 @results = &SearchOrder($search, $biblionumber, $complete);
1179
1180 Searches for orders.
1181
1182 C<$search> may take one of several forms: if it is an ISBN,
1183 C<&ordersearch> returns orders with that ISBN. If C<$search> is an
1184 order number, C<&ordersearch> returns orders with that order number
1185 and biblionumber C<$biblionumber>. Otherwise, C<$search> is considered
1186 to be a space-separated list of search terms; in this case, all of the
1187 terms must appear in the title (matching the beginning of title
1188 words).
1189
1190 If C<$complete> is C<yes>, the results will include only completed
1191 orders. In any case, C<&ordersearch> ignores cancelled orders.
1192
1193 C<&ordersearch> returns an array.
1194 C<@results> is an array of references-to-hash with the following keys:
1195
1196 =over 4
1197
1198 =item C<author>
1199
1200 =item C<seriestitle>
1201
1202 =item C<branchcode>
1203
1204 =item C<bookfundid>
1205
1206 =back
1207
1208 =cut
1209
1210 sub SearchOrder {
1211 #### -------- SearchOrder-------------------------------
1212     my ($ordernumber, $search, $supplierid, $basket) = @_;
1213
1214     my $dbh = C4::Context->dbh;
1215     my @args = ();
1216     my $query =
1217             "SELECT *
1218             FROM aqorders
1219             LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1220             LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
1221             LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
1222                 WHERE  (datecancellationprinted is NULL)";
1223
1224     if($ordernumber){
1225         $query .= " AND (aqorders.ordernumber=?)";
1226         push @args, $ordernumber;
1227     }
1228     if($search){
1229         $query .= " AND (biblio.title like ? OR biblio.author LIKE ? OR biblioitems.isbn like ?)";
1230         push @args, ("%$search%","%$search%","%$search%");
1231     }
1232     if($supplierid){
1233         $query .= "AND aqbasket.booksellerid = ?";
1234         push @args, $supplierid;
1235     }
1236     if($basket){
1237         $query .= "AND aqorders.basketno = ?";
1238         push @args, $basket;
1239     }
1240
1241     my $sth = $dbh->prepare($query);
1242     $sth->execute(@args);
1243     my $results = $sth->fetchall_arrayref({});
1244     $sth->finish;
1245     return $results;
1246 }
1247
1248 #------------------------------------------------------------#
1249
1250 =head3 DelOrder
1251
1252 =over 4
1253
1254 &DelOrder($biblionumber, $ordernumber);
1255
1256 Cancel the order with the given order and biblio numbers. It does not
1257 delete any entries in the aqorders table, it merely marks them as
1258 cancelled.
1259
1260 =back
1261
1262 =cut
1263
1264 sub DelOrder {
1265     my ( $bibnum, $ordernumber ) = @_;
1266     my $dbh = C4::Context->dbh;
1267     my $query = "
1268         UPDATE aqorders
1269         SET    datecancellationprinted=now()
1270         WHERE  biblionumber=? AND ordernumber=?
1271     ";
1272     my $sth = $dbh->prepare($query);
1273     $sth->execute( $bibnum, $ordernumber );
1274     $sth->finish;
1275 }
1276
1277 =head2 FUNCTIONS ABOUT PARCELS
1278
1279 =cut
1280
1281 #------------------------------------------------------------#
1282
1283 =head3 GetParcel
1284
1285 =over 4
1286
1287 @results = &GetParcel($booksellerid, $code, $date);
1288
1289 Looks up all of the received items from the supplier with the given
1290 bookseller ID at the given date, for the given code (bookseller Invoice number). Ignores cancelled and completed orders.
1291
1292 C<@results> is an array of references-to-hash. The keys of each element are fields from
1293 the aqorders, biblio, and biblioitems tables of the Koha database.
1294
1295 C<@results> is sorted alphabetically by book title.
1296
1297 =back
1298
1299 =cut
1300
1301 sub GetParcel {
1302     #gets all orders from a certain supplier, orders them alphabetically
1303     my ( $supplierid, $code, $datereceived ) = @_;
1304     my $dbh     = C4::Context->dbh;
1305     my @results = ();
1306     $code .= '%'
1307     if $code;  # add % if we search on a given code (otherwise, let him empty)
1308     my $strsth ="
1309         SELECT  authorisedby,
1310                 creationdate,
1311                 aqbasket.basketno,
1312                 closedate,surname,
1313                 firstname,
1314                 aqorders.biblionumber,
1315                 aqorders.ordernumber,
1316                 aqorders.quantity,
1317                 aqorders.quantityreceived,
1318                 aqorders.unitprice,
1319                 aqorders.listprice,
1320                 aqorders.rrp,
1321                 aqorders.ecost,
1322                 biblio.title
1323         FROM aqorders
1324         LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
1325         LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
1326         LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1327         WHERE
1328             aqbasket.booksellerid = ?
1329             AND aqorders.booksellerinvoicenumber LIKE ?
1330             AND aqorders.datereceived = ? ";
1331
1332     my @query_params = ( $supplierid, $code, $datereceived );
1333     if ( C4::Context->preference("IndependantBranches") ) {
1334         my $userenv = C4::Context->userenv;
1335         if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
1336             $strsth .= " and (borrowers.branchcode = ?
1337                         or borrowers.branchcode  = '')";
1338             push @query_params, $userenv->{branch};
1339         }
1340     }
1341     $strsth .= " ORDER BY aqbasket.basketno";
1342     # ## parcelinformation : $strsth
1343     my $sth = $dbh->prepare($strsth);
1344     $sth->execute( @query_params );
1345     while ( my $data = $sth->fetchrow_hashref ) {
1346         push( @results, $data );
1347     }
1348     # ## countparcelbiblio: scalar(@results)
1349     $sth->finish;
1350
1351     return @results;
1352 }
1353
1354 #------------------------------------------------------------#
1355
1356 =head3 GetParcels
1357
1358 =over 4
1359
1360 $results = &GetParcels($bookseller, $order, $code, $datefrom, $dateto);
1361 get a lists of parcels.
1362
1363 =back
1364
1365 * Input arg :
1366
1367 =over 4
1368
1369 =item $bookseller
1370 is the bookseller this function has to get parcels.
1371
1372 =item $order
1373 To know on what criteria the results list has to be ordered.
1374
1375 =item $code
1376 is the booksellerinvoicenumber.
1377
1378 =item $datefrom & $dateto
1379 to know on what date this function has to filter its search.
1380
1381 * return:
1382 a pointer on a hash list containing parcel informations as such :
1383
1384 =item Creation date
1385
1386 =item Last operation
1387
1388 =item Number of biblio
1389
1390 =item Number of items
1391
1392 =back
1393
1394 =cut
1395
1396 sub GetParcels {
1397     my ($bookseller,$order, $code, $datefrom, $dateto) = @_;
1398     my $dbh    = C4::Context->dbh;
1399     my @query_params = ();
1400     my $strsth ="
1401         SELECT  aqorders.booksellerinvoicenumber,
1402                 datereceived,purchaseordernumber,
1403                 count(DISTINCT biblionumber) AS biblio,
1404                 sum(quantity) AS itemsexpected,
1405                 sum(quantityreceived) AS itemsreceived
1406         FROM   aqorders LEFT JOIN aqbasket ON aqbasket.basketno = aqorders.basketno
1407         WHERE aqbasket.booksellerid = $bookseller and datereceived IS NOT NULL
1408     ";
1409
1410     if ( defined $code ) {
1411         $strsth .= ' and aqorders.booksellerinvoicenumber like ? ';
1412         # add a % to the end of the code to allow stemming.
1413         push @query_params, "$code%";
1414     }
1415
1416     if ( defined $datefrom ) {
1417         $strsth .= ' and datereceived >= ? ';
1418         push @query_params, $datefrom;
1419     }
1420
1421     if ( defined $dateto ) {
1422         $strsth .=  'and datereceived <= ? ';
1423         push @query_params, $dateto;
1424     }
1425
1426     $strsth .= "group by aqorders.booksellerinvoicenumber,datereceived ";
1427
1428     # can't use a placeholder to place this column name.
1429     # but, we could probably be checking to make sure it is a column that will be fetched.
1430     $strsth .= "order by $order " if ($order);
1431
1432     my $sth = $dbh->prepare($strsth);
1433
1434     $sth->execute( @query_params );
1435     my $results = $sth->fetchall_arrayref({});
1436     $sth->finish;
1437     return @$results;
1438 }
1439
1440 #------------------------------------------------------------#
1441
1442 =head3 GetLateOrders
1443
1444 =over 4
1445
1446 @results = &GetLateOrders;
1447
1448 Searches for bookseller with late orders.
1449
1450 return:
1451 the table of supplier with late issues. This table is full of hashref.
1452
1453 =back
1454
1455 =cut
1456
1457 sub GetLateOrders {
1458     my $delay      = shift;
1459     my $supplierid = shift;
1460     my $branch     = shift;
1461
1462     my $dbh = C4::Context->dbh;
1463
1464     #BEWARE, order of parenthesis and LEFT JOIN is important for speed
1465     my $dbdriver = C4::Context->config("db_scheme") || "mysql";
1466
1467     my @query_params = ($delay);        # delay is the first argument regardless
1468     my $select = "
1469     SELECT aqbasket.basketno,
1470         aqorders.ordernumber,
1471         DATE(aqbasket.closedate)  AS orderdate,
1472         aqorders.rrp              AS unitpricesupplier,
1473         aqorders.ecost            AS unitpricelib,
1474         aqbudgets.budget_name     AS budget,
1475         borrowers.branchcode      AS branch,
1476         aqbooksellers.name        AS supplier,
1477         biblio.author,
1478         biblioitems.publishercode AS publisher,
1479         biblioitems.publicationyear,
1480     ";
1481     my $from = "
1482     FROM (((
1483         (aqorders LEFT JOIN biblio     ON biblio.biblionumber         = aqorders.biblionumber)
1484         LEFT JOIN biblioitems          ON biblioitems.biblionumber    = biblio.biblionumber)
1485         LEFT JOIN aqbudgets            ON aqorders.budget_id          = aqbudgets.budget_id),
1486         (aqbasket LEFT JOIN borrowers  ON aqbasket.authorisedby       = borrowers.borrowernumber)
1487         LEFT JOIN aqbooksellers        ON aqbasket.booksellerid       = aqbooksellers.id
1488         WHERE aqorders.basketno = aqbasket.basketno
1489         AND ( (datereceived = '' OR datereceived IS NULL)
1490             OR (aqorders.quantityreceived < aqorders.quantity)
1491         )
1492     ";
1493     my $having = "";
1494     if ($dbdriver eq "mysql") {
1495         $select .= "
1496         aqorders.quantity - IFNULL(aqorders.quantityreceived,0)                 AS quantity,
1497         (aqorders.quantity - IFNULL(aqorders.quantityreceived,0)) * aqorders.rrp AS subtotal,
1498         DATEDIFF(CURDATE( ),closedate) AS latesince
1499         ";
1500         $from .= " AND (closedate <= DATE_SUB(CURDATE( ),INTERVAL ? DAY)) ";
1501         $having = "
1502         HAVING quantity          <> 0
1503             AND unitpricesupplier <> 0
1504             AND unitpricelib      <> 0
1505         ";
1506     } else {
1507         # FIXME: account for IFNULL as above
1508         $select .= "
1509                 aqorders.quantity                AS quantity,
1510                 aqorders.quantity * aqorders.rrp AS subtotal,
1511                 (CURDATE - closedate)            AS latesince
1512         ";
1513         $from .= " AND (closedate <= (CURDATE -(INTERVAL ? DAY)) ";
1514     }
1515     if (defined $supplierid) {
1516         $from .= ' AND aqbasket.booksellerid = ? ';
1517         push @query_params, $supplierid;
1518     }
1519     if (defined $branch) {
1520         $from .= ' AND borrowers.branchcode LIKE ? ';
1521         push @query_params, $branch;
1522     }
1523     if (C4::Context->preference("IndependantBranches")
1524             && C4::Context->userenv
1525             && C4::Context->userenv->{flags} != 1 ) {
1526         $from .= ' AND borrowers.branchcode LIKE ? ';
1527         push @query_params, C4::Context->userenv->{branch};
1528     }
1529     my $query = "$select $from $having\nORDER BY latesince, basketno, borrowers.branchcode, supplier";
1530     $debug and print STDERR "GetLateOrders query: $query\nGetLateOrders args: " . join(" ",@query_params);
1531     my $sth = $dbh->prepare($query);
1532     $sth->execute(@query_params);
1533     my @results;
1534     while (my $data = $sth->fetchrow_hashref) {
1535         $data->{orderdate} = format_date($data->{orderdate});
1536         push @results, $data;
1537     }
1538     return @results;
1539 }
1540
1541 #------------------------------------------------------------#
1542
1543 =head3 GetHistory
1544
1545 =over 4
1546
1547 (\@order_loop, $total_qty, $total_price, $total_qtyreceived) = GetHistory( $title, $author, $name, $from_placed_on, $to_placed_on );
1548
1549 Retreives some acquisition history information
1550
1551 returns:
1552     $order_loop is a list of hashrefs that each look like this:
1553             {
1554                 'author'           => 'Twain, Mark',
1555                 'basketno'         => '1',
1556                 'biblionumber'     => '215',
1557                 'count'            => 1,
1558                 'creationdate'     => 'MM/DD/YYYY',
1559                 'datereceived'     => undef,
1560                 'ecost'            => '1.00',
1561                 'id'               => '1',
1562                 'invoicenumber'    => undef,
1563                 'name'             => '',
1564                 'ordernumber'      => '1',
1565                 'quantity'         => 1,
1566                 'quantityreceived' => undef,
1567                 'title'            => 'The Adventures of Huckleberry Finn'
1568             }
1569     $total_qty is the sum of all of the quantities in $order_loop
1570     $total_price is the cost of each in $order_loop times the quantity
1571     $total_qtyreceived is the sum of all of the quantityreceived entries in $order_loop
1572
1573 =back
1574
1575 =cut
1576
1577 sub GetHistory {
1578     my ( $title, $author, $name, $from_placed_on, $to_placed_on ) = @_;
1579     my @order_loop;
1580     my $total_qty         = 0;
1581     my $total_qtyreceived = 0;
1582     my $total_price       = 0;
1583
1584 # don't run the query if there are no parameters (list would be too long for sure !)
1585     if ( $title || $author || $name || $from_placed_on || $to_placed_on ) {
1586         my $dbh   = C4::Context->dbh;
1587         my $query ="
1588             SELECT
1589                 biblio.title,
1590                 biblio.author,
1591                 aqorders.basketno,
1592                 name,aqbasket.creationdate,
1593                 aqorders.datereceived,
1594                 aqorders.quantity,
1595                 aqorders.quantityreceived,
1596                 aqorders.ecost,
1597                 aqorders.ordernumber,
1598                 aqorders.booksellerinvoicenumber as invoicenumber,
1599                 aqbooksellers.id as id,
1600                 aqorders.biblionumber
1601             FROM aqorders
1602             LEFT JOIN aqbasket ON aqorders.basketno=aqbasket.basketno
1603             LEFT JOIN aqbooksellers ON aqbasket.booksellerid=aqbooksellers.id
1604             LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber";
1605
1606         $query .= " LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber"
1607         if ( C4::Context->preference("IndependantBranches") );
1608
1609         $query .= " WHERE (datecancellationprinted is NULL or datecancellationprinted='0000-00-00') ";
1610
1611         my @query_params  = ();
1612
1613         if ( defined $title ) {
1614             $query .= " AND biblio.title LIKE ? ";
1615             push @query_params, "%$title%";
1616         }
1617
1618         if ( defined $author ) {
1619             $query .= " AND biblio.author LIKE ? ";
1620             push @query_params, "%$author%";
1621         }
1622
1623         if ( defined $name ) {
1624             $query .= " AND name LIKE ? ";
1625             push @query_params, "%$name%";
1626         }
1627
1628         if ( defined $from_placed_on ) {
1629             $query .= " AND creationdate >= ? ";
1630             push @query_params, $from_placed_on;
1631         }
1632
1633         if ( defined $to_placed_on ) {
1634             $query .= " AND creationdate <= ? ";
1635             push @query_params, $to_placed_on;
1636         }
1637
1638         if ( C4::Context->preference("IndependantBranches") ) {
1639             my $userenv = C4::Context->userenv;
1640             if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
1641                 $query .= " AND (borrowers.branchcode = ? OR borrowers.branchcode ='' ) ";
1642                 push @query_params, $userenv->{branch};
1643             }
1644         }
1645         $query .= " ORDER BY booksellerid";
1646         my $sth = $dbh->prepare($query);
1647         $sth->execute( @query_params );
1648         my $cnt = 1;
1649         while ( my $line = $sth->fetchrow_hashref ) {
1650             $line->{count} = $cnt++;
1651             $line->{toggle} = 1 if $cnt % 2;
1652             push @order_loop, $line;
1653             $line->{creationdate} = format_date( $line->{creationdate} );
1654             $line->{datereceived} = format_date( $line->{datereceived} );
1655             $total_qty         += $line->{'quantity'};
1656             $total_qtyreceived += $line->{'quantityreceived'};
1657             $total_price       += $line->{'quantity'} * $line->{'ecost'};
1658         }
1659     }
1660     return \@order_loop, $total_qty, $total_price, $total_qtyreceived;
1661 }
1662
1663 =head2 GetRecentAcqui
1664
1665 $results = GetRecentAcqui($days);
1666
1667 C<$results> is a ref to a table which containts hashref
1668
1669 =cut
1670
1671 sub GetRecentAcqui {
1672     my $limit  = shift;
1673     my $dbh    = C4::Context->dbh;
1674     my $query = "
1675         SELECT *
1676         FROM   biblio
1677         ORDER BY timestamp DESC
1678         LIMIT  0,".$limit;
1679
1680     my $sth = $dbh->prepare($query);
1681     $sth->execute;
1682     my $results = $sth->fetchall_arrayref({});
1683     return $results;
1684 }
1685
1686 =head3 GetContracts
1687
1688 =over 4
1689
1690 $contractlist = &GetContracts($booksellerid, $activeonly);
1691
1692 Looks up the contracts that belong to a bookseller
1693
1694 Returns a list of contracts
1695
1696 =item C<$booksellerid> is the "id" field in the "aqbooksellers" table.
1697
1698 =item C<$activeonly> if exists get only contracts that are still active.
1699
1700 =back
1701
1702 =cut
1703 sub GetContracts {
1704     my ( $booksellerid, $activeonly ) = @_;
1705     my $dbh = C4::Context->dbh;
1706     my $query;
1707     if (! $activeonly) {
1708         $query = "
1709             SELECT *
1710             FROM   aqcontract
1711             WHERE  booksellerid=?
1712         ";
1713     } else {
1714         $query = "SELECT *
1715             FROM aqcontract
1716             WHERE booksellerid=?
1717                 AND contractenddate >= CURDATE( )";
1718     }
1719     my $sth = $dbh->prepare($query);
1720     $sth->execute( $booksellerid );
1721     my @results;
1722     while (my $data = $sth->fetchrow_hashref ) {
1723         push(@results, $data);
1724     }
1725     $sth->finish;
1726     return @results;
1727 }
1728
1729 #------------------------------------------------------------#
1730
1731 =head3 GetContract
1732
1733 =over 4
1734
1735 $contract = &GetContract($contractID);
1736
1737 Looks up the contract that has PRIMKEY (contractnumber) value $contractID
1738
1739 Returns a contract
1740
1741 =back
1742
1743 =cut
1744 sub GetContract {
1745     my ( $contractno ) = @_;
1746     my $dbh = C4::Context->dbh;
1747     my $query = "
1748         SELECT *
1749         FROM   aqcontract
1750         WHERE  contractnumber=?
1751         ";
1752
1753     my $sth = $dbh->prepare($query);
1754     $sth->execute( $contractno );
1755     my $result = $sth->fetchrow_hashref;
1756     return $result;
1757 }
1758
1759 1;
1760 __END__
1761
1762 =head1 AUTHOR
1763
1764 Koha Developement team <info@koha.org>
1765
1766 =cut