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