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