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