C4/Acquisition.pm

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