C4/Acquisition.pm

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