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