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 &GetOrdersByBiblionumber
  57         &GetOrderNumber &GetLateOrders &GetOrderFromItemnumber
  58         &SearchOrder &GetHistory &GetRecentAcqui
  59         &ModReceiveOrder &CancelReceipt &ModOrderBiblioitemNumber
  60         &GetCancelledOrders
  61         &GetLastOrderNotReceivedFromSubscriptionid &GetLastOrderReceivedFromSubscriptionid
  62         &NewOrderItem &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, $allbaskets);
 572
 573 The optional second parameter allbaskets is a boolean allowing you to
 574 select all baskets from the supplier; by default only active baskets (open or
 575 closed but still something to receive) are returned.
 576
 577 Returns in a arrayref of hashref all about booksellers baskets, plus:
 578     total_biblios: Number of distinct biblios in basket
 579     total_items: Number of items in basket
 580     expected_items: Number of non-received items in basket
 581
 582 =cut
 583
 584 sub GetBasketsInfosByBookseller {
 585     my ($supplierid, $allbaskets) = @_;
 586
 587     return unless $supplierid;
 588
 589     my $dbh = C4::Context->dbh;
 590     my $query = qq{
 591         SELECT aqbasket.*,
 592           SUM(aqorders.quantity) AS total_items,
 593           COUNT(DISTINCT aqorders.biblionumber) AS total_biblios,
 594           SUM(
 595             IF(aqorders.datereceived IS NULL
 596               AND aqorders.datecancellationprinted IS NULL
 597             , aqorders.quantity
 598             , 0)
 599           ) AS expected_items
 600         FROM aqbasket
 601           LEFT JOIN aqorders ON aqorders.basketno = aqbasket.basketno
 602         WHERE booksellerid = ?};
 603     if(!$allbaskets) {
 604         $query.=" AND (closedate IS NULL OR (aqorders.quantity > aqorders.quantityreceived AND datecancellationprinted IS NULL))";
 605     }
 606     $query.=" GROUP BY aqbasket.basketno";
 607
 608     my $sth = $dbh->prepare($query);
 609     $sth->execute($supplierid);
 610     return $sth->fetchall_arrayref({});
 611 }
 612
 613
 614 #------------------------------------------------------------#
 615
 616 =head3 GetBasketsByBasketgroup
 617
 618   $baskets = &GetBasketsByBasketgroup($basketgroupid);
 619
 620 Returns a reference to all baskets that belong to basketgroup $basketgroupid.
 621
 622 =cut
 623
 624 sub GetBasketsByBasketgroup {
 625     my $basketgroupid = shift;
 626     my $query = qq{
 627         SELECT *, aqbasket.booksellerid as booksellerid
 628         FROM aqbasket
 629         LEFT JOIN aqcontract USING(contractnumber) WHERE basketgroupid=?
 630     };
 631     my $dbh = C4::Context->dbh;
 632     my $sth = $dbh->prepare($query);
 633     $sth->execute($basketgroupid);
 634     my $results = $sth->fetchall_arrayref({});
 635     $sth->finish;
 636     return $results
 637 }
 638
 639 #------------------------------------------------------------#
 640
 641 =head3 NewBasketgroup
 642
 643   $basketgroupid = NewBasketgroup(\%hashref);
 644
 645 Adds a basketgroup to the aqbasketgroups table, and add the initial baskets to it.
 646
 647 $hashref->{'booksellerid'} is the 'id' field of the bookseller in the aqbooksellers table,
 648
 649 $hashref->{'name'} is the 'name' field of the basketgroup in the aqbasketgroups table,
 650
 651 $hashref->{'basketlist'} is a list reference of the 'id's of the baskets that belong to this group,
 652
 653 $hashref->{'billingplace'} is the 'billingplace' field of the basketgroup in the aqbasketgroups table,
 654
 655 $hashref->{'deliveryplace'} is the 'deliveryplace' field of the basketgroup in the aqbasketgroups table,
 656
 657 $hashref->{'freedeliveryplace'} is the 'freedeliveryplace' field of the basketgroup in the aqbasketgroups table,
 658
 659 $hashref->{'deliverycomment'} is the 'deliverycomment' field of the basketgroup in the aqbasketgroups table,
 660
 661 $hashref->{'closed'} is the 'closed' field of the aqbasketgroups table, it is false if 0, true otherwise.
 662
 663 =cut
 664
 665 sub NewBasketgroup {
 666     my $basketgroupinfo = shift;
 667     die "booksellerid is required to create a basketgroup" unless $basketgroupinfo->{'booksellerid'};
 668     my $query = "INSERT INTO aqbasketgroups (";
 669     my @params;
 670     foreach my $field (qw(name billingplace deliveryplace freedeliveryplace deliverycomment closed)) {
 671         if ( defined $basketgroupinfo->{$field} ) {
 672             $query .= "$field, ";
 673             push(@params, $basketgroupinfo->{$field});
 674         }
 675     }
 676     $query .= "booksellerid) VALUES (";
 677     foreach (@params) {
 678         $query .= "?, ";
 679     }
 680     $query .= "?)";
 681     push(@params, $basketgroupinfo->{'booksellerid'});
 682     my $dbh = C4::Context->dbh;
 683     my $sth = $dbh->prepare($query);
 684     $sth->execute(@params);
 685     my $basketgroupid = $dbh->{'mysql_insertid'};
 686     if( $basketgroupinfo->{'basketlist'} ) {
 687         foreach my $basketno (@{$basketgroupinfo->{'basketlist'}}) {
 688             my $query2 = "UPDATE aqbasket SET basketgroupid=? WHERE basketno=?";
 689             my $sth2 = $dbh->prepare($query2);
 690             $sth2->execute($basketgroupid, $basketno);
 691         }
 692     }
 693     return $basketgroupid;
 694 }
 695
 696 #------------------------------------------------------------#
 697
 698 =head3 ModBasketgroup
 699
 700   ModBasketgroup(\%hashref);
 701
 702 Modifies a basketgroup in the aqbasketgroups table, and add the baskets to it.
 703
 704 $hashref->{'id'} is the 'id' field of the basketgroup in the aqbasketgroup table, this parameter is mandatory,
 705
 706 $hashref->{'name'} is the 'name' field of the basketgroup in the aqbasketgroups table,
 707
 708 $hashref->{'basketlist'} is a list reference of the 'id's of the baskets that belong to this group,
 709
 710 $hashref->{'billingplace'} is the 'billingplace' field of the basketgroup in the aqbasketgroups table,
 711
 712 $hashref->{'deliveryplace'} is the 'deliveryplace' field of the basketgroup in the aqbasketgroups table,
 713
 714 $hashref->{'freedeliveryplace'} is the 'freedeliveryplace' field of the basketgroup in the aqbasketgroups table,
 715
 716 $hashref->{'deliverycomment'} is the 'deliverycomment' field of the basketgroup in the aqbasketgroups table,
 717
 718 $hashref->{'closed'} is the 'closed' field of the aqbasketgroups table, it is false if 0, true otherwise.
 719
 720 =cut
 721
 722 sub ModBasketgroup {
 723     my $basketgroupinfo = shift;
 724     die "basketgroup id is required to edit a basketgroup" unless $basketgroupinfo->{'id'};
 725     my $dbh = C4::Context->dbh;
 726     my $query = "UPDATE aqbasketgroups SET ";
 727     my @params;
 728     foreach my $field (qw(name billingplace deliveryplace freedeliveryplace deliverycomment closed)) {
 729         if ( defined $basketgroupinfo->{$field} ) {
 730             $query .= "$field=?, ";
 731             push(@params, $basketgroupinfo->{$field});
 732         }
 733     }
 734     chop($query);
 735     chop($query);
 736     $query .= " WHERE id=?";
 737     push(@params, $basketgroupinfo->{'id'});
 738     my $sth = $dbh->prepare($query);
 739     $sth->execute(@params);
 740
 741     $sth = $dbh->prepare('UPDATE aqbasket SET basketgroupid = NULL WHERE basketgroupid = ?');
 742     $sth->execute($basketgroupinfo->{'id'});
 743
 744     if($basketgroupinfo->{'basketlist'} && @{$basketgroupinfo->{'basketlist'}}){
 745         $sth = $dbh->prepare("UPDATE aqbasket SET basketgroupid=? WHERE basketno=?");
 746         foreach my $basketno (@{$basketgroupinfo->{'basketlist'}}) {
 747             $sth->execute($basketgroupinfo->{'id'}, $basketno);
 748             $sth->finish;
 749         }
 750     }
 751     $sth->finish;
 752 }
 753
 754 #------------------------------------------------------------#
 755
 756 =head3 DelBasketgroup
 757
 758   DelBasketgroup($basketgroupid);
 759
 760 Deletes a basketgroup in the aqbasketgroups table, and removes the reference to it from the baskets,
 761
 762 =over
 763
 764 =item C<$basketgroupid> is the 'id' field of the basket in the aqbasketgroup table
 765
 766 =back
 767
 768 =cut
 769
 770 sub DelBasketgroup {
 771     my $basketgroupid = shift;
 772     die "basketgroup id is required to edit a basketgroup" unless $basketgroupid;
 773     my $query = "DELETE FROM aqbasketgroups WHERE id=?";
 774     my $dbh = C4::Context->dbh;
 775     my $sth = $dbh->prepare($query);
 776     $sth->execute($basketgroupid);
 777     $sth->finish;
 778 }
 779
 780 #------------------------------------------------------------#
 781
 782
 783 =head2 FUNCTIONS ABOUT ORDERS
 784
 785 =head3 GetBasketgroup
 786
 787   $basketgroup = &GetBasketgroup($basketgroupid);
 788
 789 Returns a reference to the hash containing all information about the basketgroup.
 790
 791 =cut
 792
 793 sub GetBasketgroup {
 794     my $basketgroupid = shift;
 795     die "basketgroup id is required to edit a basketgroup" unless $basketgroupid;
 796     my $query = "SELECT * FROM aqbasketgroups WHERE id=?";
 797     my $dbh = C4::Context->dbh;
 798     my $sth = $dbh->prepare($query);
 799     $sth->execute($basketgroupid);
 800     my $result = $sth->fetchrow_hashref;
 801     $sth->finish;
 802     return $result
 803 }
 804
 805 #------------------------------------------------------------#
 806
 807 =head3 GetBasketgroups
 808
 809   $basketgroups = &GetBasketgroups($booksellerid);
 810
 811 Returns a reference to the array of all the basketgroups of bookseller $booksellerid.
 812
 813 =cut
 814
 815 sub GetBasketgroups {
 816     my $booksellerid = shift;
 817     die 'bookseller id is required to edit a basketgroup' unless $booksellerid;
 818     my $query = 'SELECT * FROM aqbasketgroups WHERE booksellerid=? ORDER BY id DESC';
 819     my $dbh = C4::Context->dbh;
 820     my $sth = $dbh->prepare($query);
 821     $sth->execute($booksellerid);
 822     return $sth->fetchall_arrayref({});
 823 }
 824
 825 #------------------------------------------------------------#
 826
 827 =head2 FUNCTIONS ABOUT ORDERS
 828
 829 =cut
 830
 831 #------------------------------------------------------------#
 832
 833 =head3 GetPendingOrders
 834
 835 $orders = &GetPendingOrders($supplierid,$grouped,$owner,$basketno,$ordernumber,$search,$ean);
 836
 837 Finds pending orders from the bookseller with the given ID. Ignores
 838 completed and cancelled orders.
 839
 840 C<$booksellerid> contains the bookseller identifier
 841 C<$owner> contains 0 or 1. 0 means any owner. 1 means only the list of orders entered by the user itself.
 842 C<$grouped> is a boolean that, if set to 1 will group all order lines of the same basket
 843 in a single result line
 844 C<$orders> is a reference-to-array; each element is a reference-to-hash.
 845
 846 Used also by the filter in parcel.pl
 847 I have added:
 848
 849 C<$ordernumber>
 850 C<$search>
 851 C<$ean>
 852
 853 These give the value of the corresponding field in the aqorders table
 854 of the Koha database.
 855
 856 Results are ordered from most to least recent.
 857
 858 =cut
 859
 860 sub GetPendingOrders {
 861     my ($supplierid,$grouped,$owner,$basketno,$ordernumber,$search,$ean) = @_;
 862     my $dbh = C4::Context->dbh;
 863     my $strsth = "
 864         SELECT ".($grouped?"count(*),":"")."aqbasket.basketno,
 865                surname,firstname,biblio.*,biblioitems.isbn,
 866                aqbasket.closedate, aqbasket.creationdate, aqbasket.basketname,
 867                aqorders.*
 868         FROM aqorders
 869         LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
 870         LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
 871         LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber
 872         LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
 873         WHERE (quantity > quantityreceived OR quantityreceived is NULL)
 874         AND datecancellationprinted IS NULL";
 875     my @query_params;
 876     my $userenv = C4::Context->userenv;
 877     if ( C4::Context->preference("IndependantBranches") ) {
 878         if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
 879             $strsth .= " AND (borrowers.branchcode = ?
 880                         or borrowers.branchcode  = '')";
 881             push @query_params, $userenv->{branch};
 882         }
 883     }
 884     if ($supplierid) {
 885         $strsth .= " AND aqbasket.booksellerid = ?";
 886         push @query_params, $supplierid;
 887     }
 888     if($ordernumber){
 889         $strsth .= " AND (aqorders.ordernumber=?)";
 890         push @query_params, $ordernumber;
 891     }
 892     if($search){
 893         $strsth .= " AND (biblio.title like ? OR biblio.author LIKE ? OR biblioitems.isbn like ?)";
 894         push @query_params, ("%$search%","%$search%","%$search%");
 895     }
 896     if ($ean) {
 897         $strsth .= " AND biblioitems.ean = ?";
 898         push @query_params, $ean;
 899     }
 900     if ($basketno) {
 901         $strsth .= " AND aqbasket.basketno=? ";
 902         push @query_params, $basketno;
 903     }
 904     if ($owner) {
 905         $strsth .= " AND aqbasket.authorisedby=? ";
 906         push @query_params, $userenv->{'number'};
 907     }
 908     $strsth .= " group by aqbasket.basketno" if $grouped;
 909     $strsth .= " order by aqbasket.basketno";
 910     my $sth = $dbh->prepare($strsth);
 911     $sth->execute( @query_params );
 912     my $results = $sth->fetchall_arrayref({});
 913     $sth->finish;
 914     return $results;
 915 }
 916
 917 #------------------------------------------------------------#
 918
 919 =head3 GetOrders
 920
 921   @orders = &GetOrders($basketnumber, $orderby);
 922
 923 Looks up the pending (non-cancelled) orders with the given basket
 924 number. If C<$booksellerID> is non-empty, only orders from that seller
 925 are returned.
 926
 927 return :
 928 C<&basket> returns a two-element array. C<@orders> is an array of
 929 references-to-hash, whose keys are the fields from the aqorders,
 930 biblio, and biblioitems tables in the Koha database.
 931
 932 =cut
 933
 934 sub GetOrders {
 935     my ( $basketno, $orderby ) = @_;
 936     my $dbh   = C4::Context->dbh;
 937     my $query  ="
 938         SELECT biblio.*,biblioitems.*,
 939                 aqorders.*,
 940                 aqbudgets.*
 941         FROM    aqorders
 942             LEFT JOIN aqbudgets        ON aqbudgets.budget_id = aqorders.budget_id
 943             LEFT JOIN biblio           ON biblio.biblionumber = aqorders.biblionumber
 944             LEFT JOIN biblioitems      ON biblioitems.biblionumber =biblio.biblionumber
 945         WHERE   basketno=?
 946             AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00')
 947     ";
 948
 949     $orderby = "biblioitems.publishercode,biblio.title" unless $orderby;
 950     $query .= " ORDER BY $orderby";
 951     my $sth = $dbh->prepare($query);
 952     $sth->execute($basketno);
 953     my $results = $sth->fetchall_arrayref({});
 954     $sth->finish;
 955     return @$results;
 956 }
 957
 958 #------------------------------------------------------------#
 959 =head3 GetOrdersByBiblionumber
 960
 961   @orders = &GetOrdersByBiblionumber($biblionumber);
 962
 963 Looks up the orders with linked to a specific $biblionumber, including
 964 cancelled orders and received orders.
 965
 966 return :
 967 C<@orders> is an array of references-to-hash, whose keys are the
 968 fields from the aqorders, biblio, and biblioitems tables in the Koha database.
 969
 970 =cut
 971
 972 sub GetOrdersByBiblionumber {
 973     my $biblionumber = shift;
 974     return unless $biblionumber;
 975     my $dbh   = C4::Context->dbh;
 976     my $query  ="
 977         SELECT biblio.*,biblioitems.*,
 978                 aqorders.*,
 979                 aqbudgets.*
 980         FROM    aqorders
 981             LEFT JOIN aqbudgets        ON aqbudgets.budget_id = aqorders.budget_id
 982             LEFT JOIN biblio           ON biblio.biblionumber = aqorders.biblionumber
 983             LEFT JOIN biblioitems      ON biblioitems.biblionumber =biblio.biblionumber
 984         WHERE   aqorders.biblionumber=?
 985     ";
 986     my $sth = $dbh->prepare($query);
 987     $sth->execute($biblionumber);
 988     my $results = $sth->fetchall_arrayref({});
 989     $sth->finish;
 990     return @$results;
 991 }
 992
 993 #------------------------------------------------------------#
 994
 995 =head3 GetOrderNumber
 996
 997   $ordernumber = &GetOrderNumber($biblioitemnumber, $biblionumber);
 998
 999 Looks up the ordernumber with the given biblionumber and biblioitemnumber.
