C4/Acquisition.pm

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