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