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