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     croak "The ordernumber parameter should not be provided on calling NewOrder"
1270       if $orderinfo->{ordernumber};
1271
1272     # if these parameters are missing, we can't continue
1273     for my $key (qw/basketno quantity biblionumber budget_id/) {
1274         croak "Mandatory parameter $key missing" unless $orderinfo->{$key};
1275     }
1276
1277     $orderinfo->{'entrydate'} ||= C4::Dates->new()->output("iso");
1278     if (!$orderinfo->{quantityreceived}) {
1279         $orderinfo->{quantityreceived} = 0;
1280     }
1281
1282     # get only the columns of Aqorder
1283     my $schema = Koha::Database->new()->schema;
1284     my $columns = ' '.join(' ', $schema->source('Aqorder')->columns).' ';
1285     my $new_order = { map { $columns =~ / $_ / ? ($_ => $orderinfo->{$_}) : () } keys(%$orderinfo) };
1286     $new_order->{ordernumber} ||= undef;
1287
1288     my $rs = $schema->resultset('Aqorder');
1289     my $ordernumber = $rs->create($new_order)->id;
1290     if (not $new_order->{parent_ordernumber}) {
1291         my $sth = $dbh->prepare("
1292             UPDATE aqorders
1293             SET parent_ordernumber = ordernumber
1294             WHERE ordernumber = ?
1295         ");
1296         $sth->execute($ordernumber);
1297     }
1298     return ( $new_order->{'basketno'}, $ordernumber );
1299 }
1300
1301
1302
1303 #------------------------------------------------------------#
1304
1305 =head3 NewOrderItem
1306
1307   &NewOrderItem();
1308
1309 =cut
1310
1311 sub NewOrderItem {
1312     my ($itemnumber, $ordernumber)  = @_;
1313     my $dbh = C4::Context->dbh;
1314     my $query = qq|
1315             INSERT INTO aqorders_items
1316                 (itemnumber, ordernumber)
1317             VALUES (?,?)    |;
1318
1319     my $sth = $dbh->prepare($query);
1320     $sth->execute( $itemnumber, $ordernumber);
1321 }
1322
1323 #------------------------------------------------------------#
1324
1325 =head3 ModOrder
1326
1327   &ModOrder(\%hashref);
1328
1329 Modifies an existing order. Updates the order with order number
1330 $hashref->{'ordernumber'} and biblionumber $hashref->{'biblionumber'}. All
1331 other keys of the hash update the fields with the same name in the aqorders
1332 table of the Koha database.
1333
1334 =cut
1335
1336 sub ModOrder {
1337     my $orderinfo = shift;
1338
1339     die "Ordernumber is required"     if $orderinfo->{'ordernumber'} eq  '' ;
1340     die "Biblionumber is required"  if  $orderinfo->{'biblionumber'} eq '';
1341
1342     my $dbh = C4::Context->dbh;
1343     my @params;
1344
1345     # update uncertainprice to an integer, just in case (under FF, checked boxes have the value "ON" by default)
1346     $orderinfo->{uncertainprice}=1 if $orderinfo->{uncertainprice};
1347
1348 #    delete($orderinfo->{'branchcode'});
1349     # the hash contains a lot of entries not in aqorders, so get the columns ...
1350     my $sth = $dbh->prepare("SELECT * FROM aqorders LIMIT 1;");
1351     $sth->execute;
1352     my $colnames = $sth->{NAME};
1353         #FIXME Be careful. If aqorders would have columns with diacritics,
1354         #you should need to decode what you get back from NAME.
1355         #See report 10110 and guided_reports.pl
1356     my $query = "UPDATE aqorders SET ";
1357
1358     foreach my $orderinfokey (grep(!/ordernumber/, keys %$orderinfo)){
1359         # ... and skip hash entries that are not in the aqorders table
1360         # FIXME : probably not the best way to do it (would be better to have a correct hash)
1361         next unless grep(/^$orderinfokey$/, @$colnames);
1362             $query .= "$orderinfokey=?, ";
1363             push(@params, $orderinfo->{$orderinfokey});
1364     }
1365
1366     $query .= "timestamp=NOW()  WHERE  ordernumber=?";
1367     push(@params, $orderinfo->{'ordernumber'} );
1368     $sth = $dbh->prepare($query);
1369     $sth->execute(@params);
1370     return;
1371 }
1372
1373 #------------------------------------------------------------#
1374
1375 =head3 ModItemOrder
1376
1377     ModItemOrder($itemnumber, $ordernumber);
1378
1379 Modifies the ordernumber of an item in aqorders_items.
1380
1381 =cut
1382
1383 sub ModItemOrder {
1384     my ($itemnumber, $ordernumber) = @_;
1385
1386     return unless ($itemnumber and $ordernumber);
1387
1388     my $dbh = C4::Context->dbh;
1389     my $query = qq{
1390         UPDATE aqorders_items
1391         SET ordernumber = ?
1392         WHERE itemnumber = ?
1393     };
1394     my $sth = $dbh->prepare($query);
1395     return $sth->execute($ordernumber, $itemnumber);
1396 }
1397
1398 #------------------------------------------------------------#
1399
1400 =head3 GetCancelledOrders
1401
1402   my @orders = GetCancelledOrders($basketno, $orderby);
1403
1404 Returns cancelled orders for a basket
1405
1406 =cut
1407
1408 sub GetCancelledOrders {
1409     my ( $basketno, $orderby ) = @_;
1410
1411     return () unless $basketno;
1412
1413     my $dbh   = C4::Context->dbh;
1414     my $query = "
1415         SELECT
1416             biblio.*,
1417             biblioitems.*,
1418             aqorders.*,
1419             aqbudgets.*,
1420             aqorders_transfers.ordernumber_to AS transferred_to,
1421             aqorders_transfers.timestamp AS transferred_to_timestamp
1422         FROM aqorders
1423           LEFT JOIN aqbudgets   ON aqbudgets.budget_id = aqorders.budget_id
1424           LEFT JOIN biblio      ON biblio.biblionumber = aqorders.biblionumber
1425           LEFT JOIN biblioitems ON biblioitems.biblionumber = biblio.biblionumber
1426           LEFT JOIN aqorders_transfers ON aqorders_transfers.ordernumber_from = aqorders.ordernumber
1427         WHERE basketno = ?
1428           AND (datecancellationprinted IS NOT NULL
1429                AND datecancellationprinted <> '0000-00-00')
1430     ";
1431
1432     $orderby = "aqorders.datecancellationprinted desc, aqorders.timestamp desc"
1433         unless $orderby;
1434     $query .= " ORDER BY $orderby";
1435     my $sth = $dbh->prepare($query);
1436     $sth->execute($basketno);
1437     my $results = $sth->fetchall_arrayref( {} );
1438
1439     return @$results;
1440 }
1441
1442
1443 #------------------------------------------------------------#
1444
1445 =head3 ModReceiveOrder
1446
1447   &ModReceiveOrder({
1448     biblionumber => $biblionumber,
1449     ordernumber => $ordernumber,
1450     quantityreceived => $quantityreceived,
1451     user => $user,
1452     cost => $cost,
1453     ecost => $ecost,
1454     invoiceid => $invoiceid,
1455     rrp => $rrp,
1456     budget_id => $budget_id,
1457     datereceived => $datereceived,
1458     received_itemnumbers => \@received_itemnumbers,
1459     order_internalnote => $order_internalnote,
1460     order_vendornote => $order_vendornote,
1461    });
1462
1463 Updates an order, to reflect the fact that it was received, at least
1464 in part. All arguments not mentioned below update the fields with the
1465 same name in the aqorders table of the Koha database.
1466
1467 If a partial order is received, splits the order into two.
1468
1469 Updates the order with bibilionumber C<$biblionumber> and ordernumber
1470 C<$ordernumber>.
1471
1472 =cut
1473
1474
1475 sub ModReceiveOrder {
1476     my ( $params ) = @_;
1477     my $biblionumber = $params->{biblionumber};
1478     my $ordernumber = $params->{ordernumber};
1479     my $quantrec = $params->{quantityreceived};
1480     my $user = $params->{user};
1481     my $cost = $params->{cost};
1482     my $ecost = $params->{ecost};
1483     my $invoiceid = $params->{invoiceid};
1484     my $rrp = $params->{rrp};
1485     my $budget_id = $params->{budget_id};
1486     my $datereceived = $params->{datereceived};
1487     my $received_items = $params->{received_items};
1488     my $order_internalnote = $params->{order_internalnote};
1489     my $order_vendornote = $params->{order_vendornote};
1490
1491     my $dbh = C4::Context->dbh;
1492     $datereceived = C4::Dates->output('iso') unless $datereceived;
1493     my $suggestionid = GetSuggestionFromBiblionumber( $biblionumber );
1494     if ($suggestionid) {
1495         ModSuggestion( {suggestionid=>$suggestionid,
1496                         STATUS=>'AVAILABLE',
1497                         biblionumber=> $biblionumber}
1498                         );
1499     }
1500
1501     my $result_set = $dbh->selectall_arrayref(
1502 q{SELECT * FROM aqorders WHERE biblionumber=? AND aqorders.ordernumber=?},
1503         { Slice => {} }, $biblionumber, $ordernumber
1504     );
1505
1506     # we assume we have a unique order
1507     my $order = $result_set->[0];
1508
1509     my $new_ordernumber = $ordernumber;
1510     if ( $order->{quantity} > $quantrec ) {
1511         # Split order line in two parts: the first is the original order line
1512         # without received items (the quantity is decreased),
1513         # the second part is a new order line with quantity=quantityrec
1514         # (entirely received)
1515         my $query = q|
1516             UPDATE aqorders
1517             SET quantity = ?,
1518                 orderstatus = 'partial'|;
1519         $query .= q|, order_internalnote = ?| if defined $order_internalnote;
1520         $query .= q|, order_vendornote = ?| if defined $order_vendornote;
1521         $query .= q| WHERE ordernumber = ?|;
1522         my $sth = $dbh->prepare($query);
1523
1524         $sth->execute(
1525             $order->{quantity} - $quantrec,
1526             ( defined $order_internalnote ? $order_internalnote : () ),
1527             ( defined $order_vendornote ? $order_vendornote : () ),
1528             $ordernumber
1529         );
1530
1531         delete $order->{'ordernumber'};
1532         $order->{'budget_id'} = ( $budget_id || $order->{'budget_id'} );
1533         $order->{'quantity'} = $quantrec;
1534         $order->{'quantityreceived'} = $quantrec;
1535         $order->{'datereceived'} = $datereceived;
1536         $order->{'invoiceid'} = $invoiceid;
1537         $order->{'unitprice'} = $cost;
1538         $order->{'rrp'} = $rrp;
1539         $order->{ecost} = $ecost;
1540         $order->{'orderstatus'} = 'complete';
1541         my $basketno;
1542         ( $basketno, $new_ordernumber ) = NewOrder($order);
1543
1544         if ($received_items) {
1545             foreach my $itemnumber (@$received_items) {
1546                 ModItemOrder($itemnumber, $new_ordernumber);
1547             }
1548         }
1549     } else {
1550         my $query = q|
1551             update aqorders
1552             set quantityreceived=?,datereceived=?,invoiceid=?,
1553                 unitprice=?,rrp=?,ecost=?,budget_id=?,orderstatus='complete'|;
1554         $query .= q|, order_internalnote = ?| if defined $order_internalnote;
1555         $query .= q|, order_vendornote = ?| if defined $order_vendornote;
1556         $query .= q| where biblionumber=? and ordernumber=?|;
1557         my $sth = $dbh->prepare( $query );
1558         $sth->execute(
1559             $quantrec,
1560             $datereceived,
1561             $invoiceid,
1562             $cost,
1563             $rrp,
1564             $ecost,
1565             $budget_id,
1566             ( defined $order_internalnote ? $order_internalnote : () ),
1567             ( defined $order_vendornote ? $order_vendornote : () ),
1568             $biblionumber,
1569             $ordernumber
1570         );
1571     }
1572     return ($datereceived, $new_ordernumber);
1573 }
1574
1575 =head3 CancelReceipt
1576
1577     my $parent_ordernumber = CancelReceipt($ordernumber);
1578
1579     Cancel an order line receipt and update the parent order line, as if no
1580     receipt was made.
1581     If items are created at receipt (AcqCreateItem = receiving) then delete
1582     these items.
1583
1584 =cut
1585
1586 sub CancelReceipt {
1587     my $ordernumber = shift;
1588
1589     return unless $ordernumber;
1590
1591     my $dbh = C4::Context->dbh;
1592     my $query = qq{
1593         SELECT datereceived, parent_ordernumber, quantity
1594         FROM aqorders
1595         WHERE ordernumber = ?
1596     };
1597     my $sth = $dbh->prepare($query);
1598     $sth->execute($ordernumber);
1599     my $order = $sth->fetchrow_hashref;
1600     unless($order) {
1601         warn "CancelReceipt: order $ordernumber does not exist";
1602         return;
1603     }
1604     unless($order->{'datereceived'}) {
1605         warn "CancelReceipt: order $ordernumber is not received";
1606         return;
1607     }
1608
1609     my $parent_ordernumber = $order->{'parent_ordernumber'};
1610
1611     my @itemnumbers = GetItemnumbersFromOrder( $ordernumber );
1612
1613     if($parent_ordernumber == $ordernumber || not $parent_ordernumber) {
1614         # The order line has no parent, just mark it as not received
1615         $query = qq{
1616             UPDATE aqorders
1617             SET quantityreceived = ?,
1618                 datereceived = ?,
1619                 invoiceid = ?,
1620                 orderstatus = 'ordered'
1621             WHERE ordernumber = ?
1622         };
1623         $sth = $dbh->prepare($query);
1624         $sth->execute(0, undef, undef, $ordernumber);
1625         _cancel_items_receipt( $ordernumber );
1626     } else {
1627         # The order line has a parent, increase parent quantity and delete
1628         # the order line.
1629         $query = qq{
1630             SELECT quantity, datereceived
1631             FROM aqorders
1632             WHERE ordernumber = ?
1633         };
1634         $sth = $dbh->prepare($query);
1635         $sth->execute($parent_ordernumber);
1636         my $parent_order = $sth->fetchrow_hashref;
1637         unless($parent_order) {
1638             warn "Parent order $parent_ordernumber does not exist.";
1639             return;
1640         }
1641         if($parent_order->{'datereceived'}) {
1642             warn "CancelReceipt: parent order is received.".
1643                 " Can't cancel receipt.";
1644             return;
1645         }
1646         $query = qq{
1647             UPDATE aqorders
1648             SET quantity = ?,
1649                 orderstatus = 'ordered'
1650             WHERE ordernumber = ?
1651         };
1652         $sth = $dbh->prepare($query);
1653         my $rv = $sth->execute(
1654             $order->{'quantity'} + $parent_order->{'quantity'},
1655             $parent_ordernumber
1656         );
1657         unless($rv) {
1658             warn "Cannot update parent order line, so do not cancel".
1659                 " receipt";
1660             return;
1661         }
1662         _cancel_items_receipt( $ordernumber, $parent_ordernumber );
1663         # Delete order line
1664         $query = qq{
1665             DELETE FROM aqorders
1666             WHERE ordernumber = ?
1667         };
1668         $sth = $dbh->prepare($query);
1669         $sth->execute($ordernumber);
1670
1671     }
1672
1673     if(C4::Context->preference('AcqCreateItem') eq 'ordering') {
1674         my @affects = split q{\|}, C4::Context->preference("AcqItemSetSubfieldsWhenReceiptIsCancelled");
1675         if ( @affects ) {
1676             for my $in ( @itemnumbers ) {
1677                 my $biblionumber = C4::Biblio::GetBiblionumberFromItemnumber( $in );
1678                 my $frameworkcode = GetFrameworkCode($biblionumber);
1679                 my ( $itemfield ) = GetMarcFromKohaField( 'items.itemnumber', $frameworkcode );
1680                 my $item = C4::Items::GetMarcItem( $biblionumber, $in );
1681                 for my $affect ( @affects ) {
1682                     my ( $sf, $v ) = split q{=}, $affect, 2;
1683                     foreach ( $item->field($itemfield) ) {
1684                         $_->update( $sf => $v );
1685                     }
1686                 }
1687                 C4::Items::ModItemFromMarc( $item, $biblionumber, $in );
1688             }
1689         }
1690     }
1691
1692     return $parent_ordernumber;
1693 }
1694
1695 sub _cancel_items_receipt {
1696     my ( $ordernumber, $parent_ordernumber ) = @_;
1697     $parent_ordernumber ||= $ordernumber;
1698
1699     my @itemnumbers = GetItemnumbersFromOrder($ordernumber);
1700     if(C4::Context->preference('AcqCreateItem') eq 'receiving') {
1701         # Remove items that were created at receipt
1702         my $query = qq{
1703             DELETE FROM items, aqorders_items
1704             USING items, aqorders_items
1705             WHERE items.itemnumber = ? AND aqorders_items.itemnumber = ?
1706         };
1707         my $dbh = C4::Context->dbh;
1708         my $sth = $dbh->prepare($query);
1709         foreach my $itemnumber (@itemnumbers) {
1710             $sth->execute($itemnumber, $itemnumber);
1711         }
1712     } else {
1713         # Update items
1714         foreach my $itemnumber (@itemnumbers) {
1715             ModItemOrder($itemnumber, $parent_ordernumber);
1716         }
1717     }
1718 }
1719
1720 #------------------------------------------------------------#
1721
1722 =head3 SearchOrders
1723
1724 @results = &SearchOrders({
1725     ordernumber => $ordernumber,
1726     search => $search,
1727     biblionumber => $biblionumber,
1728     ean => $ean,
1729     booksellerid => $booksellerid,
1730     basketno => $basketno,
1731     owner => $owner,
1732     pending => $pending
1733     ordered => $ordered
1734 });
1735
1736 Searches for orders.
1737
1738 C<$owner> Finds order for the logged in user.
1739 C<$pending> Finds pending orders. Ignores completed and cancelled orders.
1740 C<$ordered> Finds orders to receive only (status 'ordered' or 'partial').
1741
1742
1743 C<@results> is an array of references-to-hash with the keys are fields
1744 from aqorders, biblio, biblioitems and aqbasket tables.
1745
1746 =cut
1747
1748 sub SearchOrders {
1749     my ( $params ) = @_;
1750     my $ordernumber = $params->{ordernumber};
1751     my $search = $params->{search};
1752     my $ean = $params->{ean};
1753     my $booksellerid = $params->{booksellerid};
1754     my $basketno = $params->{basketno};
1755     my $basketname = $params->{basketname};
1756     my $basketgroupname = $params->{basketgroupname};
1757     my $owner = $params->{owner};
1758     my $pending = $params->{pending};
1759     my $ordered = $params->{ordered};
1760     my $biblionumber = $params->{biblionumber};
1761     my $budget_id = $params->{budget_id};
1762
1763     my $dbh = C4::Context->dbh;
1764     my @args = ();
1765     my $query = q{
1766         SELECT aqbasket.basketno,
1767                borrowers.surname,
1768                borrowers.firstname,
1769                biblio.*,
1770                biblioitems.isbn,
1771                biblioitems.biblioitemnumber,
1772                aqbasket.authorisedby,
1773                aqbasket.booksellerid,
1774                aqbasket.closedate,
1775                aqbasket.creationdate,
1776                aqbasket.basketname,
1777                aqbasketgroups.id as basketgroupid,
1778                aqbasketgroups.name as basketgroupname,
1779                aqorders.*
1780         FROM aqorders
1781             LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
1782             LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid = aqbasketgroups.id
1783             LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
1784             LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1785             LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
1786     };
1787
1788     # If we search on ordernumber, we retrieve the transfered order if a transfer has been done.
1789     $query .= q{
1790             LEFT JOIN aqorders_transfers ON aqorders_transfers.ordernumber_to = aqorders.ordernumber
1791     } if $ordernumber;
1792
1793     $query .= q{
1794         WHERE (datecancellationprinted is NULL)
1795     };
1796
1797     if ( $pending or $ordered ) {
1798         $query .= q{ AND (quantity > quantityreceived OR quantityreceived is NULL)};
1799     }
1800     if ( $ordered ) {
1801         $query .= q{ AND aqorders.orderstatus IN ( "ordered", "partial" )};
1802     }
1803
1804     my $userenv = C4::Context->userenv;
1805     if ( C4::Context->preference("IndependentBranches") ) {
1806         unless ( C4::Context->IsSuperLibrarian() ) {
1807             $query .= q{
1808                 AND (
1809                     borrowers.branchcode = ?
1810                     OR borrowers.branchcode  = ''
1811                 )
1812             };
1813             push @args, $userenv->{branch};
1814         }
1815     }
1816
1817     if ( $ordernumber ) {
1818         $query .= ' AND ( aqorders.ordernumber = ? OR aqorders_transfers.ordernumber_from = ? ) ';
1819         push @args, ( $ordernumber, $ordernumber );
1820     }
1821     if ( $biblionumber ) {
1822         $query .= 'AND aqorders.biblionumber = ?';
1823         push @args, $biblionumber;
1824     }
1825     if( $search ) {
1826         $query .= ' AND (biblio.title LIKE ? OR biblio.author LIKE ? OR biblioitems.isbn LIKE ?)';
1827         push @args, ("%$search%","%$search%","%$search%");
1828     }
1829     if ( $ean ) {
1830         $query .= ' AND biblioitems.ean = ?';
1831         push @args, $ean;
1832     }
1833     if ( $booksellerid ) {
1834         $query .= 'AND aqbasket.booksellerid = ?';
1835         push @args, $booksellerid;
1836     }
1837     if( $basketno ) {
1838         $query .= 'AND aqbasket.basketno = ?';
1839         push @args, $basketno;
1840     }
1841     if( $basketname ) {
1842         $query .= 'AND aqbasket.basketname LIKE ?';
1843         push @args, "%$basketname%";
1844     }
1845     if( $basketgroupname ) {
1846         $query .= ' AND aqbasketgroups.name LIKE ?';
1847         push @args, "%$basketgroupname%";
1848     }
1849
1850     if ( $owner ) {
1851         $query .= ' AND aqbasket.authorisedby=? ';
1852         push @args, $userenv->{'number'};
1853     }
1854
1855     if ( $budget_id ) {
1856         $query .= ' AND aqorders.budget_id = ?';
1857         push @args, $budget_id;
1858     }
1859
1860     $query .= ' ORDER BY aqbasket.basketno';
1861
1862     my $sth = $dbh->prepare($query);
1863     $sth->execute(@args);
1864     return $sth->fetchall_arrayref({});
1865 }
1866
1867 #------------------------------------------------------------#
1868
1869 =head3 DelOrder
1870
1871   &DelOrder($biblionumber, $ordernumber);
1872
1873 Cancel the order with the given order and biblio numbers. It does not
1874 delete any entries in the aqorders table, it merely marks them as
1875 cancelled.
1876
1877 =cut
1878
1879 sub DelOrder {
1880     my ( $bibnum, $ordernumber ) = @_;
1881     my $dbh = C4::Context->dbh;
1882     my $query = "
1883         UPDATE aqorders
1884         SET    datecancellationprinted=now(), orderstatus='cancelled'
1885         WHERE  biblionumber=? AND ordernumber=?
1886     ";
1887     my $sth = $dbh->prepare($query);
1888     $sth->execute( $bibnum, $ordernumber );
1889     my @itemnumbers = GetItemnumbersFromOrder( $ordernumber );
1890     foreach my $itemnumber (@itemnumbers){
1891         C4::Items::DelItem(
1892             {
1893                 biblionumber => $bibnum,
1894                 itemnumber   => $itemnumber
1895             }
1896         );
1897     }
1898     return;
1899 }
1900
1901 =head3 TransferOrder
1902
1903     my $newordernumber = TransferOrder($ordernumber, $basketno);
1904
1905 Transfer an order line to a basket.
1906 Mark $ordernumber as cancelled with an internal note 'Cancelled and transfered
1907 to BOOKSELLER on DATE' and create new order with internal note
1908 'Transfered from BOOKSELLER on DATE'.
1909 Move all attached items to the new order.
1910 Received orders cannot be transfered.
1911 Return the ordernumber of created order.
1912
1913 =cut
1914
1915 sub TransferOrder {
1916     my ($ordernumber, $basketno) = @_;
1917
1918     return unless ($ordernumber and $basketno);
1919
1920     my $order = GetOrder( $ordernumber );
1921     return if $order->{datereceived};
1922     my $basket = GetBasket($basketno);
1923     return unless $basket;
1924
1925     my $dbh = C4::Context->dbh;
1926     my ($query, $sth, $rv);
1927
1928     $query = q{
1929         UPDATE aqorders
1930         SET datecancellationprinted = CAST(NOW() AS date)
1931         WHERE ordernumber = ?
1932     };
1933     $sth = $dbh->prepare($query);
1934     $rv = $sth->execute($ordernumber);
1935
1936     delete $order->{'ordernumber'};
1937     delete $order->{parent_ordernumber};
1938     $order->{'basketno'} = $basketno;
1939     my $newordernumber;
1940     (undef, $newordernumber) = NewOrder($order);
1941
1942     $query = q{
1943         UPDATE aqorders_items
1944         SET ordernumber = ?
1945         WHERE ordernumber = ?
1946     };
1947     $sth = $dbh->prepare($query);
1948     $sth->execute($newordernumber, $ordernumber);
1949
1950     $query = q{
1951         INSERT INTO aqorders_transfers (ordernumber_from, ordernumber_to)
1952         VALUES (?, ?)
1953     };
1954     $sth = $dbh->prepare($query);
1955     $sth->execute($ordernumber, $newordernumber);
1956
1957     return $newordernumber;
1958 }
1959
1960 =head2 FUNCTIONS ABOUT PARCELS
1961
1962 =cut
1963
1964 #------------------------------------------------------------#
1965
1966 =head3 GetParcel
1967
1968   @results = &GetParcel($booksellerid, $code, $date);
1969
1970 Looks up all of the received items from the supplier with the given
1971 bookseller ID at the given date, for the given code (bookseller Invoice number). Ignores cancelled and completed orders.
1972
1973 C<@results> is an array of references-to-hash. The keys of each element are fields from
1974 the aqorders, biblio, and biblioitems tables of the Koha database.
1975
1976 C<@results> is sorted alphabetically by book title.
1977
1978 =cut
1979
1980 sub GetParcel {
1981     #gets all orders from a certain supplier, orders them alphabetically
1982     my ( $supplierid, $code, $datereceived ) = @_;
1983     my $dbh     = C4::Context->dbh;
1984     my @results = ();
1985     $code .= '%'
1986     if $code;  # add % if we search on a given code (otherwise, let him empty)
1987     my $strsth ="
1988         SELECT  authorisedby,
1989                 creationdate,
1990                 aqbasket.basketno,
1991                 closedate,surname,
1992                 firstname,
1993                 aqorders.biblionumber,
1994                 aqorders.ordernumber,
1995                 aqorders.parent_ordernumber,
1996                 aqorders.quantity,
1997                 aqorders.quantityreceived,
1998                 aqorders.unitprice,
1999                 aqorders.listprice,
2000                 aqorders.rrp,
2001                 aqorders.ecost,
2002                 aqorders.gstrate,
2003                 biblio.title
2004         FROM aqorders
2005         LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
2006         LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
2007         LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
2008         LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid
2009         WHERE
2010             aqbasket.booksellerid = ?
2011             AND aqinvoices.invoicenumber LIKE ?
2012             AND aqorders.datereceived = ? ";
2013
2014     my @query_params = ( $supplierid, $code, $datereceived );
2015     if ( C4::Context->preference("IndependentBranches") ) {
2016         unless ( C4::Context->IsSuperLibrarian() ) {
2017             $strsth .= " and (borrowers.branchcode = ?
2018                         or borrowers.branchcode  = '')";
2019             push @query_params, C4::Context->userenv->{branch};
2020         }
2021     }
2022     $strsth .= " ORDER BY aqbasket.basketno";
2023     my $result_set = $dbh->selectall_arrayref(
2024         $strsth,
2025         { Slice => {} },
2026         @query_params);
2027
2028     return @{$result_set};
2029 }
2030
2031 #------------------------------------------------------------#
2032
2033 =head3 GetParcels
2034
2035   $results = &GetParcels($bookseller, $order, $code, $datefrom, $dateto);
2036
2037 get a lists of parcels.
2038
2039 * Input arg :
2040
2041 =over
2042
2043 =item $bookseller
2044 is the bookseller this function has to get parcels.
2045
2046 =item $order
2047 To know on what criteria the results list has to be ordered.
2048
2049 =item $code
2050 is the booksellerinvoicenumber.
2051
2052 =item $datefrom & $dateto
2053 to know on what date this function has to filter its search.
2054
2055 =back
2056
2057 * return:
2058 a pointer on a hash list containing parcel informations as such :
2059
2060 =over
2061
2062 =item Creation date
2063
2064 =item Last operation
2065
2066 =item Number of biblio
2067
2068 =item Number of items
2069
2070 =back
2071
2072 =cut
2073
2074 sub GetParcels {
2075     my ($bookseller,$order, $code, $datefrom, $dateto) = @_;
2076     my $dbh    = C4::Context->dbh;
2077     my @query_params = ();
2078     my $strsth ="
2079         SELECT  aqinvoices.invoicenumber,
2080                 datereceived,purchaseordernumber,
2081                 count(DISTINCT biblionumber) AS biblio,
2082                 sum(quantity) AS itemsexpected,
2083                 sum(quantityreceived) AS itemsreceived
2084         FROM   aqorders LEFT JOIN aqbasket ON aqbasket.basketno = aqorders.basketno
2085         LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid
2086         WHERE aqbasket.booksellerid = ? and datereceived IS NOT NULL
2087     ";
2088     push @query_params, $bookseller;
2089
2090     if ( defined $code ) {
2091         $strsth .= ' and aqinvoices.invoicenumber like ? ';
2092         # add a % to the end of the code to allow stemming.
2093         push @query_params, "$code%";
2094     }
2095
2096     if ( defined $datefrom ) {
2097         $strsth .= ' and datereceived >= ? ';
2098         push @query_params, $datefrom;
2099     }
2100
2101     if ( defined $dateto ) {
2102         $strsth .=  'and datereceived <= ? ';
2103         push @query_params, $dateto;
2104     }
2105
2106     $strsth .= "group by aqinvoices.invoicenumber,datereceived ";
2107
2108     # can't use a placeholder to place this column name.
2109     # but, we could probably be checking to make sure it is a column that will be fetched.
2110     $strsth .= "order by $order " if ($order);
2111
2112     my $sth = $dbh->prepare($strsth);
2113
2114     $sth->execute( @query_params );
2115     my $results = $sth->fetchall_arrayref({});
2116     return @{$results};
2117 }
2118
2119 #------------------------------------------------------------#
2120
2121 =head3 GetLateOrders
2122
2123   @results = &GetLateOrders;
2124
2125 Searches for bookseller with late orders.
2126
2127 return:
2128 the table of supplier with late issues. This table is full of hashref.
2129
2130 =cut
2131
2132 sub GetLateOrders {
2133     my $delay      = shift;
2134     my $supplierid = shift;
2135     my $branch     = shift;
2136     my $estimateddeliverydatefrom = shift;
2137     my $estimateddeliverydateto = shift;
2138
2139     my $dbh = C4::Context->dbh;
2140
2141     #BEWARE, order of parenthesis and LEFT JOIN is important for speed
2142     my $dbdriver = C4::Context->config("db_scheme") || "mysql";
2143
2144     my @query_params = ();
2145     my $select = "
2146     SELECT aqbasket.basketno,
2147         aqorders.ordernumber,
2148         DATE(aqbasket.closedate)  AS orderdate,
2149         aqbasket.basketname       AS basketname,
2150         aqbasket.basketgroupid    AS basketgroupid,
2151         aqbasketgroups.name       AS basketgroupname,
2152         aqorders.rrp              AS unitpricesupplier,
2153         aqorders.ecost            AS unitpricelib,
2154         aqorders.claims_count     AS claims_count,
2155         aqorders.claimed_date     AS claimed_date,
2156         aqbudgets.budget_name     AS budget,
2157         borrowers.branchcode      AS branch,
2158         aqbooksellers.name        AS supplier,
2159         aqbooksellers.id          AS supplierid,
2160         biblio.author, biblio.title,
2161         biblioitems.publishercode AS publisher,
2162         biblioitems.publicationyear,
2163         ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) AS estimateddeliverydate,
2164     ";
2165     my $from = "
2166     FROM
2167         aqorders LEFT JOIN biblio     ON biblio.biblionumber         = aqorders.biblionumber
2168         LEFT JOIN biblioitems         ON biblioitems.biblionumber    = biblio.biblionumber
2169         LEFT JOIN aqbudgets           ON aqorders.budget_id          = aqbudgets.budget_id,
2170         aqbasket LEFT JOIN borrowers  ON aqbasket.authorisedby       = borrowers.borrowernumber
2171         LEFT JOIN aqbooksellers       ON aqbasket.booksellerid       = aqbooksellers.id
2172         LEFT JOIN aqbasketgroups      ON aqbasket.basketgroupid      = aqbasketgroups.id
2173         WHERE aqorders.basketno = aqbasket.basketno
2174         AND ( datereceived = ''
2175             OR datereceived IS NULL
2176             OR aqorders.quantityreceived < aqorders.quantity
2177         )
2178         AND aqbasket.closedate IS NOT NULL
2179         AND (aqorders.datecancellationprinted IS NULL OR aqorders.datecancellationprinted='0000-00-00')
2180     ";
2181     my $having = "";
2182     if ($dbdriver eq "mysql") {
2183         $select .= "
2184         aqorders.quantity - COALESCE(aqorders.quantityreceived,0)                 AS quantity,
2185         (aqorders.quantity - COALESCE(aqorders.quantityreceived,0)) * aqorders.rrp AS subtotal,
2186         DATEDIFF(CAST(now() AS date),closedate) AS latesince
2187         ";
2188         if ( defined $delay ) {
2189             $from .= " AND (closedate <= DATE_SUB(CAST(now() AS date),INTERVAL ? DAY)) " ;
2190             push @query_params, $delay;
2191         }
2192         $having = "
2193         HAVING quantity          <> 0
2194             AND unitpricesupplier <> 0
2195             AND unitpricelib      <> 0
2196         ";
2197     } else {
2198         # FIXME: account for IFNULL as above
2199         $select .= "
2200                 aqorders.quantity                AS quantity,
2201                 aqorders.quantity * aqorders.rrp AS subtotal,
2202                 (CAST(now() AS date) - closedate)            AS latesince
2203         ";
2204         if ( defined $delay ) {
2205             $from .= " AND (closedate <= (CAST(now() AS date) -(INTERVAL ? DAY)) ";
2206             push @query_params, $delay;
2207         }
2208     }
2209     if (defined $supplierid) {
2210         $from .= ' AND aqbasket.booksellerid = ? ';
2211         push @query_params, $supplierid;
2212     }
2213     if (defined $branch) {
2214         $from .= ' AND borrowers.branchcode LIKE ? ';
2215         push @query_params, $branch;
2216     }
2217
2218     if ( defined $estimateddeliverydatefrom or defined $estimateddeliverydateto ) {
2219         $from .= ' AND aqbooksellers.deliverytime IS NOT NULL ';
2220     }
2221     if ( defined $estimateddeliverydatefrom ) {
2222         $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) >= ?';
2223         push @query_params, $estimateddeliverydatefrom;
2224     }
2225     if ( defined $estimateddeliverydateto ) {
2226         $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) <= ?';
2227         push @query_params, $estimateddeliverydateto;
2228     }
2229     if ( defined $estimateddeliverydatefrom and not defined $estimateddeliverydateto ) {
2230         $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) <= CAST(now() AS date)';
2231     }
2232     if (C4::Context->preference("IndependentBranches")
2233             && !C4::Context->IsSuperLibrarian() ) {
2234         $from .= ' AND borrowers.branchcode LIKE ? ';
2235         push @query_params, C4::Context->userenv->{branch};
2236     }
2237     $from .= " AND orderstatus <> 'cancelled' ";
2238     my $query = "$select $from $having\nORDER BY latesince, basketno, borrowers.branchcode, supplier";
2239     $debug and print STDERR "GetLateOrders query: $query\nGetLateOrders args: " . join(" ",@query_params);
2240     my $sth = $dbh->prepare($query);
2241     $sth->execute(@query_params);
2242     my @results;
2243     while (my $data = $sth->fetchrow_hashref) {
2244         push @results, $data;
2245     }
2246     return @results;
2247 }
2248
2249 #------------------------------------------------------------#
2250
2251 =head3 GetHistory
2252
2253   (\@order_loop, $total_qty, $total_price, $total_qtyreceived) = GetHistory( %params );
2254
2255 Retreives some acquisition history information
2256
2257 params:
2258   title
2259   author
2260   name
2261   isbn
2262   ean
2263   from_placed_on
2264   to_placed_on
2265   basket                  - search both basket name and number
2266   booksellerinvoicenumber
2267   basketgroupname
2268   budget
2269   orderstatus (note that orderstatus '' will retrieve orders
2270                of any status except cancelled)
2271   biblionumber
2272   get_canceled_order (if set to a true value, cancelled orders will
2273                       be included)
2274
2275 returns:
2276     $order_loop is a list of hashrefs that each look like this:
2277             {
2278                 'author'           => 'Twain, Mark',
2279                 'basketno'         => '1',
2280                 'biblionumber'     => '215',
2281                 'count'            => 1,
2282                 'creationdate'     => 'MM/DD/YYYY',
2283                 'datereceived'     => undef,
2284                 'ecost'            => '1.00',
2285                 'id'               => '1',
2286                 'invoicenumber'    => undef,
2287                 'name'             => '',
2288                 'ordernumber'      => '1',
2289                 'quantity'         => 1,
2290                 'quantityreceived' => undef,
2291                 'title'            => 'The Adventures of Huckleberry Finn'
2292             }
2293     $total_qty is the sum of all of the quantities in $order_loop
2294     $total_price is the cost of each in $order_loop times the quantity
2295     $total_qtyreceived is the sum of all of the quantityreceived entries in $order_loop
2296
2297 =cut
2298
2299 sub GetHistory {
2300 # don't run the query if there are no parameters (list would be too long for sure !)
2301     croak "No search params" unless @_;
2302     my %params = @_;
2303     my $title = $params{title};
2304     my $author = $params{author};
2305     my $isbn   = $params{isbn};
2306     my $ean    = $params{ean};
2307     my $name = $params{name};
2308     my $from_placed_on = $params{from_placed_on};
2309     my $to_placed_on = $params{to_placed_on};
2310     my $basket = $params{basket};
2311     my $booksellerinvoicenumber = $params{booksellerinvoicenumber};
2312     my $basketgroupname = $params{basketgroupname};
2313     my $budget = $params{budget};
2314     my $orderstatus = $params{orderstatus};
2315     my $biblionumber = $params{biblionumber};
2316     my $get_canceled_order = $params{get_canceled_order} || 0;
2317     my $ordernumber = $params{ordernumber};
2318     my $search_children_too = $params{search_children_too} || 0;
2319
2320     my @order_loop;
2321     my $total_qty         = 0;
2322     my $total_qtyreceived = 0;
2323     my $total_price       = 0;
2324
2325     my $dbh   = C4::Context->dbh;
2326     my $query ="
2327         SELECT
2328             COALESCE(biblio.title,     deletedbiblio.title)     AS title,
2329             COALESCE(biblio.author,    deletedbiblio.author)    AS author,
2330             COALESCE(biblioitems.isbn, deletedbiblioitems.isbn) AS isbn,
2331             COALESCE(biblioitems.ean,  deletedbiblioitems.ean)  AS ean,
2332             aqorders.basketno,
2333             aqbasket.basketname,
2334             aqbasket.basketgroupid,
2335             aqbasketgroups.name as groupname,
2336             aqbooksellers.name,
2337             aqbasket.creationdate,
2338             aqorders.datereceived,
2339             aqorders.quantity,
2340             aqorders.quantityreceived,
2341             aqorders.ecost,
2342             aqorders.ordernumber,
2343             aqorders.invoiceid,
2344             aqinvoices.invoicenumber,
2345             aqbooksellers.id as id,
2346             aqorders.biblionumber,
2347             aqorders.orderstatus,
2348             aqorders.parent_ordernumber,
2349             aqbudgets.budget_name
2350             ";
2351     $query .= ", aqbudgets.budget_id AS budget" if defined $budget;
2352     $query .= "
2353         FROM aqorders
2354         LEFT JOIN aqbasket ON aqorders.basketno=aqbasket.basketno
2355         LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid=aqbasketgroups.id
2356         LEFT JOIN aqbooksellers ON aqbasket.booksellerid=aqbooksellers.id
2357         LEFT JOIN biblioitems ON biblioitems.biblionumber=aqorders.biblionumber
2358         LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber
2359         LEFT JOIN aqbudgets ON aqorders.budget_id=aqbudgets.budget_id
2360         LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid
2361         LEFT JOIN deletedbiblio ON deletedbiblio.biblionumber=aqorders.biblionumber
2362         LEFT JOIN deletedbiblioitems ON deletedbiblioitems.biblionumber=aqorders.biblionumber
2363         ";
2364
2365     if ( C4::Context->preference("IndependentBranches") ) {
2366         $query .= " LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber";
2367     }
2368
2369     $query .= " WHERE 1 ";
2370
2371     unless ($get_canceled_order or (defined $orderstatus and $orderstatus eq 'cancelled')) {
2372         $query .= " AND (datecancellationprinted is NULL or datecancellationprinted='0000-00-00') ";
2373     }
2374
2375     my @query_params  = ();
2376
2377     if ( $biblionumber ) {
2378         $query .= " AND biblio.biblionumber = ?";
2379         push @query_params, $biblionumber;
2380     }
2381
2382     if ( $title ) {
2383         $query .= " AND biblio.title LIKE ? ";
2384         $title =~ s/\s+/%/g;
2385         push @query_params, "%$title%";
2386     }
2387
2388     if ( $author ) {
2389         $query .= " AND biblio.author LIKE ? ";
2390         push @query_params, "%$author%";
2391     }
2392
2393     if ( $isbn ) {
2394         $query .= " AND biblioitems.isbn LIKE ? ";
2395         push @query_params, "%$isbn%";
2396     }
2397     if ( $ean ) {
2398         $query .= " AND biblioitems.ean = ? ";
2399         push @query_params, "$ean";
2400     }
2401     if ( $name ) {
2402         $query .= " AND aqbooksellers.name LIKE ? ";
2403         push @query_params, "%$name%";
2404     }
2405
2406     if ( $budget ) {
2407         $query .= " AND aqbudgets.budget_id = ? ";
2408         push @query_params, "$budget";
2409     }
2410
2411     if ( $from_placed_on ) {
2412         $query .= " AND creationdate >= ? ";
2413         push @query_params, $from_placed_on;
2414     }
2415
2416     if ( $to_placed_on ) {
2417         $query .= " AND creationdate <= ? ";
2418         push @query_params, $to_placed_on;
2419     }
2420
2421     if ( defined $orderstatus and $orderstatus ne '') {
2422         $query .= " AND aqorders.orderstatus = ? ";
2423         push @query_params, "$orderstatus";
2424     }
2425
2426     if ($basket) {
2427         if ($basket =~ m/^\d+$/) {
2428             $query .= " AND aqorders.basketno = ? ";
2429             push @query_params, $basket;
2430         } else {
2431             $query .= " AND aqbasket.basketname LIKE ? ";
2432             push @query_params, "%$basket%";
2433         }
2434     }
2435
2436     if ($booksellerinvoicenumber) {
2437         $query .= " AND aqinvoices.invoicenumber LIKE ? ";
2438         push @query_params, "%$booksellerinvoicenumber%";
2439     }
2440
2441     if ($basketgroupname) {
2442         $query .= " AND aqbasketgroups.name LIKE ? ";
2443         push @query_params, "%$basketgroupname%";
2444     }
2445
2446     if ($ordernumber) {
2447         $query .= " AND (aqorders.ordernumber = ? ";
2448         push @query_params, $ordernumber;
2449         if ($search_children_too) {
2450             $query .= " OR aqorders.parent_ordernumber = ? ";
2451             push @query_params, $ordernumber;
2452         }
2453         $query .= ") ";
2454     }
2455
2456
2457     if ( C4::Context->preference("IndependentBranches") ) {
2458         unless ( C4::Context->IsSuperLibrarian() ) {
2459             $query .= " AND (borrowers.branchcode = ? OR borrowers.branchcode ='' ) ";
2460             push @query_params, C4::Context->userenv->{branch};
2461         }
2462     }
2463     $query .= " ORDER BY id";
2464     my $sth = $dbh->prepare($query);
2465     $sth->execute( @query_params );
2466     my $cnt = 1;
2467     while ( my $line = $sth->fetchrow_hashref ) {
2468         $line->{count} = $cnt++;
2469         $line->{toggle} = 1 if $cnt % 2;
2470         push @order_loop, $line;
2471         $total_qty         += ( $line->{quantity} ) ? $line->{quantity} : 0;
2472         $total_qtyreceived += ( $line->{quantityreceived} ) ? $line->{quantityreceived} : 0;
2473         $total_price       += ( $line->{quantity} and $line->{ecost} ) ? $line->{quantity} * $line->{ecost} : 0;
2474     }
2475     return \@order_loop, $total_qty, $total_price, $total_qtyreceived;
2476 }
2477
2478 =head2 GetRecentAcqui
2479
2480   $results = GetRecentAcqui($days);
2481
2482 C<$results> is a ref to a table which containts hashref
2483
2484 =cut
2485
2486 sub GetRecentAcqui {
2487     my $limit  = shift;
2488     my $dbh    = C4::Context->dbh;
2489     my $query = "
2490         SELECT *
2491         FROM   biblio
2492         ORDER BY timestamp DESC
2493         LIMIT  0,".$limit;
2494
2495     my $sth = $dbh->prepare($query);
2496     $sth->execute;
2497     my $results = $sth->fetchall_arrayref({});
2498     return $results;
2499 }
2500
2501 #------------------------------------------------------------#
2502
2503 =head3 AddClaim
2504
2505 =over
2506
2507 &AddClaim($ordernumber);
2508
2509 Add a claim for an order
2510
2511 =back
2512
2513 =cut
2514
2515 sub AddClaim {
2516     my ($ordernumber) = @_;
2517     my $dbh          = C4::Context->dbh;
2518     my $query        = "
2519         UPDATE aqorders SET
2520             claims_count = claims_count + 1,
2521             claimed_date = CURDATE()
2522         WHERE ordernumber = ?
2523         ";
2524     my $sth = $dbh->prepare($query);
2525     $sth->execute($ordernumber);
2526 }
2527
2528 =head3 GetInvoices
2529
2530     my @invoices = GetInvoices(
2531         invoicenumber => $invoicenumber,
2532         supplierid => $supplierid,
2533         suppliername => $suppliername,
2534         shipmentdatefrom => $shipmentdatefrom, # ISO format
2535         shipmentdateto => $shipmentdateto, # ISO format
2536         billingdatefrom => $billingdatefrom, # ISO format
2537         billingdateto => $billingdateto, # ISO format
2538         isbneanissn => $isbn_or_ean_or_issn,
2539         title => $title,
2540         author => $author,
2541         publisher => $publisher,
2542         publicationyear => $publicationyear,
2543         branchcode => $branchcode,
2544         order_by => $order_by
2545     );
2546
2547 Return a list of invoices that match all given criteria.
2548
2549 $order_by is "column_name (asc|desc)", where column_name is any of
2550 'invoicenumber', 'booksellerid', 'shipmentdate', 'billingdate', 'closedate',
2551 'shipmentcost', 'shipmentcost_budgetid'.
2552
2553 asc is the default if omitted
2554
2555 =cut
2556
2557 sub GetInvoices {
2558     my %args = @_;
2559
2560     my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2561         closedate shipmentcost shipmentcost_budgetid);
2562
2563     my $dbh = C4::Context->dbh;
2564     my $query = qq{
2565         SELECT aqinvoices.*, aqbooksellers.name AS suppliername,
2566           COUNT(
2567             DISTINCT IF(
2568               aqorders.datereceived IS NOT NULL,
2569               aqorders.biblionumber,
2570               NULL
2571             )
2572           ) AS receivedbiblios,
2573           COUNT(
2574              DISTINCT IF(
2575               aqorders.subscriptionid IS NOT NULL,
2576               aqorders.subscriptionid,
2577               NULL
2578             )
2579           ) AS is_linked_to_subscriptions,
2580           SUM(aqorders.quantityreceived) AS receiveditems
2581         FROM aqinvoices
2582           LEFT JOIN aqbooksellers ON aqbooksellers.id = aqinvoices.booksellerid
2583           LEFT JOIN aqorders ON aqorders.invoiceid = aqinvoices.invoiceid
2584           LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
2585           LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
2586           LEFT JOIN biblio ON aqorders.biblionumber = biblio.biblionumber
2587           LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
2588           LEFT JOIN subscription ON biblio.biblionumber = subscription.biblionumber
2589     };
2590
2591     my @bind_args;
2592     my @bind_strs;
2593     if($args{supplierid}) {
2594         push @bind_strs, " aqinvoices.booksellerid = ? ";
2595         push @bind_args, $args{supplierid};
2596     }
2597     if($args{invoicenumber}) {
2598         push @bind_strs, " aqinvoices.invoicenumber LIKE ? ";
2599         push @bind_args, "%$args{invoicenumber}%";
2600     }
2601     if($args{suppliername}) {
2602         push @bind_strs, " aqbooksellers.name LIKE ? ";
2603         push @bind_args, "%$args{suppliername}%";
2604     }
2605     if($args{shipmentdatefrom}) {
2606         push @bind_strs, " aqinvoices.shipmentdate >= ? ";
2607         push @bind_args, $args{shipmentdatefrom};
2608     }
2609     if($args{shipmentdateto}) {
2610         push @bind_strs, " aqinvoices.shipmentdate <= ? ";
2611         push @bind_args, $args{shipmentdateto};
2612     }
2613     if($args{billingdatefrom}) {
2614         push @bind_strs, " aqinvoices.billingdate >= ? ";
2615         push @bind_args, $args{billingdatefrom};
2616     }
2617     if($args{billingdateto}) {
2618         push @bind_strs, " aqinvoices.billingdate <= ? ";
2619         push @bind_args, $args{billingdateto};
2620     }
2621     if($args{isbneanissn}) {
2622         push @bind_strs, " (biblioitems.isbn LIKE CONCAT('%', ?, '%') OR biblioitems.ean LIKE CONCAT('%', ?, '%') OR biblioitems.issn LIKE CONCAT('%', ?, '%') ) ";
2623         push @bind_args, $args{isbneanissn}, $args{isbneanissn}, $args{isbneanissn};
2624     }
2625     if($args{title}) {
2626         push @bind_strs, " biblio.title LIKE CONCAT('%', ?, '%') ";
2627         push @bind_args, $args{title};
2628     }
2629     if($args{author}) {
2630         push @bind_strs, " biblio.author LIKE CONCAT('%', ?, '%') ";
2631         push @bind_args, $args{author};
2632     }
2633     if($args{publisher}) {
2634         push @bind_strs, " biblioitems.publishercode LIKE CONCAT('%', ?, '%') ";
2635         push @bind_args, $args{publisher};
2636     }
2637     if($args{publicationyear}) {
2638         push @bind_strs, " ((biblioitems.publicationyear LIKE CONCAT('%', ?, '%')) OR (biblio.copyrightdate LIKE CONCAT('%', ?, '%'))) ";
2639         push @bind_args, $args{publicationyear}, $args{publicationyear};
2640     }
2641     if($args{branchcode}) {
2642         push @bind_strs, " borrowers.branchcode = ? ";
2643         push @bind_args, $args{branchcode};
2644     }
2645
2646     $query .= " WHERE " . join(" AND ", @bind_strs) if @bind_strs;
2647     $query .= " GROUP BY aqinvoices.invoiceid ";
2648
2649     if($args{order_by}) {
2650         my ($column, $direction) = split / /, $args{order_by};
2651         if(grep /^$column$/, @columns) {
2652             $direction ||= 'ASC';
2653             $query .= " ORDER BY $column $direction";
2654         }
2655     }
2656
2657     my $sth = $dbh->prepare($query);
2658     $sth->execute(@bind_args);
2659
2660     my $results = $sth->fetchall_arrayref({});
2661     return @$results;
2662 }
2663
2664 =head3 GetInvoice
2665
2666     my $invoice = GetInvoice($invoiceid);
2667
2668 Get informations about invoice with given $invoiceid
2669
2670 Return a hash filled with aqinvoices.* fields
2671
2672 =cut
2673
2674 sub GetInvoice {
2675     my ($invoiceid) = @_;
2676     my $invoice;
2677
2678     return unless $invoiceid;
2679
2680     my $dbh = C4::Context->dbh;
2681     my $query = qq{
2682         SELECT *
2683         FROM aqinvoices
2684         WHERE invoiceid = ?
2685     };
2686     my $sth = $dbh->prepare($query);
2687     $sth->execute($invoiceid);
2688
2689     $invoice = $sth->fetchrow_hashref;
2690     return $invoice;
2691 }
2692
2693 =head3 GetInvoiceDetails
2694
2695     my $invoice = GetInvoiceDetails($invoiceid)
2696
2697 Return informations about an invoice + the list of related order lines
2698
2699 Orders informations are in $invoice->{orders} (array ref)
2700
2701 =cut
2702
2703 sub GetInvoiceDetails {
2704     my ($invoiceid) = @_;
2705
2706     if ( !defined $invoiceid ) {
2707         carp 'GetInvoiceDetails called without an invoiceid';
2708         return;
2709     }
2710
2711     my $dbh = C4::Context->dbh;
2712     my $query = q{
2713         SELECT aqinvoices.*, aqbooksellers.name AS suppliername
2714         FROM aqinvoices
2715           LEFT JOIN aqbooksellers ON aqinvoices.booksellerid = aqbooksellers.id
2716         WHERE invoiceid = ?
2717     };
2718     my $sth = $dbh->prepare($query);
2719     $sth->execute($invoiceid);
2720
2721     my $invoice = $sth->fetchrow_hashref;
2722
2723     $query = q{
2724         SELECT aqorders.*, biblio.*, aqbasket.basketname
2725         FROM aqorders
2726           LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
2727           LEFT JOIN biblio ON aqorders.biblionumber = biblio.biblionumber
2728         WHERE invoiceid = ?
2729     };
2730     $sth = $dbh->prepare($query);
2731     $sth->execute($invoiceid);
2732     $invoice->{orders} = $sth->fetchall_arrayref({});
2733     $invoice->{orders} ||= []; # force an empty arrayref if fetchall_arrayref fails
2734
2735     return $invoice;
2736 }
2737
2738 =head3 AddInvoice
2739
2740     my $invoiceid = AddInvoice(
2741         invoicenumber => $invoicenumber,
2742         booksellerid => $booksellerid,
2743         shipmentdate => $shipmentdate,
2744         billingdate => $billingdate,
2745         closedate => $closedate,
2746         shipmentcost => $shipmentcost,
2747         shipmentcost_budgetid => $shipmentcost_budgetid
2748     );
2749
2750 Create a new invoice and return its id or undef if it fails.
2751
2752 =cut
2753
2754 sub AddInvoice {
2755     my %invoice = @_;
2756
2757     return unless(%invoice and $invoice{invoicenumber});
2758
2759     my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2760         closedate shipmentcost shipmentcost_budgetid);
2761
2762     my @set_strs;
2763     my @set_args;
2764     foreach my $key (keys %invoice) {
2765         if(0 < grep(/^$key$/, @columns)) {
2766             push @set_strs, "$key = ?";
2767             push @set_args, ($invoice{$key} || undef);
2768         }
2769     }
2770
2771     my $rv;
2772     if(@set_args > 0) {
2773         my $dbh = C4::Context->dbh;
2774         my $query = "INSERT INTO aqinvoices SET ";
2775         $query .= join (",", @set_strs);
2776         my $sth = $dbh->prepare($query);
2777         $rv = $sth->execute(@set_args);
2778         if($rv) {
2779             $rv = $dbh->last_insert_id(undef, undef, 'aqinvoices', undef);
2780         }
2781     }
2782     return $rv;
2783 }
2784
2785 =head3 ModInvoice
2786
2787     ModInvoice(
2788         invoiceid => $invoiceid,    # Mandatory
2789         invoicenumber => $invoicenumber,
2790         booksellerid => $booksellerid,
2791         shipmentdate => $shipmentdate,
2792         billingdate => $billingdate,
2793         closedate => $closedate,
2794         shipmentcost => $shipmentcost,
2795         shipmentcost_budgetid => $shipmentcost_budgetid
2796     );
2797
2798 Modify an invoice, invoiceid is mandatory.
2799
2800 Return undef if it fails.
2801
2802 =cut
2803
2804 sub ModInvoice {
2805     my %invoice = @_;
2806
2807     return unless(%invoice and $invoice{invoiceid});
2808
2809     my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2810         closedate shipmentcost shipmentcost_budgetid);
2811
2812     my @set_strs;
2813     my @set_args;
2814     foreach my $key (keys %invoice) {
2815         if(0 < grep(/^$key$/, @columns)) {
2816             push @set_strs, "$key = ?";
2817             push @set_args, ($invoice{$key} || undef);
2818         }
2819     }
2820
2821     my $dbh = C4::Context->dbh;
2822     my $query = "UPDATE aqinvoices SET ";
2823     $query .= join(",", @set_strs);
2824     $query .= " WHERE invoiceid = ?";
2825
2826     my $sth = $dbh->prepare($query);
2827     $sth->execute(@set_args, $invoice{invoiceid});
2828 }
2829
2830 =head3 CloseInvoice
2831
2832     CloseInvoice($invoiceid);
2833
2834 Close an invoice.
2835
2836 Equivalent to ModInvoice(invoiceid => $invoiceid, closedate => undef);
2837
2838 =cut
2839
2840 sub CloseInvoice {
2841     my ($invoiceid) = @_;
2842
2843     return unless $invoiceid;
2844
2845     my $dbh = C4::Context->dbh;
2846     my $query = qq{
2847         UPDATE aqinvoices
2848         SET closedate = CAST(NOW() AS DATE)
2849         WHERE invoiceid = ?
2850     };
2851     my $sth = $dbh->prepare($query);
2852     $sth->execute($invoiceid);
2853 }
2854
2855 =head3 ReopenInvoice
2856
2857     ReopenInvoice($invoiceid);
2858
2859 Reopen an invoice
2860
2861 Equivalent to ModInvoice(invoiceid => $invoiceid, closedate => C4::Dates->new()->output('iso'))
2862
2863 =cut
2864
2865 sub ReopenInvoice {
2866     my ($invoiceid) = @_;
2867
2868     return unless $invoiceid;
2869
2870     my $dbh = C4::Context->dbh;
2871     my $query = qq{
2872         UPDATE aqinvoices
2873         SET closedate = NULL
2874         WHERE invoiceid = ?
2875     };
2876     my $sth = $dbh->prepare($query);
2877     $sth->execute($invoiceid);
2878 }
2879
2880 =head3 DelInvoice
2881
2882     DelInvoice($invoiceid);
2883
2884 Delete an invoice if there are no items attached to it.
2885
2886 =cut
2887
2888 sub DelInvoice {
2889     my ($invoiceid) = @_;
2890
2891     return unless $invoiceid;
2892
2893     my $dbh   = C4::Context->dbh;
2894     my $query = qq{
2895         SELECT COUNT(*)
2896         FROM aqorders
2897         WHERE invoiceid = ?
2898     };
2899     my $sth = $dbh->prepare($query);
2900     $sth->execute($invoiceid);
2901     my $res = $sth->fetchrow_arrayref;
2902     if ( $res && $res->[0] == 0 ) {
2903         $query = qq{
2904             DELETE FROM aqinvoices
2905             WHERE invoiceid = ?
2906         };
2907         my $sth = $dbh->prepare($query);
2908         return ( $sth->execute($invoiceid) > 0 );
2909     }
2910     return;
2911 }
2912
2913 =head3 MergeInvoices
2914
2915     MergeInvoices($invoiceid, \@sourceids);
2916
2917 Merge the invoices identified by the IDs in \@sourceids into
2918 the invoice identified by $invoiceid.
2919
2920 =cut
2921
2922 sub MergeInvoices {
2923     my ($invoiceid, $sourceids) = @_;
2924
2925     return unless $invoiceid;
2926     foreach my $sourceid (@$sourceids) {
2927         next if $sourceid == $invoiceid;
2928         my $source = GetInvoiceDetails($sourceid);
2929         foreach my $order (@{$source->{'orders'}}) {
2930             $order->{'invoiceid'} = $invoiceid;
2931             ModOrder($order);
2932         }
2933         DelInvoice($source->{'invoiceid'});
2934     }
2935     return;
2936 }
2937
2938 =head3 GetBiblioCountByBasketno
2939
2940 $biblio_count = &GetBiblioCountByBasketno($basketno);
2941
2942 Looks up the biblio's count that has basketno value $basketno
2943
2944 Returns a quantity
2945
2946 =cut
2947
2948 sub GetBiblioCountByBasketno {
2949     my ($basketno) = @_;
2950     my $dbh          = C4::Context->dbh;
2951     my $query        = "
2952         SELECT COUNT( DISTINCT( biblionumber ) )
2953         FROM   aqorders
2954         WHERE  basketno = ?
2955             AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00')
2956         ";
2957
2958     my $sth = $dbh->prepare($query);
2959     $sth->execute($basketno);
2960     return $sth->fetchrow;
2961 }
2962
2963 1;
2964 __END__
2965
2966 =head1 AUTHOR
2967
2968 Koha Development Team <http://koha-community.org/>
2969
2970 =cut