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