C4/Acquisition.pm

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