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
  17 # with Koha; if not, write to the Free Software Foundation, Inc.,
  18 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  19
  20
  21 use strict;
  22 use warnings;
  23 use Carp;
  24 use C4::Context;
  25 use C4::Debug;
  26 use C4::Dates qw(format_date format_date_in_iso);
  27 use MARC::Record;
  28 use C4::Suggestions;
  29 use C4::Biblio;
  30 use C4::Debug;
  31 use C4::SQLHelper qw(InsertInTable);
  32 use C4::Bookseller qw(GetBookSellerFromId);
  33 use C4::Templates qw(gettemplate);
  34
  35 use Time::localtime;
  36 use HTML::Entities;
  37
  38 use vars qw($VERSION @ISA @EXPORT);
  39
  40 BEGIN {
  41     # set the version for version checking
  42     $VERSION = 3.07.00.049;
  43     require Exporter;
  44     @ISA    = qw(Exporter);
  45     @EXPORT = qw(
  46         &GetBasket &NewBasket &CloseBasket &DelBasket &ModBasket
  47         &GetBasketAsCSV &GetBasketGroupAsCSV
  48         &GetBasketsByBookseller &GetBasketsByBasketgroup
  49         &GetBasketsInfosByBookseller
  50
  51         &ModBasketHeader
  52
  53         &ModBasketgroup &NewBasketgroup &DelBasketgroup &GetBasketgroup &CloseBasketgroup
  54         &GetBasketgroups &ReOpenBasketgroup
  55
  56         &NewOrder &DelOrder &ModOrder &GetPendingOrders &GetOrder &GetOrders
  57         &GetOrderNumber &GetLateOrders &GetOrderFromItemnumber
  58         &SearchOrder &GetHistory &GetRecentAcqui
  59         &ModReceiveOrder &CancelReceipt &ModOrderBiblioitemNumber
  60         &GetCancelledOrders
  61         &GetLastOrderNotReceivedFromSubscriptionid &GetLastOrderReceivedFromSubscriptionid
  62         &NewOrderItem &ModOrderItem &ModItemOrder
  63
  64         &GetParcels &GetParcel
  65         &GetContracts &GetContract
  66
  67         &GetInvoices
  68         &GetInvoice
  69         &GetInvoiceDetails
  70         &AddInvoice
  71         &ModInvoice
  72         &CloseInvoice
  73         &ReopenInvoice
  74
  75         &GetItemnumbersFromOrder
  76
  77         &AddClaim
  78     );
  79 }
  80
  81
  82
  83
  84
  85 sub GetOrderFromItemnumber {
  86     my ($itemnumber) = @_;
  87     my $dbh          = C4::Context->dbh;
  88     my $query        = qq|
  89
  90     SELECT  * from aqorders    LEFT JOIN aqorders_items
  91     ON (     aqorders.ordernumber = aqorders_items.ordernumber   )
  92     WHERE itemnumber = ?  |;
  93
  94     my $sth = $dbh->prepare($query);
  95
  96 #    $sth->trace(3);
  97
  98     $sth->execute($itemnumber);
  99
 100     my $order = $sth->fetchrow_hashref;
 101     return ( $order  );
 102
 103 }
 104
 105 # Returns the itemnumber(s) associated with the ordernumber given in parameter
 106 sub GetItemnumbersFromOrder {
 107     my ($ordernumber) = @_;
 108     my $dbh          = C4::Context->dbh;
 109     my $query        = "SELECT itemnumber FROM aqorders_items WHERE ordernumber=?";
 110     my $sth = $dbh->prepare($query);
 111     $sth->execute($ordernumber);
 112     my @tab;
 113
 114     while (my $order = $sth->fetchrow_hashref) {
 115     push @tab, $order->{'itemnumber'};
 116     }
 117
 118     return @tab;
 119
 120 }
 121
 122
 123
 124
 125
 126
 127 =head1 NAME
 128
 129 C4::Acquisition - Koha functions for dealing with orders and acquisitions
 130
 131 =head1 SYNOPSIS
 132
 133 use C4::Acquisition;
 134
 135 =head1 DESCRIPTION
 136
 137 The functions in this module deal with acquisitions, managing book
 138 orders, basket and parcels.
 139
 140 =head1 FUNCTIONS
 141
 142 =head2 FUNCTIONS ABOUT BASKETS
 143
 144 =head3 GetBasket
 145
 146   $aqbasket = &GetBasket($basketnumber);
 147
 148 get all basket informations in aqbasket for a given basket
 149
 150 B<returns:> informations for a given basket returned as a hashref.
 151
 152 =cut
 153
 154 sub GetBasket {
 155     my ($basketno) = @_;
 156     my $dbh        = C4::Context->dbh;
 157     my $query = "
 158         SELECT  aqbasket.*,
 159                 concat( b.firstname,' ',b.surname) AS authorisedbyname,
 160                 b.branchcode AS branch
 161         FROM    aqbasket
 162         LEFT JOIN borrowers b ON aqbasket.authorisedby=b.borrowernumber
 163         WHERE basketno=?
 164     ";
 165     my $sth=$dbh->prepare($query);
 166     $sth->execute($basketno);
 167     my $basket = $sth->fetchrow_hashref;
 168     return ( $basket );
 169 }
 170
 171 #------------------------------------------------------------#
 172
 173 =head3 NewBasket
 174
 175   $basket = &NewBasket( $booksellerid, $authorizedby, $basketname,
 176       $basketnote, $basketbooksellernote, $basketcontractnumber, $deliveryplace, $billingplace );
 177
 178 Create a new basket in aqbasket table
 179
 180 =over
 181
 182 =item C<$booksellerid> is a foreign key in the aqbasket table
 183
 184 =item C<$authorizedby> is the username of who created the basket
 185
 186 =back
 187
 188 The other parameters are optional, see ModBasketHeader for more info on them.
 189
 190 =cut
 191
 192 sub NewBasket {
 193     my ( $booksellerid, $authorisedby, $basketname, $basketnote,
 194         $basketbooksellernote, $basketcontractnumber, $deliveryplace,
 195         $billingplace ) = @_;
 196     my $dbh = C4::Context->dbh;
 197     my $query =
 198         'INSERT INTO aqbasket (creationdate,booksellerid,authorisedby) '
 199       . 'VALUES  (now(),?,?)';
 200     $dbh->do( $query, {}, $booksellerid, $authorisedby );
 201
 202     my $basket = $dbh->{mysql_insertid};
 203     $basketname           ||= q{}; # default to empty strings
 204     $basketnote           ||= q{};
 205     $basketbooksellernote ||= q{};
 206     ModBasketHeader( $basket, $basketname, $basketnote, $basketbooksellernote,
 207         $basketcontractnumber, $booksellerid, $deliveryplace, $billingplace );
 208     return $basket;
 209 }
 210
 211 #------------------------------------------------------------#
 212
 213 =head3 CloseBasket
 214
 215   &CloseBasket($basketno);
 216
 217 close a basket (becomes unmodifiable,except for recieves)
 218
 219 =cut
 220
 221 sub CloseBasket {
 222     my ($basketno) = @_;
 223     my $dbh        = C4::Context->dbh;
 224     my $query = "
 225         UPDATE aqbasket
 226         SET    closedate=now()
 227         WHERE  basketno=?
 228     ";
 229     my $sth = $dbh->prepare($query);
 230     $sth->execute($basketno);
 231 }
 232
 233 #------------------------------------------------------------#
 234
 235 =head3 GetBasketAsCSV
 236
 237   &GetBasketAsCSV($basketno);
 238
 239 Export a basket as CSV
 240
 241 $cgi parameter is needed for column name translation
 242
 243 =cut
 244
 245 sub GetBasketAsCSV {
 246     my ($basketno, $cgi) = @_;
 247     my $basket = GetBasket($basketno);
 248     my @orders = GetOrders($basketno);
 249     my $contract = GetContract($basket->{'contractnumber'});
 250
 251     my $template = C4::Templates::gettemplate("acqui/csv/basket.tmpl", "intranet", $cgi);
 252
 253     my @rows;
 254     foreach my $order (@orders) {
 255         my $bd = GetBiblioData( $order->{'biblionumber'} );
 256         my $row = {
 257             contractname => $contract->{'contractname'},
 258             ordernumber => $order->{'ordernumber'},
 259             entrydate => $order->{'entrydate'},
 260             isbn => $order->{'isbn'},
 261             author => $bd->{'author'},
 262             title => $bd->{'title'},
 263             publicationyear => $bd->{'publicationyear'},
 264             publishercode => $bd->{'publishercode'},
 265             collectiontitle => $bd->{'collectiontitle'},
 266             notes => $order->{'notes'},
 267             quantity => $order->{'quantity'},
 268             rrp => $order->{'rrp'},
 269             deliveryplace => C4::Branch::GetBranchName( $basket->{'deliveryplace'} ),
 270             billingplace => C4::Branch::GetBranchName( $basket->{'billingplace'} ),
 271         };
 272         foreach(qw(
 273             contractname author title publishercode collectiontitle notes
 274             deliveryplace billingplace
 275         ) ) {
 276             # Double the quotes to not be interpreted as a field end
 277             $row->{$_} =~ s/"/""/g if $row->{$_};
 278         }
 279         push @rows, $row;
 280     }
 281
 282     @rows = sort {
 283         if(defined $a->{publishercode} and defined $b->{publishercode}) {
 284             $a->{publishercode} cmp $b->{publishercode};
 285         }
 286     } @rows;
 287
 288     $template->param(rows => \@rows);
 289
 290     return $template->output;
 291 }
 292
 293
 294 =head3 GetBasketGroupAsCSV
 295
 296 =over 4
 297
 298 &GetBasketGroupAsCSV($basketgroupid);
 299
 300 Export a basket group as CSV
 301
 302 $cgi parameter is needed for column name translation
 303
 304 =back
 305
 306 =cut
 307
 308 sub GetBasketGroupAsCSV {
 309     my ($basketgroupid, $cgi) = @_;
 310     my $baskets = GetBasketsByBasketgroup($basketgroupid);
 311
 312     my $template = C4::Templates::gettemplate('acqui/csv/basketgroup.tmpl', 'intranet', $cgi);
 313
 314     my @rows;
 315     for my $basket (@$baskets) {
 316         my @orders     = GetOrders( $$basket{basketno} );
 317         my $contract   = GetContract( $$basket{contractnumber} );
 318         my $bookseller = GetBookSellerFromId( $$basket{booksellerid} );
 319         my $basketgroup = GetBasketgroup( $$basket{basketgroupid} );
 320
 321         foreach my $order (@orders) {
 322             my $bd = GetBiblioData( $order->{'biblionumber'} );
 323             my $row = {
 324                 clientnumber => $bookseller->{accountnumber},
 325                 basketname => $basket->{basketname},
 326                 ordernumber => $order->{ordernumber},
 327                 author => $bd->{author},
 328                 title => $bd->{title},
 329                 publishercode => $bd->{publishercode},
 330                 publicationyear => $bd->{publicationyear},
 331                 collectiontitle => $bd->{collectiontitle},
 332                 isbn => $order->{isbn},
 333                 quantity => $order->{quantity},
 334                 rrp => $order->{rrp},
 335                 discount => $bookseller->{discount},
 336                 ecost => $order->{ecost},
 337                 notes => $order->{notes},
 338                 entrydate => $order->{entrydate},
 339                 booksellername => $bookseller->{name},
 340                 bookselleraddress => $bookseller->{address1},
 341                 booksellerpostal => $bookseller->{postal},
 342                 contractnumber => $contract->{contractnumber},
 343                 contractname => $contract->{contractname},
 344                 basketgroupdeliveryplace => C4::Branch::GetBranchName( $basketgroup->{deliveryplace} ),
 345                 basketgroupbillingplace => C4::Branch::GetBranchName( $basketgroup->{billingplace} ),
 346                 basketdeliveryplace => C4::Branch::GetBranchName( $basket->{deliveryplace} ),
 347                 basketbillingplace => C4::Branch::GetBranchName( $basket->{billingplace} ),
 348             };
 349             foreach(qw(
 350                 basketname author title publishercode collectiontitle notes
 351                 booksellername bookselleraddress booksellerpostal contractname
 352                 basketgroupdeliveryplace basketgroupbillingplace
 353                 basketdeliveryplace basketbillingplace
 354             ) ) {
 355                 # Double the quotes to not be interpreted as a field end
 356                 $row->{$_} =~ s/"/""/g if $row->{$_};
 357             }
 358             push @rows, $row;
 359          }
 360      }
 361     $template->param(rows => \@rows);
 362
 363     return $template->output;
 364
 365 }
 366
 367 =head3 CloseBasketgroup
 368
 369   &CloseBasketgroup($basketgroupno);
 370
 371 close a basketgroup
 372
 373 =cut
 374
 375 sub CloseBasketgroup {
 376     my ($basketgroupno) = @_;
 377     my $dbh        = C4::Context->dbh;
 378     my $sth = $dbh->prepare("
 379         UPDATE aqbasketgroups
 380         SET    closed=1
 381         WHERE  id=?
 382     ");
 383     $sth->execute($basketgroupno);
 384 }
 385
 386 #------------------------------------------------------------#
 387
 388 =head3 ReOpenBaskergroup($basketgroupno)
 389
 390   &ReOpenBaskergroup($basketgroupno);
 391
 392 reopen a basketgroup
 393
 394 =cut
 395
 396 sub ReOpenBasketgroup {
 397     my ($basketgroupno) = @_;
 398     my $dbh        = C4::Context->dbh;
 399     my $sth = $dbh->prepare("
 400         UPDATE aqbasketgroups
 401         SET    closed=0
 402         WHERE  id=?
 403     ");
 404     $sth->execute($basketgroupno);
 405 }
 406
 407 #------------------------------------------------------------#
 408
 409
 410 =head3 DelBasket
 411
 412   &DelBasket($basketno);
 413
 414 Deletes the basket that has basketno field $basketno in the aqbasket table.
 415
 416 =over
 417
 418 =item C<$basketno> is the primary key of the basket in the aqbasket table.
 419
 420 =back
 421
 422 =cut
 423
 424 sub DelBasket {
 425     my ( $basketno ) = @_;
 426     my $query = "DELETE FROM aqbasket WHERE basketno=?";
 427     my $dbh = C4::Context->dbh;
 428     my $sth = $dbh->prepare($query);
 429     $sth->execute($basketno);
 430     $sth->finish;
 431 }
 432
 433 #------------------------------------------------------------#
 434
 435 =head3 ModBasket
 436
 437   &ModBasket($basketinfo);
 438
 439 Modifies a basket, using a hashref $basketinfo for the relevant information, only $basketinfo->{'basketno'} is required.
 440
 441 =over
 442
 443 =item C<$basketno> is the primary key of the basket in the aqbasket table.
 444
 445 =back
 446
 447 =cut
 448
 449 sub ModBasket {
 450     my $basketinfo = shift;
 451     my $query = "UPDATE aqbasket SET ";
 452     my @params;
 453     foreach my $key (keys %$basketinfo){
 454         if ($key ne 'basketno'){
 455             $query .= "$key=?, ";
 456             push(@params, $basketinfo->{$key} || undef );
 457         }
 458     }
 459 # get rid of the "," at the end of $query
 460     if (substr($query, length($query)-2) eq ', '){
 461         chop($query);
 462         chop($query);
 463         $query .= ' ';
 464     }
 465     $query .= "WHERE basketno=?";
 466     push(@params, $basketinfo->{'basketno'});
 467     my $dbh = C4::Context->dbh;
 468     my $sth = $dbh->prepare($query);
 469     $sth->execute(@params);
 470     $sth->finish;
 471 }
 472
 473 #------------------------------------------------------------#
 474
 475 =head3 ModBasketHeader
 476
 477   &ModBasketHeader($basketno, $basketname, $note, $booksellernote, $contractnumber, $booksellerid);
 478
 479 Modifies a basket's header.
 480
 481 =over
 482
 483 =item C<$basketno> is the "basketno" field in the "aqbasket" table;
 484
 485 =item C<$basketname> is the "basketname" field in the "aqbasket" table;
 486
 487 =item C<$note> is the "note" field in the "aqbasket" table;
 488
 489 =item C<$booksellernote> is the "booksellernote" field in the "aqbasket" table;
 490
 491 =item C<$contractnumber> is the "contractnumber" (foreign) key in the "aqbasket" table.
 492
 493 =item C<$booksellerid> is the id (foreign) key in the "aqbooksellers" table for the vendor.
 494
 495 =item C<$deliveryplace> is the "deliveryplace" field in the aqbasket table.
 496
 497 =item C<$billingplace> is the "billingplace" field in the aqbasket table.
 498
 499 =back
 500
 501 =cut
 502
 503 sub ModBasketHeader {
 504     my ($basketno, $basketname, $note, $booksellernote, $contractnumber, $booksellerid, $deliveryplace, $billingplace) = @_;
 505     my $query = qq{
 506         UPDATE aqbasket
 507         SET basketname=?, note=?, booksellernote=?, booksellerid=?, deliveryplace=?, billingplace=?
 508         WHERE basketno=?
 509     };
 510
 511     my $dbh = C4::Context->dbh;
 512     my $sth = $dbh->prepare($query);
 513     $sth->execute($basketname, $note, $booksellernote, $booksellerid, $deliveryplace, $billingplace, $basketno);
 514
 515     if ( $contractnumber ) {
 516         my $query2 ="UPDATE aqbasket SET contractnumber=? WHERE basketno=?";
 517         my $sth2 = $dbh->prepare($query2);
 518         $sth2->execute($contractnumber,$basketno);
 519         $sth2->finish;
 520     }
 521     $sth->finish;
 522 }
 523
 524 #------------------------------------------------------------#
 525
 526 =head3 GetBasketsByBookseller
 527
 528   @results = &GetBasketsByBookseller($booksellerid, $extra);
 529
 530 Returns a list of hashes of all the baskets that belong to bookseller 'booksellerid'.
 531
 532 =over
 533
 534 =item C<$booksellerid> is the 'id' field of the bookseller in the aqbooksellers table
 535
 536 =item C<$extra> is the extra sql parameters, can be
 537
 538  $extra->{groupby}: group baskets by column
 539     ex. $extra->{groupby} = aqbasket.basketgroupid
 540  $extra->{orderby}: order baskets by column
 541  $extra->{limit}: limit number of results (can be helpful for pagination)
 542
 543 =back
 544
 545 =cut
 546
 547 sub GetBasketsByBookseller {
 548     my ($booksellerid, $extra) = @_;
 549     my $query = "SELECT * FROM aqbasket WHERE booksellerid=?";
 550     if ($extra){
 551         if ($extra->{groupby}) {
 552             $query .= " GROUP by $extra->{groupby}";
 553         }
 554         if ($extra->{orderby}){
 555             $query .= " ORDER by $extra->{orderby}";
 556         }
 557         if ($extra->{limit}){
 558             $query .= " LIMIT $extra->{limit}";
 559         }
 560     }
 561     my $dbh = C4::Context->dbh;
 562     my $sth = $dbh->prepare($query);
 563     $sth->execute($booksellerid);
 564     my $results = $sth->fetchall_arrayref({});
 565     $sth->finish;
 566     return $results
 567 }
 568
 569 =head3 GetBasketsInfosByBookseller
 570
 571     my $baskets = GetBasketsInfosByBookseller($supplierid);
 572
 573 Returns in a arrayref of hashref all about booksellers baskets, plus:
 574     total_biblios: Number of distinct biblios in basket
 575     total_items: Number of items in basket
 576     expected_items: Number of non-received items in basket
 577
 578 =cut
 579
 580 sub GetBasketsInfosByBookseller {
 581     my ($supplierid) = @_;
 582
 583     return unless $supplierid;
 584
 585     my $dbh = C4::Context->dbh;
 586     my $query = qq{
 587         SELECT aqbasket.*,
 588           SUM(aqorders.quantity) AS total_items,
 589           COUNT(DISTINCT aqorders.biblionumber) AS total_biblios,
 590           SUM(
 591             IF(aqorders.datereceived IS NULL
 592               AND aqorders.datecancellationprinted IS NULL
 593             , aqorders.quantity
 594             , 0)
 595           ) AS expected_items
 596         FROM aqbasket
 597           LEFT JOIN aqorders ON aqorders.basketno = aqbasket.basketno
 598         WHERE booksellerid = ?
 599         GROUP BY aqbasket.basketno
 600     };
 601     my $sth = $dbh->prepare($query);
 602     $sth->execute($supplierid);
 603     return $sth->fetchall_arrayref({});
 604 }
 605
 606
 607 #------------------------------------------------------------#
 608
 609 =head3 GetBasketsByBasketgroup
 610
 611   $baskets = &GetBasketsByBasketgroup($basketgroupid);
 612
 613 Returns a reference to all baskets that belong to basketgroup $basketgroupid.
 614
 615 =cut
 616
 617 sub GetBasketsByBasketgroup {
 618     my $basketgroupid = shift;
 619     my $query = qq{
 620         SELECT *, aqbasket.booksellerid as booksellerid
 621         FROM aqbasket
 622         LEFT JOIN aqcontract USING(contractnumber) WHERE basketgroupid=?
 623     };
 624     my $dbh = C4::Context->dbh;
 625     my $sth = $dbh->prepare($query);
 626     $sth->execute($basketgroupid);
 627     my $results = $sth->fetchall_arrayref({});
 628     $sth->finish;
 629     return $results
 630 }
 631
 632 #------------------------------------------------------------#
 633
 634 =head3 NewBasketgroup
 635
 636   $basketgroupid = NewBasketgroup(\%hashref);
 637
 638 Adds a basketgroup to the aqbasketgroups table, and add the initial baskets to it.
 639
 640 $hashref->{'booksellerid'} is the 'id' field of the bookseller in the aqbooksellers table,
 641
 642 $hashref->{'name'} is the 'name' field of the basketgroup in the aqbasketgroups table,
 643
 644 $hashref->{'basketlist'} is a list reference of the 'id's of the baskets that belong to this group,
 645
 646 $hashref->{'deliveryplace'} is the 'deliveryplace' field of the basketgroup in the aqbasketgroups table,
 647
 648 $hashref->{'deliverycomment'} is the 'deliverycomment' field of the basketgroup in the aqbasketgroups table,
 649
 650 $hashref->{'closed'} is the 'closed' field of the aqbasketgroups table, it is false if 0, true otherwise.
 651
 652 =cut
 653
 654 sub NewBasketgroup {
 655     my $basketgroupinfo = shift;
 656     die "booksellerid is required to create a basketgroup" unless $basketgroupinfo->{'booksellerid'};
 657     my $query = "INSERT INTO aqbasketgroups (";
 658     my @params;
 659     foreach my $field ('name', 'deliveryplace', 'deliverycomment', 'closed') {
 660         if ( $basketgroupinfo->{$field} ) {
 661             $query .= "$field, ";
 662             push(@params, $basketgroupinfo->{$field});
 663         }
 664     }
 665     $query .= "booksellerid) VALUES (";
 666     foreach (@params) {
 667         $query .= "?, ";
 668     }
 669     $query .= "?)";
 670     push(@params, $basketgroupinfo->{'booksellerid'});
 671     my $dbh = C4::Context->dbh;
 672     my $sth = $dbh->prepare($query);
 673     $sth->execute(@params);
 674     my $basketgroupid = $dbh->{'mysql_insertid'};
 675     if( $basketgroupinfo->{'basketlist'} ) {
 676         foreach my $basketno (@{$basketgroupinfo->{'basketlist'}}) {
 677             my $query2 = "UPDATE aqbasket SET basketgroupid=? WHERE basketno=?";
 678             my $sth2 = $dbh->prepare($query2);
 679             $sth2->execute($basketgroupid, $basketno);
 680         }
 681     }
 682     return $basketgroupid;
 683 }
 684
 685 #------------------------------------------------------------#
 686
 687 =head3 ModBasketgroup
 688
 689   ModBasketgroup(\%hashref);
 690
 691 Modifies a basketgroup in the aqbasketgroups table, and add the baskets to it.
 692
 693 $hashref->{'id'} is the 'id' field of the basketgroup in the aqbasketgroup table, this parameter is mandatory,
 694
 695 $hashref->{'name'} is the 'name' field of the basketgroup in the aqbasketgroups table,
 696
 697 $hashref->{'basketlist'} is a list reference of the 'id's of the baskets that belong to this group,
 698
 699 $hashref->{'billingplace'} is the 'billingplace' field of the basketgroup in the aqbasketgroups table,
 700
 701 $hashref->{'deliveryplace'} is the 'deliveryplace' field of the basketgroup in the aqbasketgroups table,
 702
 703 $hashref->{'deliverycomment'} is the 'deliverycomment' field of the basketgroup in the aqbasketgroups table,
 704
 705 $hashref->{'closed'} is the 'closed' field of the aqbasketgroups table, it is false if 0, true otherwise.
 706
 707 =cut
 708
 709 sub ModBasketgroup {
 710     my $basketgroupinfo = shift;
 711     die "basketgroup id is required to edit a basketgroup" unless $basketgroupinfo->{'id'};
 712     my $dbh = C4::Context->dbh;
 713     my $query = "UPDATE aqbasketgroups SET ";
 714     my @params;
 715     foreach my $field (qw(name billingplace deliveryplace freedeliveryplace deliverycomment closed)) {
 716         if ( defined $basketgroupinfo->{$field} ) {
 717             $query .= "$field=?, ";
 718             push(@params, $basketgroupinfo->{$field});
 719         }
 720     }
 721     chop($query);
 722     chop($query);
 723     $query .= " WHERE id=?";
 724     push(@params, $basketgroupinfo->{'id'});
 725     my $sth = $dbh->prepare($query);
 726     $sth->execute(@params);
 727
 728     $sth = $dbh->prepare('UPDATE aqbasket SET basketgroupid = NULL WHERE basketgroupid = ?');
 729     $sth->execute($basketgroupinfo->{'id'});
 730
 731     if($basketgroupinfo->{'basketlist'} && @{$basketgroupinfo->{'basketlist'}}){
 732         $sth = $dbh->prepare("UPDATE aqbasket SET basketgroupid=? WHERE basketno=?");
 733         foreach my $basketno (@{$basketgroupinfo->{'basketlist'}}) {
 734             $sth->execute($basketgroupinfo->{'id'}, $basketno);
 735             $sth->finish;
 736         }
 737     }
 738     $sth->finish;
 739 }
 740
 741 #------------------------------------------------------------#
 742
 743 =head3 DelBasketgroup
 744
 745   DelBasketgroup($basketgroupid);
 746
 747 Deletes a basketgroup in the aqbasketgroups table, and removes the reference to it from the baskets,
 748
 749 =over
 750
 751 =item C<$basketgroupid> is the 'id' field of the basket in the aqbasketgroup table
 752
 753 =back
 754
 755 =cut
 756
 757 sub DelBasketgroup {
 758     my $basketgroupid = shift;
 759     die "basketgroup id is required to edit a basketgroup" unless $basketgroupid;
 760     my $query = "DELETE FROM aqbasketgroups WHERE id=?";
 761     my $dbh = C4::Context->dbh;
 762     my $sth = $dbh->prepare($query);
 763     $sth->execute($basketgroupid);
 764     $sth->finish;
 765 }
 766
 767 #------------------------------------------------------------#
 768
 769
 770 =head2 FUNCTIONS ABOUT ORDERS
 771
 772 =head3 GetBasketgroup
 773
 774   $basketgroup = &GetBasketgroup($basketgroupid);
 775
 776 Returns a reference to the hash containing all infermation about the basketgroup.
 777
 778 =cut
 779
 780 sub GetBasketgroup {
 781     my $basketgroupid = shift;
 782     die "basketgroup id is required to edit a basketgroup" unless $basketgroupid;
 783     my $query = "SELECT * FROM aqbasketgroups WHERE id=?";
 784     my $dbh = C4::Context->dbh;
 785     my $sth = $dbh->prepare($query);
 786     $sth->execute($basketgroupid);
 787     my $result = $sth->fetchrow_hashref;
 788     $sth->finish;
 789     return $result
 790 }
 791
 792 #------------------------------------------------------------#
 793
 794 =head3 GetBasketgroups
 795
 796   $basketgroups = &GetBasketgroups($booksellerid);
 797
 798 Returns a reference to the array of all the basketgroups of bookseller $booksellerid.
 799
 800 =cut
 801
 802 sub GetBasketgroups {
 803     my $booksellerid = shift;
 804     die 'bookseller id is required to edit a basketgroup' unless $booksellerid;
 805     my $query = 'SELECT * FROM aqbasketgroups WHERE booksellerid=? ORDER BY id DESC';
 806     my $dbh = C4::Context->dbh;
 807     my $sth = $dbh->prepare($query);
 808     $sth->execute($booksellerid);
 809     return $sth->fetchall_arrayref({});
 810 }
 811
 812 #------------------------------------------------------------#
 813
 814 =head2 FUNCTIONS ABOUT ORDERS
 815
 816 =cut
 817
 818 #------------------------------------------------------------#
 819
 820 =head3 GetPendingOrders
 821
 822 $orders = &GetPendingOrders($supplierid,$grouped,$owner,$basketno,$ordernumber,$search,$ean);
 823
 824 Finds pending orders from the bookseller with the given ID. Ignores
 825 completed and cancelled orders.
 826
 827 C<$booksellerid> contains the bookseller identifier
 828 C<$owner> contains 0 or 1. 0 means any owner. 1 means only the list of orders entered by the user itself.
 829 C<$grouped> is a boolean that, if set to 1 will group all order lines of the same basket
 830 in a single result line
 831 C<$orders> is a reference-to-array; each element is a reference-to-hash.
 832
 833 Used also by the filter in parcel.pl
 834 I have added:
 835
 836 C<$ordernumber>
 837 C<$search>
 838 C<$ean>
 839
 840 These give the value of the corresponding field in the aqorders table
 841 of the Koha database.
 842
 843 Results are ordered from most to least recent.
 844
 845 =cut
 846
 847 sub GetPendingOrders {
 848     my ($supplierid,$grouped,$owner,$basketno,$ordernumber,$search,$ean) = @_;
 849     my $dbh = C4::Context->dbh;
 850     my $strsth = "
 851         SELECT ".($grouped?"count(*),":"")."aqbasket.basketno,
 852                surname,firstname,biblio.*,biblioitems.isbn,
 853                aqbasket.closedate, aqbasket.creationdate, aqbasket.basketname,
 854                aqorders.*
 855         FROM aqorders
 856         LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
 857         LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
 858         LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber
 859         LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
 860         WHERE (quantity > quantityreceived OR quantityreceived is NULL)
 861         AND datecancellationprinted IS NULL";
 862     my @query_params;
 863     my $userenv = C4::Context->userenv;
 864     if ( C4::Context->preference("IndependantBranches") ) {
 865         if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
 866             $strsth .= " AND (borrowers.branchcode = ?
 867                         or borrowers.branchcode  = '')";
 868             push @query_params, $userenv->{branch};
 869         }
 870     }
 871     if ($supplierid) {
 872         $strsth .= " AND aqbasket.booksellerid = ?";
 873         push @query_params, $supplierid;
 874     }
 875     if($ordernumber){
 876         $strsth .= " AND (aqorders.ordernumber=?)";
 877         push @query_params, $ordernumber;
 878     }
 879     if($search){
 880         $strsth .= " AND (biblio.title like ? OR biblio.author LIKE ? OR biblioitems.isbn like ?)";
 881         push @query_params, ("%$search%","%$search%","%$search%");
 882     }
 883     if ($ean) {
 884         $strsth .= " AND biblioitems.ean = ?";
 885         push @query_params, $ean;
 886     }
 887     if ($basketno) {
 888         $strsth .= " AND aqbasket.basketno=? ";
 889         push @query_params, $basketno;
 890     }
 891     if ($owner) {
 892         $strsth .= " AND aqbasket.authorisedby=? ";
 893         push @query_params, $userenv->{'number'};
 894     }
 895     $strsth .= " group by aqbasket.basketno" if $grouped;
 896     $strsth .= " order by aqbasket.basketno";
 897     my $sth = $dbh->prepare($strsth);
 898     $sth->execute( @query_params );
 899     my $results = $sth->fetchall_arrayref({});
 900     $sth->finish;
 901     return $results;
 902 }
 903
 904 #------------------------------------------------------------#
 905
 906 =head3 GetOrders
 907
 908   @orders = &GetOrders($basketnumber, $orderby);
 909
 910 Looks up the pending (non-cancelled) orders with the given basket
 911 number. If C<$booksellerID> is non-empty, only orders from that seller
 912 are returned.
 913
 914 return :
 915 C<&basket> returns a two-element array. C<@orders> is an array of
 916 references-to-hash, whose keys are the fields from the aqorders,
 917 biblio, and biblioitems tables in the Koha database.
 918
 919 =cut
 920
 921 sub GetOrders {
 922     my ( $basketno, $orderby ) = @_;
 923     my $dbh   = C4::Context->dbh;
 924     my $query  ="
 925         SELECT biblio.*,biblioitems.*,
 926                 aqorders.*,
 927                 aqbudgets.*,
 928                 biblio.title
 929         FROM    aqorders
 930             LEFT JOIN aqbudgets        ON aqbudgets.budget_id = aqorders.budget_id
 931             LEFT JOIN biblio           ON biblio.biblionumber = aqorders.biblionumber
 932             LEFT JOIN biblioitems      ON biblioitems.biblionumber =biblio.biblionumber
 933         WHERE   basketno=?
 934             AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00')
 935     ";
 936
 937     $orderby = "biblioitems.publishercode,biblio.title" unless $orderby;
 938     $query .= " ORDER BY $orderby";
 939     my $sth = $dbh->prepare($query);
 940     $sth->execute($basketno);
 941     my $results = $sth->fetchall_arrayref({});
 942     $sth->finish;
 943     return @$results;
 944 }
 945
 946 #------------------------------------------------------------#
 947
 948 =head3 GetOrderNumber
 949
 950   $ordernumber = &GetOrderNumber($biblioitemnumber, $biblionumber);
 951
 952 Looks up the ordernumber with the given biblionumber and biblioitemnumber.
 953
 954 Returns the number of this order.
 955
 956 =over
 957
 958 =item C<$ordernumber> is the order number.
 959
 960 =back
 961
 962 =cut
 963
 964 sub GetOrderNumber {
 965     my ( $biblionumber,$biblioitemnumber ) = @_;
 966     my $dbh = C4::Context->dbh;
 967     my $query = "
 968         SELECT ordernumber
 969         FROM   aqorders
 970         WHERE  biblionumber=?
 971         AND    biblioitemnumber=?
 972     ";
 973     my $sth = $dbh->prepare($query);
 974     $sth->execute( $biblionumber, $biblioitemnumber );
 975
 976     return $sth->fetchrow;
 977 }
 978
 979 #------------------------------------------------------------#
 980
 981 =head3 GetOrder
 982
 983   $order = &GetOrder($ordernumber);
 984
 985 Looks up an order by order number.
 986
 987 Returns a reference-to-hash describing the order. The keys of
 988 C<$order> are fields from the biblio, biblioitems, aqorders tables of the Koha database.
 989
 990 =cut
 991
 992 sub GetOrder {
 993     my ($ordernumber) = @_;
 994     my $dbh      = C4::Context->dbh;
 995     my $query = "
 996         SELECT biblioitems.*, biblio.*, aqorders.*
 997         FROM   aqorders
 998         LEFT JOIN biblio on           biblio.biblionumber=aqorders.biblionumber
 999         LEFT JOIN biblioitems on       biblioitems.biblionumber=aqorders.biblionumber
1000         WHERE aqorders.ordernumber=?
1001
1002     ";
1003     my $sth= $dbh->prepare($query);
1004     $sth->execute($ordernumber);
1005     my $data = $sth->fetchrow_hashref;
1006     $sth->finish;
1007     return $data;
1008 }
1009
1010 =head3 GetLastOrderNotReceivedFromSubscriptionid
1011
1012   $order = &GetLastOrderNotReceivedFromSubscriptionid($subscriptionid);
1013
1014 Returns a reference-to-hash describing the last order not received for a subscription.
1015
1016 =cut
1017
1018 sub GetLastOrderNotReceivedFromSubscriptionid {
1019     my ( $subscriptionid ) = @_;
1020     my $dbh                = C4::Context->dbh;
1021     my $query              = qq|
1022         SELECT * FROM aqorders
1023         LEFT JOIN subscription
1024             ON ( aqorders.subscriptionid = subscription.subscriptionid )
1025         WHERE aqorders.subscriptionid = ?
1026             AND aqorders.datereceived IS NULL
1027         LIMIT 1
1028     |;
1029     my $sth = $dbh->prepare( $query );
1030     $sth->execute( $subscriptionid );
1031     my $order = $sth->fetchrow_hashref;
1032     return $order;
1033 }
1034
1035 =head3 GetLastOrderReceivedFromSubscriptionid
1036
1037   $order = &GetLastOrderReceivedFromSubscriptionid($subscriptionid);
1038
1039 Returns a reference-to-hash describing the last order received for a subscription.
1040
1041 =cut
1042
1043 sub GetLastOrderReceivedFromSubscriptionid {
1044     my ( $subscriptionid ) = @_;
1045     my $dbh                = C4::Context->dbh;
1046     my $query              = qq|
1047         SELECT * FROM aqorders
1048         LEFT JOIN subscription
1049             ON ( aqorders.subscriptionid = subscription.subscriptionid )
1050         WHERE aqorders.subscriptionid = ?
1051             AND aqorders.datereceived =
1052                 (
1053                     SELECT MAX( aqorders.datereceived )
1054                     FROM aqorders
1055                     LEFT JOIN subscription
1056                         ON ( aqorders.subscriptionid = subscription.subscriptionid )
1057                         WHERE aqorders.subscriptionid = ?
1058                             AND aqorders.datereceived IS NOT NULL
1059                 )
1060         ORDER BY ordernumber DESC
1061         LIMIT 1
1062     |;
1063     my $sth = $dbh->prepare( $query );
1064     $sth->execute( $subscriptionid, $subscriptionid );
1065     my $order = $sth->fetchrow_hashref;
1066     return $order;
1067
1068 }
1069
1070
1071 #------------------------------------------------------------#
1072
1073 =head3 NewOrder
1074
1075   &NewOrder(\%hashref);
1076
1077 Adds a new order to the database. Any argument that isn't described
1078 below is the new value of the field with the same name in the aqorders
1079 table of the Koha database.
1080
1081 =over
1082
1083 =item $hashref->{'basketno'} is the basketno foreign key in aqorders, it is mandatory
1084
1085 =item $hashref->{'ordernumber'} is a "minimum order number."
1086
1087 =item $hashref->{'budgetdate'} is effectively ignored.
1088 If it's undef (anything false) or the string 'now', the current day is used.
1089 Else, the upcoming July 1st is used.
1090
1091 =item $hashref->{'subscription'} may be either "yes", or anything else for "no".
1092
1093 =item $hashref->{'uncertainprice'} may be 0 for "the price is known" or 1 for "the price is uncertain"
1094
1095 =item defaults entrydate to Now
1096
1097 The following keys are used: "biblionumber", "title", "basketno", "quantity", "notes", "biblioitemnumber", "rrp", "ecost", "gstrate", "unitprice", "subscription", "sort1", "sort2", "booksellerinvoicenumber", "listprice", "budgetdate", "purchaseordernumber", "branchcode", "booksellerinvoicenumber", "budget_id".
1098
1099 =back
1100
1101 =cut
1102
1103 sub NewOrder {
1104     my $orderinfo = shift;
1105 #### ------------------------------
1106     my $dbh = C4::Context->dbh;
1107     my @params;
1108
1109
1110     # if these parameters are missing, we can't continue
1111     for my $key (qw/basketno quantity biblionumber budget_id/) {
1112         croak "Mandatory parameter $key missing" unless $orderinfo->{$key};
1113     }
1114
1115     if ( defined $orderinfo->{subscription} && $orderinfo->{'subscription'} eq 'yes' ) {
1116         $orderinfo->{'subscription'} = 1;
1117     } else {
1118         $orderinfo->{'subscription'} = 0;
1119     }
1120     $orderinfo->{'entrydate'} ||= C4::Dates->new()->output("iso");
1121     if (!$orderinfo->{quantityreceived}) {
1122         $orderinfo->{quantityreceived} = 0;
1123     }
1124
1125     my $ordernumber=InsertInTable("aqorders",$orderinfo);
1126     if (not $orderinfo->{parent_ordernumber}) {
1127         my $sth = $dbh->prepare("
1128             UPDATE aqorders
1129             SET parent_ordernumber = ordernumber
1130             WHERE ordernumber = ?
1131         ");
1132         $sth->execute($ordernumber);
1133     }
1134     return ( $orderinfo->{'basketno'}, $ordernumber );
1135 }
1136
1137
1138
1139 #------------------------------------------------------------#
1140
1141 =head3 NewOrderItem
1142
1143   &NewOrderItem();
1144
1145 =cut
1146
1147 sub NewOrderItem {
1148     my ($itemnumber, $ordernumber)  = @_;
1149     my $dbh = C4::Context->dbh;
1150     my $query = qq|
1151             INSERT INTO aqorders_items
1152                 (itemnumber, ordernumber)
1153             VALUES (?,?)    |;
1154
1155     my $sth = $dbh->prepare($query);
1156     $sth->execute( $itemnumber, $ordernumber);
1157 }
1158
1159 #------------------------------------------------------------#
1160
1161 =head3 ModOrder
1162
1163   &ModOrder(\%hashref);
1164
1165 Modifies an existing order. Updates the order with order number
1166 $hashref->{'ordernumber'} and biblionumber $hashref->{'biblionumber'}. All
1167 other keys of the hash update the fields with the same name in the aqorders
1168 table of the Koha database.
1169
1170 =cut
1171
1172 sub ModOrder {
1173     my $orderinfo = shift;
1174
1175     die "Ordernumber is required"     if $orderinfo->{'ordernumber'} eq  '' ;
1176     die "Biblionumber is required"  if  $orderinfo->{'biblionumber'} eq '';
1177
1178     my $dbh = C4::Context->dbh;
1179     my @params;
1180
1181     # update uncertainprice to an integer, just in case (under FF, checked boxes have the value "ON" by default)
1182     $orderinfo->{uncertainprice}=1 if $orderinfo->{uncertainprice};
1183
1184 #    delete($orderinfo->{'branchcode'});
1185     # the hash contains a lot of entries not in aqorders, so get the columns ...
1186     my $sth = $dbh->prepare("SELECT * FROM aqorders LIMIT 1;");
1187     $sth->execute;
1188     my $colnames = $sth->{NAME};
1189     my $query = "UPDATE aqorders SET ";
1190
1191     foreach my $orderinfokey (grep(!/ordernumber/, keys %$orderinfo)){
1192         # ... and skip hash entries that are not in the aqorders table
1193         # FIXME : probably not the best way to do it (would be better to have a correct hash)
1194         next unless grep(/^$orderinfokey$/, @$colnames);
1195             $query .= "$orderinfokey=?, ";
1196             push(@params, $orderinfo->{$orderinfokey});
1197     }
1198
1199     $query .= "timestamp=NOW()  WHERE  ordernumber=?";
1200 #   push(@params, $specorderinfo{'ordernumber'});
1201     push(@params, $orderinfo->{'ordernumber'} );
1202     $sth = $dbh->prepare($query);
1203     $sth->execute(@params);
1204     $sth->finish;
1205 }
1206
1207 #------------------------------------------------------------#
1208
1209 =head3 ModOrderItem
1210
1211   &ModOrderItem(\%hashref);
1212
1213 Modifies the itemnumber in the aqorders_items table. The input hash needs three entities:
1214
1215 =over
1216
1217 =item - itemnumber: the old itemnumber
1218 =item - ordernumber: the order this item is attached to
1219 =item - newitemnumber: the new itemnumber we want to attach the line to
1220
1221 =back
1222
1223 =cut
1224
1225 sub ModOrderItem {
1226     my $orderiteminfo = shift;
1227     if (! $orderiteminfo->{'ordernumber'} || ! $orderiteminfo->{'itemnumber'} || ! $orderiteminfo->{'newitemnumber'}){
1228         die "Ordernumber, itemnumber and newitemnumber is required";
1229     }
1230
1231     my $dbh = C4::Context->dbh;
1232
1233     my $query = "UPDATE aqorders_items set itemnumber=? where itemnumber=? and ordernumber=?";
1234     my @params = ($orderiteminfo->{'newitemnumber'}, $orderiteminfo->{'itemnumber'}, $orderiteminfo->{'ordernumber'});
1235     my $sth = $dbh->prepare($query);
1236     $sth->execute(@params);
1237     return 0;
1238 }
1239
1240 =head3 ModItemOrder
1241
1242     ModItemOrder($itemnumber, $ordernumber);
1243
1244 Modifies the ordernumber of an item in aqorders_items.
1245
1246 =cut
1247
1248 sub ModItemOrder {
1249     my ($itemnumber, $ordernumber) = @_;
1250
1251     return unless ($itemnumber and $ordernumber);
1252
1253     my $dbh = C4::Context->dbh;
1254     my $query = qq{
1255         UPDATE aqorders_items
1256         SET ordernumber = ?
1257         WHERE itemnumber = ?
1258     };
1259     my $sth = $dbh->prepare($query);
1260     return $sth->execute($ordernumber, $itemnumber);
1261 }
1262
1263 #------------------------------------------------------------#
1264
1265
1266 =head3 ModOrderBibliotemNumber
1267
1268   &ModOrderBiblioitemNumber($biblioitemnumber,$ordernumber, $biblionumber);
1269
1270 Modifies the biblioitemnumber for an existing order.
1271 Updates the order with order number C<$ordernum> and biblionumber C<$biblionumber>.
1272
1273 =cut
1274
1275 #FIXME: is this used at all?
1276 sub ModOrderBiblioitemNumber {
1277     my ($biblioitemnumber,$ordernumber, $biblionumber) = @_;
1278     my $dbh = C4::Context->dbh;
1279     my $query = "
1280     UPDATE aqorders
1281     SET    biblioitemnumber = ?
1282     WHERE  ordernumber = ?
1283     AND biblionumber =  ?";
1284     my $sth = $dbh->prepare($query);
1285     $sth->execute( $biblioitemnumber, $ordernumber, $biblionumber );
1286 }
1287
1288 =head3 GetCancelledOrders
1289
1290   my @orders = GetCancelledOrders($basketno, $orderby);
1291
1292 Returns cancelled orders for a basket
1293
1294 =cut
1295
1296 sub GetCancelledOrders {
1297     my ( $basketno, $orderby ) = @_;
1298
1299     return () unless $basketno;
1300
1301     my $dbh   = C4::Context->dbh;
1302     my $query = "
1303         SELECT biblio.*, biblioitems.*, aqorders.*, aqbudgets.*
1304         FROM aqorders
1305           LEFT JOIN aqbudgets   ON aqbudgets.budget_id = aqorders.budget_id
1306           LEFT JOIN biblio      ON biblio.biblionumber = aqorders.biblionumber
1307           LEFT JOIN biblioitems ON biblioitems.biblionumber = biblio.biblionumber
1308         WHERE basketno = ?
1309           AND (datecancellationprinted IS NOT NULL
1310                AND datecancellationprinted <> '0000-00-00')
1311     ";
1312
1313     $orderby = "aqorders.datecancellationprinted desc, aqorders.timestamp desc"
1314         unless $orderby;
1315     $query .= " ORDER BY $orderby";
1316     my $sth = $dbh->prepare($query);
1317     $sth->execute($basketno);
1318     my $results = $sth->fetchall_arrayref( {} );
1319
1320     return @$results;
1321 }
1322
1323
1324 #------------------------------------------------------------#
1325
1326 =head3 ModReceiveOrder
1327
1328   &ModReceiveOrder($biblionumber, $ordernumber, $quantityreceived, $user,
1329     $unitprice, $invoiceid, $biblioitemnumber,
1330     $bookfund, $rrp, \@received_itemnumbers);
1331
1332 Updates an order, to reflect the fact that it was received, at least
1333 in part. All arguments not mentioned below update the fields with the
1334 same name in the aqorders table of the Koha database.
1335
1336 If a partial order is received, splits the order into two.
1337
1338 Updates the order with bibilionumber C<$biblionumber> and ordernumber
1339 C<$ordernumber>.
1340
1341 =cut
1342
1343
1344 sub ModReceiveOrder {
1345     my (
1346         $biblionumber,    $ordernumber,  $quantrec, $user, $cost, $ecost,
1347         $invoiceid, $rrp, $budget_id, $datereceived, $received_items
1348     )
1349     = @_;
1350
1351     my $dbh = C4::Context->dbh;
1352     $datereceived = C4::Dates->output('iso') unless $datereceived;
1353     my $suggestionid = GetSuggestionFromBiblionumber( $biblionumber );
1354     if ($suggestionid) {
1355         ModSuggestion( {suggestionid=>$suggestionid,
1356                         STATUS=>'AVAILABLE',
1357                         biblionumber=> $biblionumber}
1358                         );
1359     }
1360
1361     my $sth=$dbh->prepare("
1362         SELECT * FROM   aqorders
1363         WHERE           biblionumber=? AND aqorders.ordernumber=?");
1364
1365     $sth->execute($biblionumber,$ordernumber);
1366     my $order = $sth->fetchrow_hashref();
1367     $sth->finish();
1368
1369     my $new_ordernumber = $ordernumber;
1370     if ( $order->{quantity} > $quantrec ) {
1371         # Split order line in two parts: the first is the original order line
1372         # without received items (the quantity is decreased),
1373         # the second part is a new order line with quantity=quantityrec
1374         # (entirely received)
1375         $sth=$dbh->prepare("
1376             UPDATE aqorders
1377             SET quantity = ?
1378             WHERE ordernumber = ?
1379         ");
1380
1381         $sth->execute($order->{quantity} - $quantrec, $ordernumber);
1382
1383         $sth->finish;
1384
1385         delete $order->{'ordernumber'};
1386         $order->{'quantity'} = $quantrec;
1387         $order->{'quantityreceived'} = $quantrec;
1388         $order->{'datereceived'} = $datereceived;
1389         $order->{'invoiceid'} = $invoiceid;
1390         $order->{'unitprice'} = $cost;
1391         $order->{'rrp'} = $rrp;
1392         $order->{ecost} = $ecost;
1393         $order->{'orderstatus'} = 3;    # totally received
1394         $new_ordernumber = NewOrder($order);
1395
1396         if ($received_items) {
1397             foreach my $itemnumber (@$received_items) {
1398                 ModItemOrder($itemnumber, $new_ordernumber);
1399             }
1400         }
1401     } else {
1402         $sth=$dbh->prepare("update aqorders
1403                             set quantityreceived=?,datereceived=?,invoiceid=?,
1404                                 unitprice=?,rrp=?,ecost=?
1405                             where biblionumber=? and ordernumber=?");
1406         $sth->execute($quantrec,$datereceived,$invoiceid,$cost,$rrp,$ecost,$biblionumber,$ordernumber);
1407         $sth->finish;
1408     }
1409     return ($datereceived, $new_ordernumber);
1410 }
1411
1412 =head3 CancelReceipt
1413
1414     my $parent_ordernumber = CancelReceipt($ordernumber);
1415
1416     Cancel an order line receipt and update the parent order line, as if no
1417     receipt was made.
1418     If items are created at receipt (AcqCreateItem = receiving) then delete
1419     these items.
1420
1421 =cut
1422
1423 sub CancelReceipt {
1424     my $ordernumber = shift;
1425
1426     return unless $ordernumber;
1427
1428     my $dbh = C4::Context->dbh;
1429     my $query = qq{
1430         SELECT datereceived, parent_ordernumber, quantity
1431         FROM aqorders
1432         WHERE ordernumber = ?
1433     };
1434     my $sth = $dbh->prepare($query);
1435     $sth->execute($ordernumber);
1436     my $order = $sth->fetchrow_hashref;
1437     unless($order) {
1438         warn "CancelReceipt: order $ordernumber does not exist";
1439         return;
1440     }
1441     unless($order->{'datereceived'}) {
1442         warn "CancelReceipt: order $ordernumber is not received";
1443         return;
1444     }
1445
1446     my $parent_ordernumber = $order->{'parent_ordernumber'};
1447
1448     if($parent_ordernumber == $ordernumber || not $parent_ordernumber) {
1449         # The order line has no parent, just mark it as not received
1450         $query = qq{
1451             UPDATE aqorders
1452             SET quantityreceived = ?,
1453                 datereceived = ?,
1454                 invoiceid = ?
1455             WHERE ordernumber = ?
1456         };
1457         $sth = $dbh->prepare($query);
1458         $sth->execute(0, undef, undef, $ordernumber);
1459     } else {
1460         # The order line has a parent, increase parent quantity and delete
1461         # the order line.
1462         $query = qq{
1463             SELECT quantity, datereceived
1464             FROM aqorders
1465             WHERE ordernumber = ?
1466         };
1467         $sth = $dbh->prepare($query);
1468         $sth->execute($parent_ordernumber);
1469         my $parent_order = $sth->fetchrow_hashref;
1470         unless($parent_order) {
1471             warn "Parent order $parent_ordernumber does not exist.";
1472             return;
1473         }
1474         if($parent_order->{'datereceived'}) {
1475             warn "CancelReceipt: parent order is received.".
1476                 " Can't cancel receipt.";
1477             return;
1478         }
1479         $query = qq{
1480             UPDATE aqorders
1481             SET quantity = ?
1482             WHERE ordernumber = ?
1483         };
1484         $sth = $dbh->prepare($query);
1485         my $rv = $sth->execute(
1486             $order->{'quantity'} + $parent_order->{'quantity'},
1487             $parent_ordernumber
1488         );
1489         unless($rv) {
1490             warn "Cannot update parent order line, so do not cancel".
1491                 " receipt";
1492             return;
1493         }
1494         if(C4::Context->preference('AcqCreateItem') eq 'receiving') {
1495             # Remove items that were created at receipt
1496             $query = qq{
1497                 DELETE FROM items, aqorders_items
1498                 USING items, aqorders_items
1499                 WHERE items.itemnumber = ? AND aqorders_items.itemnumber = ?
1500             };
1501             $sth = $dbh->prepare($query);
1502             my @itemnumbers = GetItemnumbersFromOrder($ordernumber);
1503             foreach my $itemnumber (@itemnumbers) {
1504                 $sth->execute($itemnumber, $itemnumber);
1505             }
1506         } else {
1507             # Update items
1508             my @itemnumbers = GetItemnumbersFromOrder($ordernumber);
1509             foreach my $itemnumber (@itemnumbers) {
1510                 ModItemOrder($itemnumber, $parent_ordernumber);
1511             }
1512         }
1513         # Delete order line
1514         $query = qq{
1515             DELETE FROM aqorders
1516             WHERE ordernumber = ?
1517         };
1518         $sth = $dbh->prepare($query);
1519         $sth->execute($ordernumber);
1520
1521     }
1522
1523     return $parent_ordernumber;
1524 }
1525
1526 #------------------------------------------------------------#
1527
1528 =head3 SearchOrder
1529
1530 @results = &SearchOrder($search, $biblionumber, $complete);
1531
1532 Searches for orders.
1533
1534 C<$search> may take one of several forms: if it is an ISBN,
1535 C<&ordersearch> returns orders with that ISBN. If C<$search> is an
1536 order number, C<&ordersearch> returns orders with that order number
1537 and biblionumber C<$biblionumber>. Otherwise, C<$search> is considered
1538 to be a space-separated list of search terms; in this case, all of the
1539 terms must appear in the title (matching the beginning of title
1540 words).
1541
1542 If C<$complete> is C<yes>, the results will include only completed
1543 orders. In any case, C<&ordersearch> ignores cancelled orders.
1544
1545 C<&ordersearch> returns an array.
1546 C<@results> is an array of references-to-hash with the following keys:
1547
1548 =over 4
1549
1550 =item C<author>
1551
1552 =item C<seriestitle>
1553
1554 =item C<branchcode>
1555
1556 =item C<budget_id>
1557
1558 =back
1559
1560 =cut
1561
1562 sub SearchOrder {
1563 #### -------- SearchOrder-------------------------------
1564     my ( $ordernumber, $search, $ean, $supplierid, $basket ) = @_;
1565
1566     my $dbh = C4::Context->dbh;
1567     my @args = ();
1568     my $query =
1569             "SELECT *
1570             FROM aqorders
1571             LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1572             LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
1573             LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
1574                 WHERE  (datecancellationprinted is NULL)";
1575
1576     if($ordernumber){
1577         $query .= " AND (aqorders.ordernumber=?)";
1578         push @args, $ordernumber;
1579     }
1580     if($search){
1581         $query .= " AND (biblio.title like ? OR biblio.author LIKE ? OR biblioitems.isbn like ?)";
1582         push @args, ("%$search%","%$search%","%$search%");
1583     }
1584     if ($ean) {
1585         $query .= " AND biblioitems.ean = ?";
1586         push @args, $ean;
1587     }
1588     if ($supplierid) {
1589         $query .= "AND aqbasket.booksellerid = ?";
1590         push @args, $supplierid;
1591     }
1592     if($basket){
1593         $query .= "AND aqorders.basketno = ?";
1594         push @args, $basket;
1595     }
1596
1597     my $sth = $dbh->prepare($query);
1598     $sth->execute(@args);
1599     my $results = $sth->fetchall_arrayref({});
1600     $sth->finish;
1601     return $results;
1602 }
1603
1604 #------------------------------------------------------------#
1605
1606 =head3 DelOrder
1607
1608   &DelOrder($biblionumber, $ordernumber);
1609
1610 Cancel the order with the given order and biblio numbers. It does not
1611 delete any entries in the aqorders table, it merely marks them as
1612 cancelled.
1613
1614 =cut
1615
1616 sub DelOrder {
1617     my ( $bibnum, $ordernumber ) = @_;
1618     my $dbh = C4::Context->dbh;
1619     my $query = "
1620         UPDATE aqorders
1621         SET    datecancellationprinted=now()
1622         WHERE  biblionumber=? AND ordernumber=?
1623     ";
1624     my $sth = $dbh->prepare($query);
1625     $sth->execute( $bibnum, $ordernumber );
1626     $sth->finish;
1627     my @itemnumbers = GetItemnumbersFromOrder( $ordernumber );
1628     foreach my $itemnumber (@itemnumbers){
1629         C4::Items::DelItem( $dbh, $bibnum, $itemnumber );
1630     }
1631
1632 }
1633
1634 =head2 FUNCTIONS ABOUT PARCELS
1635
1636 =cut
1637
1638 #------------------------------------------------------------#
1639
1640 =head3 GetParcel
1641
1642   @results = &GetParcel($booksellerid, $code, $date);
1643
1644 Looks up all of the received items from the supplier with the given
1645 bookseller ID at the given date, for the given code (bookseller Invoice number). Ignores cancelled and completed orders.
1646
1647 C<@results> is an array of references-to-hash. The keys of each element are fields from
1648 the aqorders, biblio, and biblioitems tables of the Koha database.
1649
1650 C<@results> is sorted alphabetically by book title.
1651
1652 =cut
1653
1654 sub GetParcel {
1655     #gets all orders from a certain supplier, orders them alphabetically
1656     my ( $supplierid, $code, $datereceived ) = @_;
1657     my $dbh     = C4::Context->dbh;
1658     my @results = ();
1659     $code .= '%'
1660     if $code;  # add % if we search on a given code (otherwise, let him empty)
1661     my $strsth ="
1662         SELECT  authorisedby,
1663                 creationdate,
1664                 aqbasket.basketno,
1665                 closedate,surname,
1666                 firstname,
1667                 aqorders.biblionumber,
1668                 aqorders.ordernumber,
1669                 aqorders.parent_ordernumber,
1670                 aqorders.quantity,
1671                 aqorders.quantityreceived,
1672                 aqorders.unitprice,
1673                 aqorders.listprice,
1674                 aqorders.rrp,
1675                 aqorders.ecost,
1676                 aqorders.gstrate,
1677                 biblio.title
1678         FROM aqorders
1679         LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
1680         LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
1681         LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1682         LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid
1683         WHERE
1684             aqbasket.booksellerid = ?
1685             AND aqinvoices.invoicenumber LIKE ?
1686             AND aqorders.datereceived = ? ";
1687
1688     my @query_params = ( $supplierid, $code, $datereceived );
1689     if ( C4::Context->preference("IndependantBranches") ) {
1690         my $userenv = C4::Context->userenv;
1691         if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
1692             $strsth .= " and (borrowers.branchcode = ?
1693                         or borrowers.branchcode  = '')";
1694             push @query_params, $userenv->{branch};
1695         }
1696     }
1697     $strsth .= " ORDER BY aqbasket.basketno";
1698     # ## parcelinformation : $strsth
1699     my $sth = $dbh->prepare($strsth);
1700     $sth->execute( @query_params );
1701     while ( my $data = $sth->fetchrow_hashref ) {
1702         push( @results, $data );
1703     }
1704     # ## countparcelbiblio: scalar(@results)
1705     $sth->finish;
1706
1707     return @results;
1708 }
1709
1710 #------------------------------------------------------------#
1711
1712 =head3 GetParcels
1713
1714   $results = &GetParcels($bookseller, $order, $code, $datefrom, $dateto);
1715
1716 get a lists of parcels.
1717
1718 * Input arg :
1719
1720 =over
1721
1722 =item $bookseller
1723 is the bookseller this function has to get parcels.
1724
1725 =item $order
1726 To know on what criteria the results list has to be ordered.
1727
1728 =item $code
1729 is the booksellerinvoicenumber.
1730
1731 =item $datefrom & $dateto
1732 to know on what date this function has to filter its search.
1733
1734 =back
1735
1736 * return:
1737 a pointer on a hash list containing parcel informations as such :
1738
1739 =over
1740
1741 =item Creation date
1742
1743 =item Last operation
1744
1745 =item Number of biblio
1746
1747 =item Number of items
1748
1749 =back
1750
1751 =cut
1752
1753 sub GetParcels {
1754     my ($bookseller,$order, $code, $datefrom, $dateto) = @_;
1755     my $dbh    = C4::Context->dbh;
1756     my @query_params = ();
1757     my $strsth ="
1758         SELECT  aqinvoices.invoicenumber,
1759                 datereceived,purchaseordernumber,
1760                 count(DISTINCT biblionumber) AS biblio,
1761                 sum(quantity) AS itemsexpected,
1762                 sum(quantityreceived) AS itemsreceived
1763         FROM   aqorders LEFT JOIN aqbasket ON aqbasket.basketno = aqorders.basketno
1764         LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid
1765         WHERE aqbasket.booksellerid = ? and datereceived IS NOT NULL
1766     ";
1767     push @query_params, $bookseller;
1768
1769     if ( defined $code ) {
1770         $strsth .= ' and aqinvoices.invoicenumber like ? ';
1771         # add a % to the end of the code to allow stemming.
1772         push @query_params, "$code%";
1773     }
1774
1775     if ( defined $datefrom ) {
1776         $strsth .= ' and datereceived >= ? ';
1777         push @query_params, $datefrom;
1778     }
1779
1780     if ( defined $dateto ) {
1781         $strsth .=  'and datereceived <= ? ';
1782         push @query_params, $dateto;
1783     }
1784
1785     $strsth .= "group by aqinvoices.invoicenumber,datereceived ";
1786
1787     # can't use a placeholder to place this column name.
1788     # but, we could probably be checking to make sure it is a column that will be fetched.
1789     $strsth .= "order by $order " if ($order);
1790
1791     my $sth = $dbh->prepare($strsth);
1792
1793     $sth->execute( @query_params );
1794     my $results = $sth->fetchall_arrayref({});
1795     $sth->finish;
1796     return @$results;
1797 }
1798
1799 #------------------------------------------------------------#
1800
1801 =head3 GetLateOrders
1802
1803   @results = &GetLateOrders;
1804
1805 Searches for bookseller with late orders.
1806
1807 return:
1808 the table of supplier with late issues. This table is full of hashref.
1809
1810 =cut
1811
1812 sub GetLateOrders {
1813     my $delay      = shift;
1814     my $supplierid = shift;
1815     my $branch     = shift;
1816     my $estimateddeliverydatefrom = shift;
1817     my $estimateddeliverydateto = shift;
1818
1819     my $dbh = C4::Context->dbh;
1820
1821     #BEWARE, order of parenthesis and LEFT JOIN is important for speed
1822     my $dbdriver = C4::Context->config("db_scheme") || "mysql";
1823
1824     my @query_params = ();
1825     my $select = "
1826     SELECT aqbasket.basketno,
1827         aqorders.ordernumber,
1828         DATE(aqbasket.closedate)  AS orderdate,
1829         aqorders.rrp              AS unitpricesupplier,
1830         aqorders.ecost            AS unitpricelib,
1831         aqorders.claims_count     AS claims_count,
1832         aqorders.claimed_date     AS claimed_date,
1833         aqbudgets.budget_name     AS budget,
1834         borrowers.branchcode      AS branch,
1835         aqbooksellers.name        AS supplier,
1836         aqbooksellers.id          AS supplierid,
1837         biblio.author, biblio.title,
1838         biblioitems.publishercode AS publisher,
1839         biblioitems.publicationyear,
1840         ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) AS estimateddeliverydate,
1841     ";
1842     my $from = "
1843     FROM
1844         aqorders LEFT JOIN biblio     ON biblio.biblionumber         = aqorders.biblionumber
1845         LEFT JOIN biblioitems         ON biblioitems.biblionumber    = biblio.biblionumber
1846         LEFT JOIN aqbudgets           ON aqorders.budget_id          = aqbudgets.budget_id,
1847         aqbasket LEFT JOIN borrowers  ON aqbasket.authorisedby       = borrowers.borrowernumber
1848         LEFT JOIN aqbooksellers       ON aqbasket.booksellerid       = aqbooksellers.id
1849         WHERE aqorders.basketno = aqbasket.basketno
1850         AND ( datereceived = ''
1851             OR datereceived IS NULL
1852             OR aqorders.quantityreceived < aqorders.quantity
1853         )
1854         AND aqbasket.closedate IS NOT NULL
1855         AND (aqorders.datecancellationprinted IS NULL OR aqorders.datecancellationprinted='0000-00-00')
1856     ";
1857     my $having = "";
1858     if ($dbdriver eq "mysql") {
1859         $select .= "
1860         aqorders.quantity - COALESCE(aqorders.quantityreceived,0)                 AS quantity,
1861         (aqorders.quantity - COALESCE(aqorders.quantityreceived,0)) * aqorders.rrp AS subtotal,
1862         DATEDIFF(CAST(now() AS date),closedate) AS latesince
1863         ";
1864         if ( defined $delay ) {
1865             $from .= " AND (closedate <= DATE_SUB(CAST(now() AS date),INTERVAL ? DAY)) " ;
1866             push @query_params, $delay;
1867         }
1868         $having = "
1869         HAVING quantity          <> 0
1870             AND unitpricesupplier <> 0
1871             AND unitpricelib      <> 0
1872         ";
1873     } else {
1874         # FIXME: account for IFNULL as above
1875         $select .= "
1876                 aqorders.quantity                AS quantity,
1877                 aqorders.quantity * aqorders.rrp AS subtotal,
1878                 (CAST(now() AS date) - closedate)            AS latesince
1879         ";
1880         if ( defined $delay ) {
1881             $from .= " AND (closedate <= (CAST(now() AS date) -(INTERVAL ? DAY)) ";
1882             push @query_params, $delay;
1883         }
1884     }
1885     if (defined $supplierid) {
1886         $from .= ' AND aqbasket.booksellerid = ? ';
1887         push @query_params, $supplierid;
1888     }
1889     if (defined $branch) {
1890         $from .= ' AND borrowers.branchcode LIKE ? ';
1891         push @query_params, $branch;
1892     }
1893
1894     if ( defined $estimateddeliverydatefrom or defined $estimateddeliverydateto ) {
1895         $from .= ' AND aqbooksellers.deliverytime IS NOT NULL ';
1896     }
1897     if ( defined $estimateddeliverydatefrom ) {
1898         $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) >= ?';
1899         push @query_params, $estimateddeliverydatefrom;
1900     }
1901     if ( defined $estimateddeliverydateto ) {
1902         $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) <= ?';
1903         push @query_params, $estimateddeliverydateto;
1904     }
1905     if ( defined $estimateddeliverydatefrom and not defined $estimateddeliverydateto ) {
1906         $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) <= CAST(now() AS date)';
1907     }
1908     if (C4::Context->preference("IndependantBranches")
1909             && C4::Context->userenv
1910             && C4::Context->userenv->{flags} != 1 ) {
1911         $from .= ' AND borrowers.branchcode LIKE ? ';
1912         push @query_params, C4::Context->userenv->{branch};
1913     }
1914     my $query = "$select $from $having\nORDER BY latesince, basketno, borrowers.branchcode, supplier";
1915     $debug and print STDERR "GetLateOrders query: $query\nGetLateOrders args: " . join(" ",@query_params);
1916     my $sth = $dbh->prepare($query);
1917     $sth->execute(@query_params);
1918     my @results;
1919     while (my $data = $sth->fetchrow_hashref) {
1920         $data->{orderdate} = format_date($data->{orderdate});
1921         $data->{claimed_date} = format_date($data->{claimed_date});
1922         push @results, $data;
1923     }
1924     return @results;
1925 }
1926
1927 #------------------------------------------------------------#
1928
1929 =head3 GetHistory
1930
1931   (\@order_loop, $total_qty, $total_price, $total_qtyreceived) = GetHistory( %params );
1932
1933 Retreives some acquisition history information
1934
1935 params:
1936   title
1937   author
1938   name
1939   from_placed_on
1940   to_placed_on
1941   basket                  - search both basket name and number
1942   booksellerinvoicenumber
1943
1944 returns:
1945     $order_loop is a list of hashrefs that each look like this:
1946             {
1947                 'author'           => 'Twain, Mark',
1948                 'basketno'         => '1',
1949                 'biblionumber'     => '215',
1950                 'count'            => 1,
1951                 'creationdate'     => 'MM/DD/YYYY',
1952                 'datereceived'     => undef,
1953                 'ecost'            => '1.00',
1954                 'id'               => '1',
1955                 'invoicenumber'    => undef,
1956                 'name'             => '',
1957                 'ordernumber'      => '1',
1958                 'quantity'         => 1,
1959                 'quantityreceived' => undef,
1960                 'title'            => 'The Adventures of Huckleberry Finn'
1961             }
1962     $total_qty is the sum of all of the quantities in $order_loop
1963     $total_price is the cost of each in $order_loop times the quantity
1964     $total_qtyreceived is the sum of all of the quantityreceived entries in $order_loop
1965
1966 =cut
1967
1968 sub GetHistory {
1969 # don't run the query if there are no parameters (list would be too long for sure !)
1970     croak "No search params" unless @_;
1971     my %params = @_;
1972     my $title = $params{title};
1973     my $author = $params{author};
1974     my $isbn   = $params{isbn};
1975     my $ean    = $params{ean};
1976     my $name = $params{name};
1977     my $from_placed_on = $params{from_placed_on};
1978     my $to_placed_on = $params{to_placed_on};
1979     my $basket = $params{basket};
1980     my $booksellerinvoicenumber = $params{booksellerinvoicenumber};
1981     my $basketgroupname = $params{basketgroupname};
1982     my @order_loop;
1983     my $total_qty         = 0;
1984     my $total_qtyreceived = 0;
1985     my $total_price       = 0;
1986
1987     my $dbh   = C4::Context->dbh;
1988     my $query ="
1989         SELECT
1990             biblio.title,
1991             biblio.author,
1992             biblioitems.isbn,
1993         biblioitems.ean,
1994             aqorders.basketno,
1995             aqbasket.basketname,
1996             aqbasket.basketgroupid,
1997             aqbasketgroups.name as groupname,
1998             aqbooksellers.name,
1999             aqbasket.creationdate,
2000             aqorders.datereceived,
2001             aqorders.quantity,
2002             aqorders.quantityreceived,
2003             aqorders.ecost,
2004             aqorders.ordernumber,
2005             aqinvoices.invoicenumber,
2006             aqbooksellers.id as id,
2007             aqorders.biblionumber
2008         FROM aqorders
2009         LEFT JOIN aqbasket ON aqorders.basketno=aqbasket.basketno
2010         LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid=aqbasketgroups.id
2011         LEFT JOIN aqbooksellers ON aqbasket.booksellerid=aqbooksellers.id
2012         LEFT JOIN biblioitems ON biblioitems.biblionumber=aqorders.biblionumber
2013         LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber
2014     LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid";
2015
2016     $query .= " LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber"
2017     if ( C4::Context->preference("IndependantBranches") );
2018
2019     $query .= " WHERE (datecancellationprinted is NULL or datecancellationprinted='0000-00-00') ";
2020
2021     my @query_params  = ();
2022
2023     if ( $title ) {
2024         $query .= " AND biblio.title LIKE ? ";
2025         $title =~ s/\s+/%/g;
2026         push @query_params, "%$title%";
2027     }
2028
2029     if ( $author ) {
2030         $query .= " AND biblio.author LIKE ? ";
2031         push @query_params, "%$author%";
2032     }
2033
2034     if ( $isbn ) {
2035         $query .= " AND biblioitems.isbn LIKE ? ";
2036         push @query_params, "%$isbn%";
2037     }
2038     if ( defined $ean and $ean ) {
2039         $query .= " AND biblioitems.ean = ? ";
2040         push @query_params, "$ean";
2041     }
2042     if ( $name ) {
2043         $query .= " AND aqbooksellers.name LIKE ? ";
2044         push @query_params, "%$name%";
2045     }
2046
2047     if ( $from_placed_on ) {
2048         $query .= " AND creationdate >= ? ";
2049         push @query_params, $from_placed_on;
2050     }
2051
2052     if ( $to_placed_on ) {
2053         $query .= " AND creationdate <= ? ";
2054         push @query_params, $to_placed_on;
2055     }
2056
2057     if ($basket) {
2058         if ($basket =~ m/^\d+$/) {
2059             $query .= " AND aqorders.basketno = ? ";
2060             push @query_params, $basket;
2061         } else {
2062             $query .= " AND aqbasket.basketname LIKE ? ";
2063             push @query_params, "%$basket%";
2064         }
2065     }
2066
2067     if ($booksellerinvoicenumber) {
2068         $query .= " AND aqinvoices.invoicenumber LIKE ? ";
2069         push @query_params, "%$booksellerinvoicenumber%";
2070     }
2071
2072     if ($basketgroupname) {
2073         $query .= " AND aqbasketgroups.name LIKE ? ";
2074         push @query_params, "%$basketgroupname%";
2075     }
2076
2077     if ( C4::Context->preference("IndependantBranches") ) {
2078         my $userenv = C4::Context->userenv;
2079         if ( $userenv && ($userenv->{flags} || 0) != 1 ) {
2080             $query .= " AND (borrowers.branchcode = ? OR borrowers.branchcode ='' ) ";
2081             push @query_params, $userenv->{branch};
2082         }
2083     }
2084     $query .= " ORDER BY id";
2085     my $sth = $dbh->prepare($query);
2086     $sth->execute( @query_params );
2087     my $cnt = 1;
2088     while ( my $line = $sth->fetchrow_hashref ) {
2089         $line->{count} = $cnt++;
2090         $line->{toggle} = 1 if $cnt % 2;
2091         push @order_loop, $line;
2092         $total_qty         += $line->{'quantity'};
2093         $total_qtyreceived += $line->{'quantityreceived'};
2094         $total_price       += $line->{'quantity'} * $line->{'ecost'};
2095     }
2096     return \@order_loop, $total_qty, $total_price, $total_qtyreceived;
2097 }
2098
2099 =head2 GetRecentAcqui
2100
2101   $results = GetRecentAcqui($days);
2102
2103 C<$results> is a ref to a table which containts hashref
2104
2105 =cut
2106
2107 sub GetRecentAcqui {
2108     my $limit  = shift;
2109     my $dbh    = C4::Context->dbh;
2110     my $query = "
2111         SELECT *
2112         FROM   biblio
2113         ORDER BY timestamp DESC
2114         LIMIT  0,".$limit;
2115
2116     my $sth = $dbh->prepare($query);
2117     $sth->execute;
2118     my $results = $sth->fetchall_arrayref({});
2119     return $results;
2120 }
2121
2122 =head3 GetContracts
2123
2124   $contractlist = &GetContracts($booksellerid, $activeonly);
2125
2126 Looks up the contracts that belong to a bookseller
2127
2128 Returns a list of contracts
2129
2130 =over
2131
2132 =item C<$booksellerid> is the "id" field in the "aqbooksellers" table.
2133
2134 =item C<$activeonly> if exists get only contracts that are still active.
2135
2136 =back
2137
2138 =cut
2139
2140 sub GetContracts {
2141     my ( $booksellerid, $activeonly ) = @_;
2142     my $dbh = C4::Context->dbh;
2143     my $query;
2144     if (! $activeonly) {
2145         $query = "
2146             SELECT *
2147             FROM   aqcontract
2148             WHERE  booksellerid=?
2149         ";
2150     } else {
2151         $query = "SELECT *
2152             FROM aqcontract
2153             WHERE booksellerid=?
2154                 AND contractenddate >= CURDATE( )";
2155     }
2156     my $sth = $dbh->prepare($query);
2157     $sth->execute( $booksellerid );
2158     my @results;
2159     while (my $data = $sth->fetchrow_hashref ) {
2160         push(@results, $data);
2161     }
2162     $sth->finish;
2163     return @results;
2164 }
2165
2166 #------------------------------------------------------------#
2167
2168 =head3 GetContract
2169
2170   $contract = &GetContract($contractID);
2171
2172 Looks up the contract that has PRIMKEY (contractnumber) value $contractID
2173
2174 Returns a contract
2175
2176 =cut
2177
2178 sub GetContract {
2179     my ( $contractno ) = @_;
2180     my $dbh = C4::Context->dbh;
2181     my $query = "
2182         SELECT *
2183         FROM   aqcontract
2184         WHERE  contractnumber=?
2185         ";
2186
2187     my $sth = $dbh->prepare($query);
2188     $sth->execute( $contractno );
2189     my $result = $sth->fetchrow_hashref;
2190     return $result;
2191 }
2192
2193 =head3 AddClaim
2194
2195 =over 4
2196
2197 &AddClaim($ordernumber);
2198
2199 Add a claim for an order
2200
2201 =back
2202
2203 =cut
2204 sub AddClaim {
2205     my ($ordernumber) = @_;
2206     my $dbh          = C4::Context->dbh;
2207     my $query        = "
2208         UPDATE aqorders SET
2209             claims_count = claims_count + 1,
2210             claimed_date = CURDATE()
2211         WHERE ordernumber = ?
2212         ";
2213     my $sth = $dbh->prepare($query);
2214     $sth->execute($ordernumber);
2215 }
2216
2217 =head3 GetInvoices
2218
2219     my @invoices = GetInvoices(
2220         invoicenumber => $invoicenumber,
2221         suppliername => $suppliername,
2222         shipmentdatefrom => $shipmentdatefrom, # ISO format
2223         shipmentdateto => $shipmentdateto, # ISO format
2224         billingdatefrom => $billingdatefrom, # ISO format
2225         billingdateto => $billingdateto, # ISO format
2226         isbneanissn => $isbn_or_ean_or_issn,
2227         title => $title,
2228         author => $author,
2229         publisher => $publisher,
2230         publicationyear => $publicationyear,
2231         branchcode => $branchcode,
2232         order_by => $order_by
2233     );
2234
2235 Return a list of invoices that match all given criteria.
2236
2237 $order_by is "column_name (asc|desc)", where column_name is any of
2238 'invoicenumber', 'booksellerid', 'shipmentdate', 'billingdate', 'closedate',
2239 'shipmentcost', 'shipmentcost_budgetid'.
2240
2241 asc is the default if omitted
2242
2243 =cut
2244
2245 sub GetInvoices {
2246     my %args = @_;
2247
2248     my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2249         closedate shipmentcost shipmentcost_budgetid);
2250
2251     my $dbh = C4::Context->dbh;
2252     my $query = qq{
2253         SELECT aqinvoices.*, aqbooksellers.name AS suppliername,
2254           COUNT(
2255             DISTINCT IF(
2256               aqorders.datereceived IS NOT NULL,
2257               aqorders.biblionumber,
2258               NULL
2259             )
2260           ) AS receivedbiblios,
2261           SUM(aqorders.quantityreceived) AS receiveditems
2262         FROM aqinvoices
2263           LEFT JOIN aqbooksellers ON aqbooksellers.id = aqinvoices.booksellerid
2264           LEFT JOIN aqorders ON aqorders.invoiceid = aqinvoices.invoiceid
2265           LEFT JOIN biblio ON aqorders.biblionumber = biblio.biblionumber
2266           LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
2267           LEFT JOIN subscription ON biblio.biblionumber = subscription.biblionumber
2268     };
2269
2270     my @bind_args;
2271     my @bind_strs;
2272     if($args{supplierid}) {
2273         push @bind_strs, " aqinvoices.booksellerid = ? ";
2274         push @bind_args, $args{supplierid};
2275     }
2276     if($args{invoicenumber}) {
2277         push @bind_strs, " aqinvoices.invoicenumber LIKE ? ";
2278         push @bind_args, "%$args{invoicenumber}%";
2279     }
2280     if($args{suppliername}) {
2281         push @bind_strs, " aqbooksellers.name LIKE ? ";
2282         push @bind_args, "%$args{suppliername}%";
2283     }
2284     if($args{shipmentdatefrom}) {
2285         push @bind_strs, " aqinvoices.shipementdate >= ? ";
2286         push @bind_args, $args{shipmentdatefrom};
2287     }
2288     if($args{shipmentdateto}) {
2289         push @bind_strs, " aqinvoices.shipementdate <= ? ";
2290         push @bind_args, $args{shipmentdateto};
2291     }
2292     if($args{billingdatefrom}) {
2293         push @bind_strs, " aqinvoices.billingdate >= ? ";
2294         push @bind_args, $args{billingdatefrom};
2295     }
2296     if($args{billingdateto}) {
2297         push @bind_strs, " aqinvoices.billingdate <= ? ";
2298         push @bind_args, $args{billingdateto};
2299     }
2300     if($args{isbneanissn}) {
2301         push @bind_strs, " (biblioitems.isbn LIKE ? OR biblioitems.ean LIKE ? OR biblioitems.issn LIKE ? ) ";
2302         push @bind_args, $args{isbneanissn}, $args{isbneanissn}, $args{isbneanissn};
2303     }
2304     if($args{title}) {
2305         push @bind_strs, " biblio.title LIKE ? ";
2306         push @bind_args, $args{title};
2307     }
2308     if($args{author}) {
2309         push @bind_strs, " biblio.author LIKE ? ";
2310         push @bind_args, $args{author};
2311     }
2312     if($args{publisher}) {
2313         push @bind_strs, " biblioitems.publishercode LIKE ? ";
2314         push @bind_args, $args{publisher};
2315     }
2316     if($args{publicationyear}) {
2317         push @bind_strs, " biblioitems.publicationyear = ? ";
2318         push @bind_args, $args{publicationyear};
2319     }
2320     if($args{branchcode}) {
2321         push @bind_strs, " aqorders.branchcode = ? ";
2322         push @bind_args, $args{branchcode};
2323     }
2324
2325     $query .= " WHERE " . join(" AND ", @bind_strs) if @bind_strs;
2326     $query .= " GROUP BY aqinvoices.invoiceid ";
2327
2328     if($args{order_by}) {
2329         my ($column, $direction) = split / /, $args{order_by};
2330         if(grep /^$column$/, @columns) {
2331             $direction ||= 'ASC';
2332             $query .= " ORDER BY $column $direction";
2333         }
2334     }
2335
2336     my $sth = $dbh->prepare($query);
2337     $sth->execute(@bind_args);
2338
2339     my $results = $sth->fetchall_arrayref({});
2340     return @$results;
2341 }
2342
2343 =head3 GetInvoice
2344
2345     my $invoice = GetInvoice($invoiceid);
2346
2347 Get informations about invoice with given $invoiceid
2348
2349 Return a hash filled with aqinvoices.* fields
2350
2351 =cut
2352
2353 sub GetInvoice {
2354     my ($invoiceid) = @_;
2355     my $invoice;
2356
2357     return unless $invoiceid;
2358
2359     my $dbh = C4::Context->dbh;
2360     my $query = qq{
2361         SELECT *
2362         FROM aqinvoices
2363         WHERE invoiceid = ?
2364     };
2365     my $sth = $dbh->prepare($query);
2366     $sth->execute($invoiceid);
2367
2368     $invoice = $sth->fetchrow_hashref;
2369     return $invoice;
2370 }
2371
2372 =head3 GetInvoiceDetails
2373
2374     my $invoice = GetInvoiceDetails($invoiceid)
2375
2376 Return informations about an invoice + the list of related order lines
2377
2378 Orders informations are in $invoice->{orders} (array ref)
2379
2380 =cut
2381
2382 sub GetInvoiceDetails {
2383     my ($invoiceid) = @_;
2384
2385     if ( !defined $invoiceid ) {
2386         carp 'GetInvoiceDetails called without an invoiceid';
2387         return;
2388     }
2389
2390     my $dbh = C4::Context->dbh;
2391     my $query = qq{
2392         SELECT aqinvoices.*, aqbooksellers.name AS suppliername
2393         FROM aqinvoices
2394           LEFT JOIN aqbooksellers ON aqinvoices.booksellerid = aqbooksellers.id
2395         WHERE invoiceid = ?
2396     };
2397     my $sth = $dbh->prepare($query);
2398     $sth->execute($invoiceid);
2399
2400     my $invoice = $sth->fetchrow_hashref;
2401
2402     $query = qq{
2403         SELECT aqorders.*, biblio.*
2404         FROM aqorders
2405           LEFT JOIN biblio ON aqorders.biblionumber = biblio.biblionumber
2406         WHERE invoiceid = ?
2407     };
2408     $sth = $dbh->prepare($query);
2409     $sth->execute($invoiceid);
2410     $invoice->{orders} = $sth->fetchall_arrayref({});
2411     $invoice->{orders} ||= []; # force an empty arrayref if fetchall_arrayref fails
2412
2413     return $invoice;
2414 }
2415
2416 =head3 AddInvoice
2417
2418     my $invoiceid = AddInvoice(
2419         invoicenumber => $invoicenumber,
2420         booksellerid => $booksellerid,
2421         shipmentdate => $shipmentdate,
2422         billingdate => $billingdate,
2423         closedate => $closedate,
2424         shipmentcost => $shipmentcost,
2425         shipmentcost_budgetid => $shipmentcost_budgetid
2426     );
2427
2428 Create a new invoice and return its id or undef if it fails.
2429
2430 =cut
2431
2432 sub AddInvoice {
2433     my %invoice = @_;
2434
2435     return unless(%invoice and $invoice{invoicenumber});
2436
2437     my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2438         closedate shipmentcost shipmentcost_budgetid);
2439
2440     my @set_strs;
2441     my @set_args;
2442     foreach my $key (keys %invoice) {
2443         if(0 < grep(/^$key$/, @columns)) {
2444             push @set_strs, "$key = ?";
2445             push @set_args, ($invoice{$key} || undef);
2446         }
2447     }
2448
2449     my $rv;
2450     if(@set_args > 0) {
2451         my $dbh = C4::Context->dbh;
2452         my $query = "INSERT INTO aqinvoices SET ";
2453         $query .= join (",", @set_strs);
2454         my $sth = $dbh->prepare($query);
2455         $rv = $sth->execute(@set_args);
2456         if($rv) {
2457             $rv = $dbh->last_insert_id(undef, undef, 'aqinvoices', undef);
2458         }
2459     }
2460     return $rv;
2461 }
2462
2463 =head3 ModInvoice
2464
2465     ModInvoice(
2466         invoiceid => $invoiceid,    # Mandatory
2467         invoicenumber => $invoicenumber,
2468         booksellerid => $booksellerid,
2469         shipmentdate => $shipmentdate,
2470         billingdate => $billingdate,
2471         closedate => $closedate,
2472         shipmentcost => $shipmentcost,
2473         shipmentcost_budgetid => $shipmentcost_budgetid
2474     );
2475
2476 Modify an invoice, invoiceid is mandatory.
2477
2478 Return undef if it fails.
2479
2480 =cut
2481
2482 sub ModInvoice {
2483     my %invoice = @_;
2484
2485     return unless(%invoice and $invoice{invoiceid});
2486
2487     my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2488         closedate shipmentcost shipmentcost_budgetid);
2489
2490     my @set_strs;
2491     my @set_args;
2492     foreach my $key (keys %invoice) {
2493         if(0 < grep(/^$key$/, @columns)) {
2494             push @set_strs, "$key = ?";
2495             push @set_args, ($invoice{$key} || undef);
2496         }
2497     }
2498
2499     my $dbh = C4::Context->dbh;
2500     my $query = "UPDATE aqinvoices SET ";
2501     $query .= join(",", @set_strs);
2502     $query .= " WHERE invoiceid = ?";
2503
2504     my $sth = $dbh->prepare($query);
2505     $sth->execute(@set_args, $invoice{invoiceid});
2506 }
2507
2508 =head3 CloseInvoice
2509
2510     CloseInvoice($invoiceid);
2511
2512 Close an invoice.
2513
2514 Equivalent to ModInvoice(invoiceid => $invoiceid, closedate => undef);
2515
2516 =cut
2517
2518 sub CloseInvoice {
2519     my ($invoiceid) = @_;
2520
2521     return unless $invoiceid;
2522
2523     my $dbh = C4::Context->dbh;
2524     my $query = qq{
2525         UPDATE aqinvoices
2526         SET closedate = CAST(NOW() AS DATE)
2527         WHERE invoiceid = ?
2528     };
2529     my $sth = $dbh->prepare($query);
2530     $sth->execute($invoiceid);
2531 }
2532
2533 =head3 ReopenInvoice
2534
2535     ReopenInvoice($invoiceid);
2536
2537 Reopen an invoice
2538
2539 Equivalent to ModInvoice(invoiceid => $invoiceid, closedate => C4::Dates->new()->output('iso'))
2540
2541 =cut
2542
2543 sub ReopenInvoice {
2544     my ($invoiceid) = @_;
2545
2546     return unless $invoiceid;
2547
2548     my $dbh = C4::Context->dbh;
2549     my $query = qq{
2550         UPDATE aqinvoices
2551         SET closedate = NULL
2552         WHERE invoiceid = ?
2553     };
2554     my $sth = $dbh->prepare($query);
2555     $sth->execute($invoiceid);
2556 }
2557
2558 1;
2559 __END__
2560
2561 =head1 AUTHOR
2562
2563 Koha Development Team <http://koha-community.org/>
2564
2565 =cut