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