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