1000
1001 Returns the number of this order.
1002
1003 =over
1004
1005 =item C<$ordernumber> is the order number.
1006
1007 =back
1008
1009 =cut
1010
1011 sub GetOrderNumber {
1012     my ( $biblionumber,$biblioitemnumber ) = @_;
1013     my $dbh = C4::Context->dbh;
1014     my $query = "
1015         SELECT ordernumber
1016         FROM   aqorders
1017         WHERE  biblionumber=?
1018         AND    biblioitemnumber=?
1019     ";
1020     my $sth = $dbh->prepare($query);
1021     $sth->execute( $biblionumber, $biblioitemnumber );
1022
1023     return $sth->fetchrow;
1024 }
1025
1026 #------------------------------------------------------------#
1027
1028 =head3 GetOrder
1029
1030   $order = &GetOrder($ordernumber);
1031
1032 Looks up an order by order number.
1033
1034 Returns a reference-to-hash describing the order. The keys of
1035 C<$order> are fields from the biblio, biblioitems, aqorders tables of the Koha database.
1036
1037 =cut
1038
1039 sub GetOrder {
1040     my ($ordernumber) = @_;
1041     my $dbh      = C4::Context->dbh;
1042     my $query = "
1043         SELECT biblioitems.*, biblio.*, aqorders.*
1044         FROM   aqorders
1045         LEFT JOIN biblio on           biblio.biblionumber=aqorders.biblionumber
1046         LEFT JOIN biblioitems on       biblioitems.biblionumber=aqorders.biblionumber
1047         WHERE aqorders.ordernumber=?
1048
1049     ";
1050     my $sth= $dbh->prepare($query);
1051     $sth->execute($ordernumber);
1052     my $data = $sth->fetchrow_hashref;
1053     $sth->finish;
1054     return $data;
1055 }
1056
1057 =head3 GetLastOrderNotReceivedFromSubscriptionid
1058
1059   $order = &GetLastOrderNotReceivedFromSubscriptionid($subscriptionid);
1060
1061 Returns a reference-to-hash describing the last order not received for a subscription.
1062
1063 =cut
1064
1065 sub GetLastOrderNotReceivedFromSubscriptionid {
1066     my ( $subscriptionid ) = @_;
1067     my $dbh                = C4::Context->dbh;
1068     my $query              = qq|
1069         SELECT * FROM aqorders
1070         LEFT JOIN subscription
1071             ON ( aqorders.subscriptionid = subscription.subscriptionid )
1072         WHERE aqorders.subscriptionid = ?
1073             AND aqorders.datereceived IS NULL
1074         LIMIT 1
1075     |;
1076     my $sth = $dbh->prepare( $query );
1077     $sth->execute( $subscriptionid );
1078     my $order = $sth->fetchrow_hashref;
1079     return $order;
1080 }
1081
1082 =head3 GetLastOrderReceivedFromSubscriptionid
1083
1084   $order = &GetLastOrderReceivedFromSubscriptionid($subscriptionid);
1085
1086 Returns a reference-to-hash describing the last order received for a subscription.
1087
1088 =cut
1089
1090 sub GetLastOrderReceivedFromSubscriptionid {
1091     my ( $subscriptionid ) = @_;
1092     my $dbh                = C4::Context->dbh;
1093     my $query              = qq|
1094         SELECT * FROM aqorders
1095         LEFT JOIN subscription
1096             ON ( aqorders.subscriptionid = subscription.subscriptionid )
1097         WHERE aqorders.subscriptionid = ?
1098             AND aqorders.datereceived =
1099                 (
1100                     SELECT MAX( aqorders.datereceived )
1101                     FROM aqorders
1102                     LEFT JOIN subscription
1103                         ON ( aqorders.subscriptionid = subscription.subscriptionid )
1104                         WHERE aqorders.subscriptionid = ?
1105                             AND aqorders.datereceived IS NOT NULL
1106                 )
1107         ORDER BY ordernumber DESC
1108         LIMIT 1
1109     |;
1110     my $sth = $dbh->prepare( $query );
1111     $sth->execute( $subscriptionid, $subscriptionid );
1112     my $order = $sth->fetchrow_hashref;
1113     return $order;
1114
1115 }
1116
1117
1118 #------------------------------------------------------------#
1119
1120 =head3 NewOrder
1121
1122   &NewOrder(\%hashref);
1123
1124 Adds a new order to the database. Any argument that isn't described
1125 below is the new value of the field with the same name in the aqorders
1126 table of the Koha database.
1127
1128 =over
1129
1130 =item $hashref->{'basketno'} is the basketno foreign key in aqorders, it is mandatory
1131
1132 =item $hashref->{'ordernumber'} is a "minimum order number."
1133
1134 =item $hashref->{'budgetdate'} is effectively ignored.
1135 If it's undef (anything false) or the string 'now', the current day is used.
1136 Else, the upcoming July 1st is used.
1137
1138 =item $hashref->{'subscription'} may be either "yes", or anything else for "no".
1139
1140 =item $hashref->{'uncertainprice'} may be 0 for "the price is known" or 1 for "the price is uncertain"
1141
1142 =item defaults entrydate to Now
1143
1144 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".
1145
1146 =back
1147
1148 =cut
1149
1150 sub NewOrder {
1151     my $orderinfo = shift;
1152 #### ------------------------------
1153     my $dbh = C4::Context->dbh;
1154     my @params;
1155
1156
1157     # if these parameters are missing, we can't continue
1158     for my $key (qw/basketno quantity biblionumber budget_id/) {
1159         croak "Mandatory parameter $key missing" unless $orderinfo->{$key};
1160     }
1161
1162     if ( defined $orderinfo->{subscription} && $orderinfo->{'subscription'} eq 'yes' ) {
1163         $orderinfo->{'subscription'} = 1;
1164     } else {
1165         $orderinfo->{'subscription'} = 0;
1166     }
1167     $orderinfo->{'entrydate'} ||= C4::Dates->new()->output("iso");
1168     if (!$orderinfo->{quantityreceived}) {
1169         $orderinfo->{quantityreceived} = 0;
1170     }
1171
1172     my $ordernumber=InsertInTable("aqorders",$orderinfo);
1173     if (not $orderinfo->{parent_ordernumber}) {
1174         my $sth = $dbh->prepare("
1175             UPDATE aqorders
1176             SET parent_ordernumber = ordernumber
1177             WHERE ordernumber = ?
1178         ");
1179         $sth->execute($ordernumber);
1180     }
1181     return ( $orderinfo->{'basketno'}, $ordernumber );
1182 }
1183
1184
1185
1186 #------------------------------------------------------------#
1187
1188 =head3 NewOrderItem
1189
1190   &NewOrderItem();
1191
1192 =cut
1193
1194 sub NewOrderItem {
1195     my ($itemnumber, $ordernumber)  = @_;
1196     my $dbh = C4::Context->dbh;
1197     my $query = qq|
1198             INSERT INTO aqorders_items
1199                 (itemnumber, ordernumber)
1200             VALUES (?,?)    |;
1201
1202     my $sth = $dbh->prepare($query);
1203     $sth->execute( $itemnumber, $ordernumber);
1204 }
1205
1206 #------------------------------------------------------------#
1207
1208 =head3 ModOrder
1209
1210   &ModOrder(\%hashref);
1211
1212 Modifies an existing order. Updates the order with order number
1213 $hashref->{'ordernumber'} and biblionumber $hashref->{'biblionumber'}. All
1214 other keys of the hash update the fields with the same name in the aqorders
1215 table of the Koha database.
1216
1217 =cut
1218
1219 sub ModOrder {
1220     my $orderinfo = shift;
1221
1222     die "Ordernumber is required"     if $orderinfo->{'ordernumber'} eq  '' ;
1223     die "Biblionumber is required"  if  $orderinfo->{'biblionumber'} eq '';
1224
1225     my $dbh = C4::Context->dbh;
1226     my @params;
1227
1228     # update uncertainprice to an integer, just in case (under FF, checked boxes have the value "ON" by default)
1229     $orderinfo->{uncertainprice}=1 if $orderinfo->{uncertainprice};
1230
1231 #    delete($orderinfo->{'branchcode'});
1232     # the hash contains a lot of entries not in aqorders, so get the columns ...
1233     my $sth = $dbh->prepare("SELECT * FROM aqorders LIMIT 1;");
1234     $sth->execute;
1235     my $colnames = $sth->{NAME};
1236         #FIXME Be careful. If aqorders would have columns with diacritics,
1237         #you should need to decode what you get back from NAME.
1238         #See report 10110 and guided_reports.pl
1239     my $query = "UPDATE aqorders SET ";
1240
1241     foreach my $orderinfokey (grep(!/ordernumber/, keys %$orderinfo)){
1242         # ... and skip hash entries that are not in the aqorders table
1243         # FIXME : probably not the best way to do it (would be better to have a correct hash)
1244         next unless grep(/^$orderinfokey$/, @$colnames);
1245             $query .= "$orderinfokey=?, ";
1246             push(@params, $orderinfo->{$orderinfokey});
1247     }
1248
1249     $query .= "timestamp=NOW()  WHERE  ordernumber=?";
1250 #   push(@params, $specorderinfo{'ordernumber'});
1251     push(@params, $orderinfo->{'ordernumber'} );
1252     $sth = $dbh->prepare($query);
1253     $sth->execute(@params);
1254     $sth->finish;
1255 }
1256
1257 #------------------------------------------------------------#
1258
1259 =head3 ModItemOrder
1260
1261     ModItemOrder($itemnumber, $ordernumber);
1262
1263 Modifies the ordernumber of an item in aqorders_items.
1264
1265 =cut
1266
1267 sub ModItemOrder {
1268     my ($itemnumber, $ordernumber) = @_;
1269
1270     return unless ($itemnumber and $ordernumber);
1271
1272     my $dbh = C4::Context->dbh;
1273     my $query = qq{
1274         UPDATE aqorders_items
1275         SET ordernumber = ?
1276         WHERE itemnumber = ?
1277     };
1278     my $sth = $dbh->prepare($query);
1279     return $sth->execute($ordernumber, $itemnumber);
1280 }
1281
1282 #------------------------------------------------------------#
1283
1284
1285 =head3 ModOrderBibliotemNumber
1286
1287   &ModOrderBiblioitemNumber($biblioitemnumber,$ordernumber, $biblionumber);
1288
1289 Modifies the biblioitemnumber for an existing order.
1290 Updates the order with order number C<$ordernum> and biblionumber C<$biblionumber>.
1291
1292 =cut
1293
1294 #FIXME: is this used at all?
1295 sub ModOrderBiblioitemNumber {
1296     my ($biblioitemnumber,$ordernumber, $biblionumber) = @_;
1297     my $dbh = C4::Context->dbh;
1298     my $query = "
1299     UPDATE aqorders
1300     SET    biblioitemnumber = ?
1301     WHERE  ordernumber = ?
1302     AND biblionumber =  ?";
1303     my $sth = $dbh->prepare($query);
1304     $sth->execute( $biblioitemnumber, $ordernumber, $biblionumber );
1305 }
1306
1307 =head3 GetCancelledOrders
1308
1309   my @orders = GetCancelledOrders($basketno, $orderby);
1310
1311 Returns cancelled orders for a basket
1312
1313 =cut
1314
1315 sub GetCancelledOrders {
1316     my ( $basketno, $orderby ) = @_;
1317
1318     return () unless $basketno;
1319
1320     my $dbh   = C4::Context->dbh;
1321     my $query = "
1322         SELECT biblio.*, biblioitems.*, aqorders.*, aqbudgets.*
1323         FROM aqorders
1324           LEFT JOIN aqbudgets   ON aqbudgets.budget_id = aqorders.budget_id
1325           LEFT JOIN biblio      ON biblio.biblionumber = aqorders.biblionumber
1326           LEFT JOIN biblioitems ON biblioitems.biblionumber = biblio.biblionumber
1327         WHERE basketno = ?
1328           AND (datecancellationprinted IS NOT NULL
1329                AND datecancellationprinted <> '0000-00-00')
1330     ";
1331
1332     $orderby = "aqorders.datecancellationprinted desc, aqorders.timestamp desc"
1333         unless $orderby;
1334     $query .= " ORDER BY $orderby";
1335     my $sth = $dbh->prepare($query);
1336     $sth->execute($basketno);
1337     my $results = $sth->fetchall_arrayref( {} );
1338
1339     return @$results;
1340 }
1341
1342
1343 #------------------------------------------------------------#
1344
1345 =head3 ModReceiveOrder
1346
1347   &ModReceiveOrder($biblionumber, $ordernumber, $quantityreceived, $user,
1348     $unitprice, $invoiceid, $biblioitemnumber,
1349     $bookfund, $rrp, \@received_itemnumbers);
1350
1351 Updates an order, to reflect the fact that it was received, at least
1352 in part. All arguments not mentioned below update the fields with the
1353 same name in the aqorders table of the Koha database.
1354
1355 If a partial order is received, splits the order into two.
1356
1357 Updates the order with bibilionumber C<$biblionumber> and ordernumber
1358 C<$ordernumber>.
1359
1360 =cut
1361
1362
1363 sub ModReceiveOrder {
1364     my (
1365         $biblionumber,    $ordernumber,  $quantrec, $user, $cost, $ecost,
1366         $invoiceid, $rrp, $budget_id, $datereceived, $received_items
1367     )
1368     = @_;
1369
1370     my $dbh = C4::Context->dbh;
1371     $datereceived = C4::Dates->output('iso') unless $datereceived;
1372     my $suggestionid = GetSuggestionFromBiblionumber( $biblionumber );
1373     if ($suggestionid) {
1374         ModSuggestion( {suggestionid=>$suggestionid,
1375                         STATUS=>'AVAILABLE',
1376                         biblionumber=> $biblionumber}
1377                         );
1378     }
1379
1380     my $sth=$dbh->prepare("
1381         SELECT * FROM   aqorders
1382         WHERE           biblionumber=? AND aqorders.ordernumber=?");
1383
1384     $sth->execute($biblionumber,$ordernumber);
1385     my $order = $sth->fetchrow_hashref();
1386     $sth->finish();
1387
1388     my $new_ordernumber = $ordernumber;
1389     if ( $order->{quantity} > $quantrec ) {
1390         # Split order line in two parts: the first is the original order line
1391         # without received items (the quantity is decreased),
1392         # the second part is a new order line with quantity=quantityrec
1393         # (entirely received)
1394         $sth=$dbh->prepare("
1395             UPDATE aqorders
1396             SET quantity = ?
1397             WHERE ordernumber = ?
1398         ");
1399
1400         $sth->execute($order->{quantity} - $quantrec, $ordernumber);
1401
1402         $sth->finish;
1403
1404         delete $order->{'ordernumber'};
1405         $order->{'quantity'} = $quantrec;
1406         $order->{'quantityreceived'} = $quantrec;
1407         $order->{'datereceived'} = $datereceived;
1408         $order->{'invoiceid'} = $invoiceid;
1409         $order->{'unitprice'} = $cost;
1410         $order->{'rrp'} = $rrp;
1411         $order->{ecost} = $ecost;
1412         $order->{'orderstatus'} = 3;    # totally received
1413         my $basketno;
1414         ( $basketno, $new_ordernumber ) = NewOrder($order);
1415
1416         if ($received_items) {
1417             foreach my $itemnumber (@$received_items) {
1418                 ModItemOrder($itemnumber, $new_ordernumber);
1419             }
1420         }
1421     } else {
1422         $sth=$dbh->prepare("update aqorders
1423                             set quantityreceived=?,datereceived=?,invoiceid=?,
1424                                 unitprice=?,rrp=?,ecost=?
1425                             where biblionumber=? and ordernumber=?");
1426         $sth->execute($quantrec,$datereceived,$invoiceid,$cost,$rrp,$ecost,$biblionumber,$ordernumber);
1427         $sth->finish;
1428     }
1429     return ($datereceived, $new_ordernumber);
1430 }
1431
1432 =head3 CancelReceipt
1433
1434     my $parent_ordernumber = CancelReceipt($ordernumber);
1435
1436     Cancel an order line receipt and update the parent order line, as if no
1437     receipt was made.
1438     If items are created at receipt (AcqCreateItem = receiving) then delete
1439     these items.
1440
1441 =cut
1442
1443 sub CancelReceipt {
1444     my $ordernumber = shift;
1445
1446     return unless $ordernumber;
1447
1448     my $dbh = C4::Context->dbh;
1449     my $query = qq{
1450         SELECT datereceived, parent_ordernumber, quantity
1451         FROM aqorders
1452         WHERE ordernumber = ?
1453     };
1454     my $sth = $dbh->prepare($query);
1455     $sth->execute($ordernumber);
1456     my $order = $sth->fetchrow_hashref;
1457     unless($order) {
1458         warn "CancelReceipt: order $ordernumber does not exist";
1459         return;
1460     }
1461     unless($order->{'datereceived'}) {
1462         warn "CancelReceipt: order $ordernumber is not received";
1463         return;
1464     }
1465
1466     my $parent_ordernumber = $order->{'parent_ordernumber'};
1467
1468     if($parent_ordernumber == $ordernumber || not $parent_ordernumber) {
1469         # The order line has no parent, just mark it as not received
1470         $query = qq{
1471             UPDATE aqorders
1472             SET quantityreceived = ?,
1473                 datereceived = ?,
1474                 invoiceid = ?
1475             WHERE ordernumber = ?
1476         };
1477         $sth = $dbh->prepare($query);
1478         $sth->execute(0, undef, undef, $ordernumber);
1479     } else {
1480         # The order line has a parent, increase parent quantity and delete
1481         # the order line.
1482         $query = qq{
1483             SELECT quantity, datereceived
1484             FROM aqorders
1485             WHERE ordernumber = ?
1486         };
1487         $sth = $dbh->prepare($query);
1488         $sth->execute($parent_ordernumber);
1489         my $parent_order = $sth->fetchrow_hashref;
1490         unless($parent_order) {
1491             warn "Parent order $parent_ordernumber does not exist.";
1492             return;
1493         }
1494         if($parent_order->{'datereceived'}) {
1495             warn "CancelReceipt: parent order is received.".
1496                 " Can't cancel receipt.";
1497             return;
1498         }
1499         $query = qq{
1500             UPDATE aqorders
1501             SET quantity = ?
1502             WHERE ordernumber = ?
1503         };
1504         $sth = $dbh->prepare($query);
1505         my $rv = $sth->execute(
1506             $order->{'quantity'} + $parent_order->{'quantity'},
1507             $parent_ordernumber
1508         );
1509         unless($rv) {
1510             warn "Cannot update parent order line, so do not cancel".
1511                 " receipt";
1512             return;
1513         }
1514         if(C4::Context->preference('AcqCreateItem') eq 'receiving') {
1515             # Remove items that were created at receipt
1516             $query = qq{
1517                 DELETE FROM items, aqorders_items
1518                 USING items, aqorders_items
1519                 WHERE items.itemnumber = ? AND aqorders_items.itemnumber = ?
1520             };
1521             $sth = $dbh->prepare($query);
1522             my @itemnumbers = GetItemnumbersFromOrder($ordernumber);
1523             foreach my $itemnumber (@itemnumbers) {
1524                 $sth->execute($itemnumber, $itemnumber);
1525             }
1526         } else {
1527             # Update items
1528             my @itemnumbers = GetItemnumbersFromOrder($ordernumber);
1529             foreach my $itemnumber (@itemnumbers) {
1530                 ModItemOrder($itemnumber, $parent_ordernumber);
1531             }
1532         }
1533         # Delete order line
1534         $query = qq{
1535             DELETE FROM aqorders
1536             WHERE ordernumber = ?
1537         };
1538         $sth = $dbh->prepare($query);
1539         $sth->execute($ordernumber);
1540
1541     }
1542
1543     return $parent_ordernumber;
1544 }
1545
1546 #------------------------------------------------------------#
1547
1548 =head3 SearchOrder
1549
1550 @results = &SearchOrder($search, $biblionumber, $complete);
1551
1552 Searches for orders.
1553
1554 C<$search> may take one of several forms: if it is an ISBN,
1555 C<&ordersearch> returns orders with that ISBN. If C<$search> is an
1556 order number, C<&ordersearch> returns orders with that order number
1557 and biblionumber C<$biblionumber>. Otherwise, C<$search> is considered
1558 to be a space-separated list of search terms; in this case, all of the
1559 terms must appear in the title (matching the beginning of title
1560 words).
1561
1562 If C<$complete> is C<yes>, the results will include only completed
1563 orders. In any case, C<&ordersearch> ignores cancelled orders.
1564
1565 C<&ordersearch> returns an array.
1566 C<@results> is an array of references-to-hash with the following keys:
1567
1568 =over 4
1569
1570 =item C<author>
1571
1572 =item C<seriestitle>
1573
1574 =item C<branchcode>
1575
1576 =item C<budget_id>
1577
1578 =back
1579
1580 =cut
1581
1582 sub SearchOrder {
1583 #### -------- SearchOrder-------------------------------
1584     my ( $ordernumber, $search, $ean, $supplierid, $basket ) = @_;
1585
1586     my $dbh = C4::Context->dbh;
1587     my @args = ();
1588     my $query =
1589             "SELECT *
1590             FROM aqorders
1591             LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1592             LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
1593             LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
1594                 WHERE  (datecancellationprinted is NULL)";
1595
1596     if($ordernumber){
1597         $query .= " AND (aqorders.ordernumber=?)";
1598         push @args, $ordernumber;
1599     }
1600     if($search){
1601         $query .= " AND (biblio.title like ? OR biblio.author LIKE ? OR biblioitems.isbn like ?)";
1602         push @args, ("%$search%","%$search%","%$search%");
1603     }
1604     if ($ean) {
1605         $query .= " AND biblioitems.ean = ?";
1606         push @args, $ean;
1607     }
1608     if ($supplierid) {
1609         $query .= "AND aqbasket.booksellerid = ?";
1610         push @args, $supplierid;
1611     }
1612     if($basket){
1613         $query .= "AND aqorders.basketno = ?";
1614         push @args, $basket;
1615     }
1616
1617     my $sth = $dbh->prepare($query);
1618     $sth->execute(@args);
1619     my $results = $sth->fetchall_arrayref({});
1620     $sth->finish;
1621     return $results;
1622 }
1623
1624 #------------------------------------------------------------#
1625
1626 =head3 DelOrder
1627
1628   &DelOrder($biblionumber, $ordernumber);
1629
1630 Cancel the order with the given order and biblio numbers. It does not
1631 delete any entries in the aqorders table, it merely marks them as
1632 cancelled.
1633
1634 =cut
1635
1636 sub DelOrder {
1637     my ( $bibnum, $ordernumber ) = @_;
1638     my $dbh = C4::Context->dbh;
1639     my $query = "
1640         UPDATE aqorders
1641         SET    datecancellationprinted=now()
1642         WHERE  biblionumber=? AND ordernumber=?
1643     ";
1644     my $sth = $dbh->prepare($query);
1645     $sth->execute( $bibnum, $ordernumber );
1646     $sth->finish;
1647     my @itemnumbers = GetItemnumbersFromOrder( $ordernumber );
1648     foreach my $itemnumber (@itemnumbers){
1649         C4::Items::DelItem( $dbh, $bibnum, $itemnumber );
1650     }
1651
1652 }
1653
1654 =head2 FUNCTIONS ABOUT PARCELS
1655
1656 =cut
1657
1658 #------------------------------------------------------------#
1659
1660 =head3 GetParcel
1661
1662   @results = &GetParcel($booksellerid, $code, $date);
1663
1664 Looks up all of the received items from the supplier with the given
1665 bookseller ID at the given date, for the given code (bookseller Invoice number). Ignores cancelled and completed orders.
1666
1667 C<@results> is an array of references-to-hash. The keys of each element are fields from
1668 the aqorders, biblio, and biblioitems tables of the Koha database.
1669
1670 C<@results> is sorted alphabetically by book title.
1671
1672 =cut
1673
1674 sub GetParcel {
1675     #gets all orders from a certain supplier, orders them alphabetically
1676     my ( $supplierid, $code, $datereceived ) = @_;
1677     my $dbh     = C4::Context->dbh;
1678     my @results = ();
1679     $code .= '%'
1680     if $code;  # add % if we search on a given code (otherwise, let him empty)
1681     my $strsth ="
1682         SELECT  authorisedby,
1683                 creationdate,
1684                 aqbasket.basketno,
1685                 closedate,surname,
1686                 firstname,
1687                 aqorders.biblionumber,
1688                 aqorders.ordernumber,
1689                 aqorders.parent_ordernumber,
1690                 aqorders.quantity,
1691                 aqorders.quantityreceived,
1692                 aqorders.unitprice,
1693                 aqorders.listprice,
1694                 aqorders.rrp,
1695                 aqorders.ecost,
1696                 aqorders.gstrate,
1697                 biblio.title
1698         FROM aqorders
1699         LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
1700         LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
1701         LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1702         LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid
1703         WHERE
1704             aqbasket.booksellerid = ?
1705             AND aqinvoices.invoicenumber LIKE ?
1706             AND aqorders.datereceived = ? ";
1707
1708     my @query_params = ( $supplierid, $code, $datereceived );
1709     if ( C4::Context->preference("IndependantBranches") ) {
1710         my $userenv = C4::Context->userenv;
1711         if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
1712             $strsth .= " and (borrowers.branchcode = ?
1713                         or borrowers.branchcode  = '')";
1714             push @query_params, $userenv->{branch};
1715         }
1716     }
1717     $strsth .= " ORDER BY aqbasket.basketno";
1718     # ## parcelinformation : $strsth
1719     my $sth = $dbh->prepare($strsth);
1720     $sth->execute( @query_params );
1721     while ( my $data = $sth->fetchrow_hashref ) {
1722         push( @results, $data );
1723     }
1724     # ## countparcelbiblio: scalar(@results)
1725     $sth->finish;
1726
1727     return @results;
1728 }
1729
1730 #------------------------------------------------------------#
1731
1732 =head3 GetParcels
1733
1734   $results = &GetParcels($bookseller, $order, $code, $datefrom, $dateto);
1735
1736 get a lists of parcels.
1737
1738 * Input arg :
1739
1740 =over
1741
1742 =item $bookseller
1743 is the bookseller this function has to get parcels.
1744
1745 =item $order
1746 To know on what criteria the results list has to be ordered.
1747
1748 =item $code
1749 is the booksellerinvoicenumber.
1750
1751 =item $datefrom & $dateto
1752 to know on what date this function has to filter its search.
1753
1754 =back
1755
1756 * return:
1757 a pointer on a hash list containing parcel informations as such :
1758
1759 =over
1760
1761 =item Creation date
1762
1763 =item Last operation
1764
1765 =item Number of biblio
1766
1767 =item Number of items
1768
1769 =back
1770
1771 =cut
1772
1773 sub GetParcels {
1774     my ($bookseller,$order, $code, $datefrom, $dateto) = @_;
1775     my $dbh    = C4::Context->dbh;
1776     my @query_params = ();
1777     my $strsth ="
1778         SELECT  aqinvoices.invoicenumber,
1779                 datereceived,purchaseordernumber,
1780                 count(DISTINCT biblionumber) AS biblio,
1781                 sum(quantity) AS itemsexpected,
1782                 sum(quantityreceived) AS itemsreceived
1783         FROM   aqorders LEFT JOIN aqbasket ON aqbasket.basketno = aqorders.basketno
1784         LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid
1785         WHERE aqbasket.booksellerid = ? and datereceived IS NOT NULL
1786     ";
1787     push @query_params, $bookseller;
1788
1789     if ( defined $code ) {
1790         $strsth .= ' and aqinvoices.invoicenumber like ? ';
1791         # add a % to the end of the code to allow stemming.
1792         push @query_params, "$code%";
1793     }
1794
1795     if ( defined $datefrom ) {
1796         $strsth .= ' and datereceived >= ? ';
1797         push @query_params, $datefrom;
1798     }
1799
1800     if ( defined $dateto ) {
1801         $strsth .=  'and datereceived <= ? ';
1802         push @query_params, $dateto;
1803     }
1804
1805     $strsth .= "group by aqinvoices.invoicenumber,datereceived ";
1806
1807     # can't use a placeholder to place this column name.
1808     # but, we could probably be checking to make sure it is a column that will be fetched.
1809     $strsth .= "order by $order " if ($order);
1810
1811     my $sth = $dbh->prepare($strsth);
1812
1813     $sth->execute( @query_params );
1814     my $results = $sth->fetchall_arrayref({});
1815     $sth->finish;
1816     return @$results;
1817 }
1818
1819 #------------------------------------------------------------#
1820
1821 =head3 GetLateOrders
1822
1823   @results = &GetLateOrders;
1824
1825 Searches for bookseller with late orders.
1826
1827 return:
1828 the table of supplier with late issues. This table is full of hashref.
1829
1830 =cut
1831
1832 sub GetLateOrders {
1833     my $delay      = shift;
1834     my $supplierid = shift;
1835     my $branch     = shift;
1836     my $estimateddeliverydatefrom = shift;
1837     my $estimateddeliverydateto = shift;
1838
1839     my $dbh = C4::Context->dbh;
1840
1841     #BEWARE, order of parenthesis and LEFT JOIN is important for speed
1842     my $dbdriver = C4::Context->config("db_scheme") || "mysql";
1843
1844     my @query_params = ();
1845     my $select = "
1846     SELECT aqbasket.basketno,
1847         aqorders.ordernumber,
1848         DATE(aqbasket.closedate)  AS orderdate,
1849         aqorders.rrp              AS unitpricesupplier,
1850         aqorders.ecost            AS unitpricelib,
1851         aqorders.claims_count     AS claims_count,
1852         aqorders.claimed_date     AS claimed_date,
1853         aqbudgets.budget_name     AS budget,
1854         borrowers.branchcode      AS branch,
1855         aqbooksellers.name        AS supplier,
1856         aqbooksellers.id          AS supplierid,
1857         biblio.author, biblio.title,
1858         biblioitems.publishercode AS publisher,
1859         biblioitems.publicationyear,
1860         ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) AS estimateddeliverydate,
1861     ";
1862     my $from = "
1863     FROM
1864         aqorders LEFT JOIN biblio     ON biblio.biblionumber         = aqorders.biblionumber
1865         LEFT JOIN biblioitems         ON biblioitems.biblionumber    = biblio.biblionumber
1866         LEFT JOIN aqbudgets           ON aqorders.budget_id          = aqbudgets.budget_id,
1867         aqbasket LEFT JOIN borrowers  ON aqbasket.authorisedby       = borrowers.borrowernumber
1868         LEFT JOIN aqbooksellers       ON aqbasket.booksellerid       = aqbooksellers.id
1869         WHERE aqorders.basketno = aqbasket.basketno
1870         AND ( datereceived = ''
1871             OR datereceived IS NULL
1872             OR aqorders.quantityreceived < aqorders.quantity
1873         )
1874         AND aqbasket.closedate IS NOT NULL
1875         AND (aqorders.datecancellationprinted IS NULL OR aqorders.datecancellationprinted='0000-00-00')
1876     ";
1877     my $having = "";
1878     if ($dbdriver eq "mysql") {
1879         $select .= "
1880         aqorders.quantity - COALESCE(aqorders.quantityreceived,0)                 AS quantity,
1881         (aqorders.quantity - COALESCE(aqorders.quantityreceived,0)) * aqorders.rrp AS subtotal,
1882         DATEDIFF(CAST(now() AS date),closedate) AS latesince
1883         ";
1884         if ( defined $delay ) {
1885             $from .= " AND (closedate <= DATE_SUB(CAST(now() AS date),INTERVAL ? DAY)) " ;
1886             push @query_params, $delay;
1887         }
1888         $having = "
1889         HAVING quantity          <> 0
1890             AND unitpricesupplier <> 0
1891             AND unitpricelib      <> 0
1892         ";
1893     } else {
1894         # FIXME: account for IFNULL as above
1895         $select .= "
1896                 aqorders.quantity                AS quantity,
1897                 aqorders.quantity * aqorders.rrp AS subtotal,
1898                 (CAST(now() AS date) - closedate)            AS latesince
1899         ";
1900         if ( defined $delay ) {
1901             $from .= " AND (closedate <= (CAST(now() AS date) -(INTERVAL ? DAY)) ";
1902             push @query_params, $delay;
1903         }
1904     }
1905     if (defined $supplierid) {
1906         $from .= ' AND aqbasket.booksellerid = ? ';
1907         push @query_params, $supplierid;
1908     }
1909     if (defined $branch) {
1910         $from .= ' AND borrowers.branchcode LIKE ? ';
1911         push @query_params, $branch;
1912     }
1913
1914     if ( defined $estimateddeliverydatefrom or defined $estimateddeliverydateto ) {
1915         $from .= ' AND aqbooksellers.deliverytime IS NOT NULL ';
1916     }
1917     if ( defined $estimateddeliverydatefrom ) {
1918         $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) >= ?';
1919         push @query_params, $estimateddeliverydatefrom;
1920     }
1921     if ( defined $estimateddeliverydateto ) {
1922         $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) <= ?';
1923         push @query_params, $estimateddeliverydateto;
1924     }
1925     if ( defined $estimateddeliverydatefrom and not defined $estimateddeliverydateto ) {
1926         $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) <= CAST(now() AS date)';
1927     }
1928     if (C4::Context->preference("IndependantBranches")
1929             && C4::Context->userenv
1930             && C4::Context->userenv->{flags} != 1 ) {
1931         $from .= ' AND borrowers.branchcode LIKE ? ';
1932         push @query_params, C4::Context->userenv->{branch};
1933     }
1934     my $query = "$select $from $having\nORDER BY latesince, basketno, borrowers.branchcode, supplier";
1935     $debug and print STDERR "GetLateOrders query: $query\nGetLateOrders args: " . join(" ",@query_params);
1936     my $sth = $dbh->prepare($query);
1937     $sth->execute(@query_params);
1938     my @results;
1939     while (my $data = $sth->fetchrow_hashref) {
1940         $data->{orderdate} = format_date($data->{orderdate});
1941         $data->{claimed_date} = format_date($data->{claimed_date});
1942         push @results, $data;
1943     }
1944     return @results;
1945 }
1946
1947 #------------------------------------------------------------#
1948
1949 =head3 GetHistory
1950
1951   (\@order_loop, $total_qty, $total_price, $total_qtyreceived) = GetHistory( %params );
1952
1953 Retreives some acquisition history information
1954
1955 params:
1956   title
1957   author
1958   name
1959   from_placed_on
1960   to_placed_on
1961   basket                  - search both basket name and number
1962   booksellerinvoicenumber
1963
1964 returns:
1965     $order_loop is a list of hashrefs that each look like this:
1966             {
1967                 'author'           => 'Twain, Mark',
1968                 'basketno'         => '1',
1969                 'biblionumber'     => '215',
1970                 'count'            => 1,
1971                 'creationdate'     => 'MM/DD/YYYY',
1972                 'datereceived'     => undef,
1973                 'ecost'            => '1.00',
1974                 'id'               => '1',
1975                 'invoicenumber'    => undef,
1976                 'name'             => '',
1977                 'ordernumber'      => '1',
1978                 'quantity'         => 1,
1979                 'quantityreceived' => undef,
1980                 'title'            => 'The Adventures of Huckleberry Finn'
1981             }
1982     $total_qty is the sum of all of the quantities in $order_loop
1983     $total_price is the cost of each in $order_loop times the quantity
1984     $total_qtyreceived is the sum of all of the quantityreceived entries in $order_loop
1985
1986 =cut
1987
1988 sub GetHistory {
1989 # don't run the query if there are no parameters (list would be too long for sure !)
1990     croak "No search params" unless @_;
1991     my %params = @_;
1992     my $title = $params{title};
1993     my $author = $params{author};
1994     my $isbn   = $params{isbn};
1995     my $ean    = $params{ean};
1996     my $name = $params{name};
1997     my $from_placed_on = $params{from_placed_on};
1998     my $to_placed_on = $params{to_placed_on};
1999     my $basket = $params{basket};
2000     my $booksellerinvoicenumber = $params{booksellerinvoicenumber};
2001     my $basketgroupname = $params{basketgroupname};
2002     my @order_loop;
2003     my $total_qty         = 0;
2004     my $total_qtyreceived = 0;
2005     my $total_price       = 0;
2006
2007     my $dbh   = C4::Context->dbh;
2008     my $query ="
2009         SELECT
2010             biblio.title,
2011             biblio.author,
2012             biblioitems.isbn,
2013         biblioitems.ean,
2014             aqorders.basketno,
2015             aqbasket.basketname,
2016             aqbasket.basketgroupid,
2017             aqbasketgroups.name as groupname,
2018             aqbooksellers.name,
2019             aqbasket.creationdate,
2020             aqorders.datereceived,
2021             aqorders.quantity,
2022             aqorders.quantityreceived,
2023             aqorders.ecost,
2024             aqorders.ordernumber,
2025             aqorders.invoiceid,
2026             aqinvoices.invoicenumber,
2027             aqbooksellers.id as id,
2028             aqorders.biblionumber
2029         FROM aqorders
2030         LEFT JOIN aqbasket ON aqorders.basketno=aqbasket.basketno
2031         LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid=aqbasketgroups.id
2032         LEFT JOIN aqbooksellers ON aqbasket.booksellerid=aqbooksellers.id
2033         LEFT JOIN biblioitems ON biblioitems.biblionumber=aqorders.biblionumber
2034         LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber
2035     LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid";
2036
2037     $query .= " LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber"
2038     if ( C4::Context->preference("IndependantBranches") );
2039
2040     $query .= " WHERE (datecancellationprinted is NULL or datecancellationprinted='0000-00-00') ";
2041
2042     my @query_params  = ();
2043
2044     if ( $title ) {
2045         $query .= " AND biblio.title LIKE ? ";
2046         $title =~ s/\s+/%/g;
2047         push @query_params, "%$title%";
2048     }
2049
2050     if ( $author ) {
2051         $query .= " AND biblio.author LIKE ? ";
2052         push @query_params, "%$author%";
2053     }
2054
2055     if ( $isbn ) {
2056         $query .= " AND biblioitems.isbn LIKE ? ";
2057         push @query_params, "%$isbn%";
2058     }
2059     if ( defined $ean and $ean ) {
2060         $query .= " AND biblioitems.ean = ? ";
2061         push @query_params, "$ean";
2062     }
2063     if ( $name ) {
2064         $query .= " AND aqbooksellers.name LIKE ? ";
2065         push @query_params, "%$name%";
2066     }
2067
2068     if ( $from_placed_on ) {
2069         $query .= " AND creationdate >= ? ";
2070         push @query_params, $from_placed_on;
2071     }
2072
2073     if ( $to_placed_on ) {
2074         $query .= " AND creationdate <= ? ";
2075         push @query_params, $to_placed_on;
2076     }
2077
2078     if ($basket) {
2079         if ($basket =~ m/^\d+$/) {
2080             $query .= " AND aqorders.basketno = ? ";
2081             push @query_params, $basket;
2082         } else {
2083             $query .= " AND aqbasket.basketname LIKE ? ";
2084             push @query_params, "%$basket%";
2085         }
2086     }
2087
2088     if ($booksellerinvoicenumber) {
2089         $query .= " AND aqinvoices.invoicenumber LIKE ? ";
2090         push @query_params, "%$booksellerinvoicenumber%";
2091     }
2092
2093     if ($basketgroupname) {
2094         $query .= " AND aqbasketgroups.name LIKE ? ";
2095         push @query_params, "%$basketgroupname%";
2096     }
2097
2098     if ( C4::Context->preference("IndependantBranches") ) {
2099         my $userenv = C4::Context->userenv;
2100         if ( $userenv && ($userenv->{flags} || 0) != 1 ) {
2101             $query .= " AND (borrowers.branchcode = ? OR borrowers.branchcode ='' ) ";
2102             push @query_params, $userenv->{branch};
2103         }
2104     }
2105     $query .= " ORDER BY id";
2106     my $sth = $dbh->prepare($query);
2107     $sth->execute( @query_params );
2108     my $cnt = 1;
2109     while ( my $line = $sth->fetchrow_hashref ) {
2110         $line->{count} = $cnt++;
2111         $line->{toggle} = 1 if $cnt % 2;
2112         push @order_loop, $line;
2113         $total_qty         += $line->{'quantity'};
2114         $total_qtyreceived += $line->{'quantityreceived'};
2115         $total_price       += $line->{'quantity'} * $line->{'ecost'};
2116     }
2117     return \@order_loop, $total_qty, $total_price, $total_qtyreceived;
2118 }
2119
2120 =head2 GetRecentAcqui
2121
2122   $results = GetRecentAcqui($days);
2123
2124 C<$results> is a ref to a table which containts hashref
2125
2126 =cut
2127
2128 sub GetRecentAcqui {
2129     my $limit  = shift;
2130     my $dbh    = C4::Context->dbh;
2131     my $query = "
2132         SELECT *
2133         FROM   biblio
2134         ORDER BY timestamp DESC
2135         LIMIT  0,".$limit;
2136
2137     my $sth = $dbh->prepare($query);
2138     $sth->execute;
2139     my $results = $sth->fetchall_arrayref({});
2140     return $results;
2141 }
2142
2143 =head3 GetContracts
2144
2145   $contractlist = &GetContracts($booksellerid, $activeonly);
2146
2147 Looks up the contracts that belong to a bookseller
2148
2149 Returns a list of contracts
2150
2151 =over
2152
2153 =item C<$booksellerid> is the "id" field in the "aqbooksellers" table.
2154
2155 =item C<$activeonly> if exists get only contracts that are still active.
2156
2157 =back
2158
2159 =cut
2160
2161 sub GetContracts {
2162     my ( $booksellerid, $activeonly ) = @_;
2163     my $dbh = C4::Context->dbh;
2164     my $query;
2165     if (! $activeonly) {
2166         $query = "
2167             SELECT *
2168             FROM   aqcontract
2169             WHERE  booksellerid=?
2170         ";
2171     } else {
2172         $query = "SELECT *
2173             FROM aqcontract
2174             WHERE booksellerid=?
2175                 AND contractenddate >= CURDATE( )";
2176     }
2177     my $sth = $dbh->prepare($query);
2178     $sth->execute( $booksellerid );
2179     my @results;
2180     while (my $data = $sth->fetchrow_hashref ) {
2181         push(@results, $data);
2182     }
2183     $sth->finish;
2184     return @results;
2185 }
2186
2187 #------------------------------------------------------------#
2188
2189 =head3 GetContract
2190
2191   $contract = &GetContract($contractID);
2192
2193 Looks up the contract that has PRIMKEY (contractnumber) value $contractID
2194
2195 Returns a contract
2196
2197 =cut
2198
2199 sub GetContract {
2200     my ( $contractno ) = @_;
2201     my $dbh = C4::Context->dbh;
2202     my $query = "
2203         SELECT *
2204         FROM   aqcontract
2205         WHERE  contractnumber=?
2206         ";
2207
2208     my $sth = $dbh->prepare($query);
2209     $sth->execute( $contractno );
2210     my $result = $sth->fetchrow_hashref;
2211     return $result;
2212 }
2213
2214 =head3 AddClaim
2215
2216 =over 4
2217
2218 &AddClaim($ordernumber);
2219
2220 Add a claim for an order
2221
2222 =back
2223
2224 =cut
2225 sub AddClaim {
2226     my ($ordernumber) = @_;
2227     my $dbh          = C4::Context->dbh;
2228     my $query        = "
2229         UPDATE aqorders SET
2230             claims_count = claims_count + 1,
2231             claimed_date = CURDATE()
2232         WHERE ordernumber = ?
2233         ";
2234     my $sth = $dbh->prepare($query);
2235     $sth->execute($ordernumber);
2236 }
2237
2238 =head3 GetInvoices
2239
2240     my @invoices = GetInvoices(
2241         invoicenumber => $invoicenumber,
2242         suppliername => $suppliername,
2243         shipmentdatefrom => $shipmentdatefrom, # ISO format
2244         shipmentdateto => $shipmentdateto, # ISO format
2245         billingdatefrom => $billingdatefrom, # ISO format
2246         billingdateto => $billingdateto, # ISO format
2247         isbneanissn => $isbn_or_ean_or_issn,
2248         title => $title,
2249         author => $author,
2250         publisher => $publisher,
2251         publicationyear => $publicationyear,
2252         branchcode => $branchcode,
2253         order_by => $order_by
2254     );
2255
2256 Return a list of invoices that match all given criteria.
2257
2258 $order_by is "column_name (asc|desc)", where column_name is any of
2259 'invoicenumber', 'booksellerid', 'shipmentdate', 'billingdate', 'closedate',
2260 'shipmentcost', 'shipmentcost_budgetid'.
2261
2262 asc is the default if omitted
2263
2264 =cut
2265
2266 sub GetInvoices {
2267     my %args = @_;
2268
2269     my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2270         closedate shipmentcost shipmentcost_budgetid);
2271
2272     my $dbh = C4::Context->dbh;
2273     my $query = qq{
2274         SELECT aqinvoices.*, aqbooksellers.name AS suppliername,
2275           COUNT(
2276             DISTINCT IF(
2277               aqorders.datereceived IS NOT NULL,
2278               aqorders.biblionumber,
2279               NULL
2280             )
2281           ) AS receivedbiblios,
2282           SUM(aqorders.quantityreceived) AS receiveditems
2283         FROM aqinvoices
2284           LEFT JOIN aqbooksellers ON aqbooksellers.id = aqinvoices.booksellerid
2285           LEFT JOIN aqorders ON aqorders.invoiceid = aqinvoices.invoiceid
2286           LEFT JOIN biblio ON aqorders.biblionumber = biblio.biblionumber
2287           LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
2288           LEFT JOIN subscription ON biblio.biblionumber = subscription.biblionumber
2289     };
2290
2291     my @bind_args;
2292     my @bind_strs;
2293     if($args{supplierid}) {
2294         push @bind_strs, " aqinvoices.booksellerid = ? ";
2295         push @bind_args, $args{supplierid};
2296     }
2297     if($args{invoicenumber}) {
2298         push @bind_strs, " aqinvoices.invoicenumber LIKE ? ";
2299         push @bind_args, "%$args{invoicenumber}%";
2300     }
2301     if($args{suppliername}) {
2302         push @bind_strs, " aqbooksellers.name LIKE ? ";
2303         push @bind_args, "%$args{suppliername}%";
2304     }
2305     if($args{shipmentdatefrom}) {
2306         push @bind_strs, " aqinvoices.shipementdate >= ? ";
2307         push @bind_args, $args{shipmentdatefrom};
2308     }
2309     if($args{shipmentdateto}) {
2310         push @bind_strs, " aqinvoices.shipementdate <= ? ";
2311         push @bind_args, $args{shipmentdateto};
2312     }
2313     if($args{billingdatefrom}) {
2314         push @bind_strs, " aqinvoices.billingdate >= ? ";
2315         push @bind_args, $args{billingdatefrom};
2316     }
2317     if($args{billingdateto}) {
2318         push @bind_strs, " aqinvoices.billingdate <= ? ";
2319         push @bind_args, $args{billingdateto};
2320     }
2321     if($args{isbneanissn}) {
2322         push @bind_strs, " (biblioitems.isbn LIKE ? OR biblioitems.ean LIKE ? OR biblioitems.issn LIKE ? ) ";
2323         push @bind_args, $args{isbneanissn}, $args{isbneanissn}, $args{isbneanissn};
2324     }
2325     if($args{title}) {
2326         push @bind_strs, " biblio.title LIKE ? ";
2327         push @bind_args, $args{title};
2328     }
2329     if($args{author}) {
2330         push @bind_strs, " biblio.author LIKE ? ";
2331         push @bind_args, $args{author};
2332     }
2333     if($args{publisher}) {
2334         push @bind_strs, " biblioitems.publishercode LIKE ? ";
2335         push @bind_args, $args{publisher};
2336     }
2337     if($args{publicationyear}) {
2338         push @bind_strs, " biblioitems.publicationyear = ? ";
2339         push @bind_args, $args{publicationyear};
2340     }
2341     if($args{branchcode}) {
2342         push @bind_strs, " aqorders.branchcode = ? ";
2343         push @bind_args, $args{branchcode};
2344     }
2345
2346     $query .= " WHERE " . join(" AND ", @bind_strs) if @bind_strs;
2347     $query .= " GROUP BY aqinvoices.invoiceid ";
2348
2349     if($args{order_by}) {
2350         my ($column, $direction) = split / /, $args{order_by};
2351         if(grep /^$column$/, @columns) {
2352             $direction ||= 'ASC';
2353             $query .= " ORDER BY $column $direction";
2354         }
2355     }
2356
2357     my $sth = $dbh->prepare($query);
2358     $sth->execute(@bind_args);
2359
2360     my $results = $sth->fetchall_arrayref({});
2361     return @$results;
2362 }
2363
2364 =head3 GetInvoice
2365
2366     my $invoice = GetInvoice($invoiceid);
2367
2368 Get informations about invoice with given $invoiceid
2369
2370 Return a hash filled with aqinvoices.* fields
2371
2372 =cut
2373
2374 sub GetInvoice {
2375     my ($invoiceid) = @_;
2376     my $invoice;
2377
2378     return unless $invoiceid;
2379
2380     my $dbh = C4::Context->dbh;
2381     my $query = qq{
2382         SELECT *
2383         FROM aqinvoices
2384         WHERE invoiceid = ?
2385     };
2386     my $sth = $dbh->prepare($query);
2387     $sth->execute($invoiceid);
2388
2389     $invoice = $sth->fetchrow_hashref;
2390     return $invoice;
2391 }
2392
2393 =head3 GetInvoiceDetails
2394
2395     my $invoice = GetInvoiceDetails($invoiceid)
2396
2397 Return informations about an invoice + the list of related order lines
2398
2399 Orders informations are in $invoice->{orders} (array ref)
2400
2401 =cut
2402
2403 sub GetInvoiceDetails {
2404     my ($invoiceid) = @_;
2405
2406     if ( !defined $invoiceid ) {
2407         carp 'GetInvoiceDetails called without an invoiceid';
2408         return;
2409     }
2410
2411     my $dbh = C4::Context->dbh;
2412     my $query = qq{
2413         SELECT aqinvoices.*, aqbooksellers.name AS suppliername
2414         FROM aqinvoices
2415           LEFT JOIN aqbooksellers ON aqinvoices.booksellerid = aqbooksellers.id
2416         WHERE invoiceid = ?
2417     };
2418     my $sth = $dbh->prepare($query);
2419     $sth->execute($invoiceid);
2420
2421     my $invoice = $sth->fetchrow_hashref;
2422
2423     $query = qq{
2424         SELECT aqorders.*, biblio.*
2425         FROM aqorders
2426           LEFT JOIN biblio ON aqorders.biblionumber = biblio.biblionumber
2427         WHERE invoiceid = ?
2428     };
2429     $sth = $dbh->prepare($query);
2430     $sth->execute($invoiceid);
2431     $invoice->{orders} = $sth->fetchall_arrayref({});
2432     $invoice->{orders} ||= []; # force an empty arrayref if fetchall_arrayref fails
2433
2434     return $invoice;
2435 }
2436
2437 =head3 AddInvoice
2438
2439     my $invoiceid = AddInvoice(
2440         invoicenumber => $invoicenumber,
2441         booksellerid => $booksellerid,
2442         shipmentdate => $shipmentdate,
2443         billingdate => $billingdate,
2444         closedate => $closedate,
2445         shipmentcost => $shipmentcost,
2446         shipmentcost_budgetid => $shipmentcost_budgetid
2447     );
2448
2449 Create a new invoice and return its id or undef if it fails.
2450
2451 =cut
2452
2453 sub AddInvoice {
2454     my %invoice = @_;
2455
2456     return unless(%invoice and $invoice{invoicenumber});
2457
2458     my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2459         closedate shipmentcost shipmentcost_budgetid);
2460
2461     my @set_strs;
2462     my @set_args;
2463     foreach my $key (keys %invoice) {
2464         if(0 < grep(/^$key$/, @columns)) {
2465             push @set_strs, "$key = ?";
2466             push @set_args, ($invoice{$key} || undef);
2467         }
2468     }
2469
2470     my $rv;
2471     if(@set_args > 0) {
2472         my $dbh = C4::Context->dbh;
2473         my $query = "INSERT INTO aqinvoices SET ";
2474         $query .= join (",", @set_strs);
2475         my $sth = $dbh->prepare($query);
2476         $rv = $sth->execute(@set_args);
2477         if($rv) {
2478             $rv = $dbh->last_insert_id(undef, undef, 'aqinvoices', undef);
2479         }
2480     }
2481     return $rv;
2482 }
2483
2484 =head3 ModInvoice
2485
2486     ModInvoice(
2487         invoiceid => $invoiceid,    # Mandatory
2488         invoicenumber => $invoicenumber,
2489         booksellerid => $booksellerid,
2490         shipmentdate => $shipmentdate,
2491         billingdate => $billingdate,
2492         closedate => $closedate,
2493         shipmentcost => $shipmentcost,
2494         shipmentcost_budgetid => $shipmentcost_budgetid
2495     );
2496
2497 Modify an invoice, invoiceid is mandatory.
2498
2499 Return undef if it fails.
2500
2501 =cut
2502
2503 sub ModInvoice {
2504     my %invoice = @_;
2505
2506     return unless(%invoice and $invoice{invoiceid});
2507
2508     my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2509         closedate shipmentcost shipmentcost_budgetid);
2510
2511     my @set_strs;
2512     my @set_args;
2513     foreach my $key (keys %invoice) {
2514         if(0 < grep(/^$key$/, @columns)) {
2515             push @set_strs, "$key = ?";
2516             push @set_args, ($invoice{$key} || undef);
2517         }
2518     }
2519
2520     my $dbh = C4::Context->dbh;
2521     my $query = "UPDATE aqinvoices SET ";
2522     $query .= join(",", @set_strs);
2523     $query .= " WHERE invoiceid = ?";
2524
2525     my $sth = $dbh->prepare($query);
2526     $sth->execute(@set_args, $invoice{invoiceid});
2527 }
2528
2529 =head3 CloseInvoice
2530
2531     CloseInvoice($invoiceid);
2532
2533 Close an invoice.
2534
2535 Equivalent to ModInvoice(invoiceid => $invoiceid, closedate => undef);
2536
2537 =cut
2538
2539 sub CloseInvoice {
2540     my ($invoiceid) = @_;
2541
2542     return unless $invoiceid;
2543
2544     my $dbh = C4::Context->dbh;
2545     my $query = qq{
2546         UPDATE aqinvoices
2547         SET closedate = CAST(NOW() AS DATE)
2548         WHERE invoiceid = ?
2549     };
2550     my $sth = $dbh->prepare($query);
2551     $sth->execute($invoiceid);
2552 }
2553
2554 =head3 ReopenInvoice
2555
2556     ReopenInvoice($invoiceid);
2557
2558 Reopen an invoice
2559
2560 Equivalent to ModInvoice(invoiceid => $invoiceid, closedate => C4::Dates->new()->output('iso'))
2561
2562 =cut
2563
2564 sub ReopenInvoice {
2565     my ($invoiceid) = @_;
2566
2567     return unless $invoiceid;
2568
2569     my $dbh = C4::Context->dbh;
2570     my $query = qq{
2571         UPDATE aqinvoices
2572         SET closedate = NULL
2573         WHERE invoiceid = ?
2574     };
2575     my $sth = $dbh->prepare($query);
2576     $sth->execute($invoiceid);
2577 }
2578
2579 1;
2580 __END__
2581
2582 =head1 AUTHOR
2583
2584 Koha Development Team <http://koha-community.org/>
2585
2586 =cut