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                 aqorders_transfers.ordernumber_from AS transferred_from,
 944                 aqorders_transfers.timestamp AS transferred_from_timestamp
 945         FROM    aqorders
 946             LEFT JOIN aqbudgets        ON aqbudgets.budget_id = aqorders.budget_id
 947             LEFT JOIN biblio           ON biblio.biblionumber = aqorders.biblionumber
 948             LEFT JOIN biblioitems      ON biblioitems.biblionumber =biblio.biblionumber
 949             LEFT JOIN aqorders_transfers ON aqorders_transfers.ordernumber_to = aqorders.ordernumber
 950         WHERE   basketno=?
 951             AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00')
 952     ";
 953
 954     $orderby = "biblioitems.publishercode,biblio.title" unless $orderby;
 955     $query .= " ORDER BY $orderby";
 956     my $sth = $dbh->prepare($query);
 957     $sth->execute($basketno);
 958     my $results = $sth->fetchall_arrayref({});
 959     $sth->finish;
 960     return @$results;
 961 }
 962
 963 #------------------------------------------------------------#
 964 =head3 GetOrdersByBiblionumber
 965
 966   @orders = &GetOrdersByBiblionumber($biblionumber);
 967
 968 Looks up the orders with linked to a specific $biblionumber, including
 969 cancelled orders and received orders.
 970
 971 return :
 972 C<@orders> is an array of references-to-hash, whose keys are the
 973 fields from the aqorders, biblio, and biblioitems tables in the Koha database.
 974
 975 =cut
 976
 977 sub GetOrdersByBiblionumber {
 978     my $biblionumber = shift;
 979     return unless $biblionumber;
 980     my $dbh   = C4::Context->dbh;
 981     my $query  ="
 982         SELECT biblio.*,biblioitems.*,
 983                 aqorders.*,
 984                 aqbudgets.*
 985         FROM    aqorders
 986             LEFT JOIN aqbudgets        ON aqbudgets.budget_id = aqorders.budget_id
 987             LEFT JOIN biblio           ON biblio.biblionumber = aqorders.biblionumber
 988             LEFT JOIN biblioitems      ON biblioitems.biblionumber =biblio.biblionumber
 989         WHERE   aqorders.biblionumber=?
 990     ";
 991     my $sth = $dbh->prepare($query);
 992     $sth->execute($biblionumber);
 993     my $results = $sth->fetchall_arrayref({});
 994     $sth->finish;
 995     return @$results;
 996 }
 997
 998 #------------------------------------------------------------#
 999
1000 =head3 GetOrder
1001
1002   $order = &GetOrder($ordernumber);
1003
1004 Looks up an order by order number.
1005
1006 Returns a reference-to-hash describing the order. The keys of
1007 C<$order> are fields from the biblio, biblioitems, aqorders tables of the Koha database.
1008
1009 =cut
1010
1011 sub GetOrder {
1012     my ($ordernumber) = @_;
1013     my $dbh      = C4::Context->dbh;
1014     my $query = "
1015         SELECT biblioitems.*, biblio.*, aqorders.*
1016         FROM   aqorders
1017         LEFT JOIN biblio on           biblio.biblionumber=aqorders.biblionumber
1018         LEFT JOIN biblioitems on       biblioitems.biblionumber=aqorders.biblionumber
1019         WHERE aqorders.ordernumber=?
1020
1021     ";
1022     my $sth= $dbh->prepare($query);
1023     $sth->execute($ordernumber);
1024     my $data = $sth->fetchrow_hashref;
1025     $sth->finish;
1026     return $data;
1027 }
1028
1029 =head3 GetLastOrderNotReceivedFromSubscriptionid
1030
1031   $order = &GetLastOrderNotReceivedFromSubscriptionid($subscriptionid);
1032
1033 Returns a reference-to-hash describing the last order not received for a subscription.
1034
1035 =cut
1036
1037 sub GetLastOrderNotReceivedFromSubscriptionid {
1038     my ( $subscriptionid ) = @_;
1039     my $dbh                = C4::Context->dbh;
1040     my $query              = qq|
1041         SELECT * FROM aqorders
1042         LEFT JOIN subscription
1043             ON ( aqorders.subscriptionid = subscription.subscriptionid )
1044         WHERE aqorders.subscriptionid = ?
1045             AND aqorders.datereceived IS NULL
1046         LIMIT 1
1047     |;
1048     my $sth = $dbh->prepare( $query );
1049     $sth->execute( $subscriptionid );
1050     my $order = $sth->fetchrow_hashref;
1051     return $order;
1052 }
1053
1054 =head3 GetLastOrderReceivedFromSubscriptionid
1055
1056   $order = &GetLastOrderReceivedFromSubscriptionid($subscriptionid);
1057
1058 Returns a reference-to-hash describing the last order received for a subscription.
1059
1060 =cut
1061
1062 sub GetLastOrderReceivedFromSubscriptionid {
1063     my ( $subscriptionid ) = @_;
1064     my $dbh                = C4::Context->dbh;
1065     my $query              = qq|
1066         SELECT * FROM aqorders
1067         LEFT JOIN subscription
1068             ON ( aqorders.subscriptionid = subscription.subscriptionid )
1069         WHERE aqorders.subscriptionid = ?
1070             AND aqorders.datereceived =
1071                 (
1072                     SELECT MAX( aqorders.datereceived )
1073                     FROM aqorders
1074                     LEFT JOIN subscription
1075                         ON ( aqorders.subscriptionid = subscription.subscriptionid )
1076                         WHERE aqorders.subscriptionid = ?
1077                             AND aqorders.datereceived IS NOT NULL
1078                 )
1079         ORDER BY ordernumber DESC
1080         LIMIT 1
1081     |;
1082     my $sth = $dbh->prepare( $query );
1083     $sth->execute( $subscriptionid, $subscriptionid );
1084     my $order = $sth->fetchrow_hashref;
1085     return $order;
1086
1087 }
1088
1089
1090 #------------------------------------------------------------#
1091
1092 =head3 NewOrder
1093
1094   &NewOrder(\%hashref);
1095
1096 Adds a new order to the database. Any argument that isn't described
1097 below is the new value of the field with the same name in the aqorders
1098 table of the Koha database.
1099
1100 =over
1101
1102 =item $hashref->{'basketno'} is the basketno foreign key in aqorders, it is mandatory
1103
1104 =item $hashref->{'ordernumber'} is a "minimum order number."
1105
1106 =item $hashref->{'budgetdate'} is effectively ignored.
1107 If it's undef (anything false) or the string 'now', the current day is used.
1108 Else, the upcoming July 1st is used.
1109
1110 =item $hashref->{'subscription'} may be either "yes", or anything else for "no".
1111
1112 =item $hashref->{'uncertainprice'} may be 0 for "the price is known" or 1 for "the price is uncertain"
1113
1114 =item defaults entrydate to Now
1115
1116 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".
1117
1118 =back
1119
1120 =cut
1121
1122 sub NewOrder {
1123     my $orderinfo = shift;
1124 #### ------------------------------
1125     my $dbh = C4::Context->dbh;
1126     my @params;
1127
1128
1129     # if these parameters are missing, we can't continue
1130     for my $key (qw/basketno quantity biblionumber budget_id/) {
1131         croak "Mandatory parameter $key missing" unless $orderinfo->{$key};
1132     }
1133
1134     if ( defined $orderinfo->{subscription} && $orderinfo->{'subscription'} eq 'yes' ) {
1135         $orderinfo->{'subscription'} = 1;
1136     } else {
1137         $orderinfo->{'subscription'} = 0;
1138     }
1139     $orderinfo->{'entrydate'} ||= C4::Dates->new()->output("iso");
1140     if (!$orderinfo->{quantityreceived}) {
1141         $orderinfo->{quantityreceived} = 0;
1142     }
1143
1144     my $ordernumber=InsertInTable("aqorders",$orderinfo);
1145     if (not $orderinfo->{parent_ordernumber}) {
1146         my $sth = $dbh->prepare("
1147             UPDATE aqorders
1148             SET parent_ordernumber = ordernumber
1149             WHERE ordernumber = ?
1150         ");
1151         $sth->execute($ordernumber);
1152     }
1153     return ( $orderinfo->{'basketno'}, $ordernumber );
1154 }
1155
1156
1157
1158 #------------------------------------------------------------#
1159
1160 =head3 NewOrderItem
1161
1162   &NewOrderItem();
1163
1164 =cut
1165
1166 sub NewOrderItem {
1167     my ($itemnumber, $ordernumber)  = @_;
1168     my $dbh = C4::Context->dbh;
1169     my $query = qq|
1170             INSERT INTO aqorders_items
1171                 (itemnumber, ordernumber)
1172             VALUES (?,?)    |;
1173
1174     my $sth = $dbh->prepare($query);
1175     $sth->execute( $itemnumber, $ordernumber);
1176 }
1177
1178 #------------------------------------------------------------#
1179
1180 =head3 ModOrder
1181
1182   &ModOrder(\%hashref);
1183
1184 Modifies an existing order. Updates the order with order number
1185 $hashref->{'ordernumber'} and biblionumber $hashref->{'biblionumber'}. All
1186 other keys of the hash update the fields with the same name in the aqorders
1187 table of the Koha database.
1188
1189 =cut
1190
1191 sub ModOrder {
1192     my $orderinfo = shift;
1193
1194     die "Ordernumber is required"     if $orderinfo->{'ordernumber'} eq  '' ;
1195     die "Biblionumber is required"  if  $orderinfo->{'biblionumber'} eq '';
1196
1197     my $dbh = C4::Context->dbh;
1198     my @params;
1199
1200     # update uncertainprice to an integer, just in case (under FF, checked boxes have the value "ON" by default)
1201     $orderinfo->{uncertainprice}=1 if $orderinfo->{uncertainprice};
1202
1203 #    delete($orderinfo->{'branchcode'});
1204     # the hash contains a lot of entries not in aqorders, so get the columns ...
1205     my $sth = $dbh->prepare("SELECT * FROM aqorders LIMIT 1;");
1206     $sth->execute;
1207     my $colnames = $sth->{NAME};
1208         #FIXME Be careful. If aqorders would have columns with diacritics,
1209         #you should need to decode what you get back from NAME.
1210         #See report 10110 and guided_reports.pl
1211     my $query = "UPDATE aqorders SET ";
1212
1213     foreach my $orderinfokey (grep(!/ordernumber/, keys %$orderinfo)){
1214         # ... and skip hash entries that are not in the aqorders table
1215         # FIXME : probably not the best way to do it (would be better to have a correct hash)
1216         next unless grep(/^$orderinfokey$/, @$colnames);
1217             $query .= "$orderinfokey=?, ";
1218             push(@params, $orderinfo->{$orderinfokey});
1219     }
1220
1221     $query .= "timestamp=NOW()  WHERE  ordernumber=?";
1222 #   push(@params, $specorderinfo{'ordernumber'});
1223     push(@params, $orderinfo->{'ordernumber'} );
1224     $sth = $dbh->prepare($query);
1225     $sth->execute(@params);
1226     $sth->finish;
1227 }
1228
1229 #------------------------------------------------------------#
1230
1231 =head3 ModItemOrder
1232
1233     ModItemOrder($itemnumber, $ordernumber);
1234
1235 Modifies the ordernumber of an item in aqorders_items.
1236
1237 =cut
1238
1239 sub ModItemOrder {
1240     my ($itemnumber, $ordernumber) = @_;
1241
1242     return unless ($itemnumber and $ordernumber);
1243
1244     my $dbh = C4::Context->dbh;
1245     my $query = qq{
1246         UPDATE aqorders_items
1247         SET ordernumber = ?
1248         WHERE itemnumber = ?
1249     };
1250     my $sth = $dbh->prepare($query);
1251     return $sth->execute($ordernumber, $itemnumber);
1252 }
1253
1254 #------------------------------------------------------------#
1255
1256 =head3 GetCancelledOrders
1257
1258   my @orders = GetCancelledOrders($basketno, $orderby);
1259
1260 Returns cancelled orders for a basket
1261
1262 =cut
1263
1264 sub GetCancelledOrders {
1265     my ( $basketno, $orderby ) = @_;
1266
1267     return () unless $basketno;
1268
1269     my $dbh   = C4::Context->dbh;
1270     my $query = "
1271         SELECT
1272             biblio.*,
1273             biblioitems.*,
1274             aqorders.*,
1275             aqbudgets.*,
1276             aqorders_transfers.ordernumber_to AS transferred_to,
1277             aqorders_transfers.timestamp AS transferred_to_timestamp
1278         FROM aqorders
1279           LEFT JOIN aqbudgets   ON aqbudgets.budget_id = aqorders.budget_id
1280           LEFT JOIN biblio      ON biblio.biblionumber = aqorders.biblionumber
1281           LEFT JOIN biblioitems ON biblioitems.biblionumber = biblio.biblionumber
1282           LEFT JOIN aqorders_transfers ON aqorders_transfers.ordernumber_from = aqorders.ordernumber
1283         WHERE basketno = ?
1284           AND (datecancellationprinted IS NOT NULL
1285                AND datecancellationprinted <> '0000-00-00')
1286     ";
1287
1288     $orderby = "aqorders.datecancellationprinted desc, aqorders.timestamp desc"
1289         unless $orderby;
1290     $query .= " ORDER BY $orderby";
1291     my $sth = $dbh->prepare($query);
1292     $sth->execute($basketno);
1293     my $results = $sth->fetchall_arrayref( {} );
1294
1295     return @$results;
1296 }
1297
1298
1299 #------------------------------------------------------------#
1300
1301 =head3 ModReceiveOrder
1302
1303   &ModReceiveOrder($biblionumber, $ordernumber, $quantityreceived, $user,
1304     $cost, $ecost, $invoiceid, rrp, budget_id, datereceived, \@received_itemnumbers);
1305
1306 Updates an order, to reflect the fact that it was received, at least
1307 in part. All arguments not mentioned below update the fields with the
1308 same name in the aqorders table of the Koha database.
1309
1310 If a partial order is received, splits the order into two.
1311
1312 Updates the order with bibilionumber C<$biblionumber> and ordernumber
1313 C<$ordernumber>.
1314
1315 =cut
1316
1317
1318 sub ModReceiveOrder {
1319     my (
1320         $biblionumber,    $ordernumber,  $quantrec, $user, $cost, $ecost,
1321         $invoiceid, $rrp, $budget_id, $datereceived, $received_items
1322     )
1323     = @_;
1324
1325     my $dbh = C4::Context->dbh;
1326     $datereceived = C4::Dates->output('iso') unless $datereceived;
1327     my $suggestionid = GetSuggestionFromBiblionumber( $biblionumber );
1328     if ($suggestionid) {
1329         ModSuggestion( {suggestionid=>$suggestionid,
1330                         STATUS=>'AVAILABLE',
1331                         biblionumber=> $biblionumber}
1332                         );
1333     }
1334
1335     my $sth=$dbh->prepare("
1336         SELECT * FROM   aqorders
1337         WHERE           biblionumber=? AND aqorders.ordernumber=?");
1338
1339     $sth->execute($biblionumber,$ordernumber);
1340     my $order = $sth->fetchrow_hashref();
1341     $sth->finish();
1342
1343     my $new_ordernumber = $ordernumber;
1344     if ( $order->{quantity} > $quantrec ) {
1345         # Split order line in two parts: the first is the original order line
1346         # without received items (the quantity is decreased),
1347         # the second part is a new order line with quantity=quantityrec
1348         # (entirely received)
1349         $sth=$dbh->prepare("
1350             UPDATE aqorders
1351             SET quantity = ?
1352             WHERE ordernumber = ?
1353         ");
1354
1355         $sth->execute($order->{quantity} - $quantrec, $ordernumber);
1356
1357         $sth->finish;
1358
1359         delete $order->{'ordernumber'};
1360         $order->{'quantity'} = $quantrec;
1361         $order->{'quantityreceived'} = $quantrec;
1362         $order->{'datereceived'} = $datereceived;
1363         $order->{'invoiceid'} = $invoiceid;
1364         $order->{'unitprice'} = $cost;
1365         $order->{'rrp'} = $rrp;
1366         $order->{ecost} = $ecost;
1367         $order->{'orderstatus'} = 3;    # totally received
1368         my $basketno;
1369         ( $basketno, $new_ordernumber ) = NewOrder($order);
1370
1371         if ($received_items) {
1372             foreach my $itemnumber (@$received_items) {
1373                 ModItemOrder($itemnumber, $new_ordernumber);
1374             }
1375         }
1376     } else {
1377         $sth=$dbh->prepare("update aqorders
1378                             set quantityreceived=?,datereceived=?,invoiceid=?,
1379                                 unitprice=?,rrp=?,ecost=?
1380                             where biblionumber=? and ordernumber=?");
1381         $sth->execute($quantrec,$datereceived,$invoiceid,$cost,$rrp,$ecost,$biblionumber,$ordernumber);
1382         $sth->finish;
1383     }
1384     return ($datereceived, $new_ordernumber);
1385 }
1386
1387 =head3 CancelReceipt
1388
1389     my $parent_ordernumber = CancelReceipt($ordernumber);
1390
1391     Cancel an order line receipt and update the parent order line, as if no
1392     receipt was made.
1393     If items are created at receipt (AcqCreateItem = receiving) then delete
1394     these items.
1395
1396 =cut
1397
1398 sub CancelReceipt {
1399     my $ordernumber = shift;
1400
1401     return unless $ordernumber;
1402
1403     my $dbh = C4::Context->dbh;
1404     my $query = qq{
1405         SELECT datereceived, parent_ordernumber, quantity
1406         FROM aqorders
1407         WHERE ordernumber = ?
1408     };
1409     my $sth = $dbh->prepare($query);
1410     $sth->execute($ordernumber);
1411     my $order = $sth->fetchrow_hashref;
1412     unless($order) {
1413         warn "CancelReceipt: order $ordernumber does not exist";
1414         return;
1415     }
1416     unless($order->{'datereceived'}) {
1417         warn "CancelReceipt: order $ordernumber is not received";
1418         return;
1419     }
1420
1421     my $parent_ordernumber = $order->{'parent_ordernumber'};
1422
1423     if($parent_ordernumber == $ordernumber || not $parent_ordernumber) {
1424         # The order line has no parent, just mark it as not received
1425         $query = qq{
1426             UPDATE aqorders
1427             SET quantityreceived = ?,
1428                 datereceived = ?,
1429                 invoiceid = ?
1430             WHERE ordernumber = ?
1431         };
1432         $sth = $dbh->prepare($query);
1433         $sth->execute(0, undef, undef, $ordernumber);
1434     } else {
1435         # The order line has a parent, increase parent quantity and delete
1436         # the order line.
1437         $query = qq{
1438             SELECT quantity, datereceived
1439             FROM aqorders
1440             WHERE ordernumber = ?
1441         };
1442         $sth = $dbh->prepare($query);
1443         $sth->execute($parent_ordernumber);
1444         my $parent_order = $sth->fetchrow_hashref;
1445         unless($parent_order) {
1446             warn "Parent order $parent_ordernumber does not exist.";
1447             return;
1448         }
1449         if($parent_order->{'datereceived'}) {
1450             warn "CancelReceipt: parent order is received.".
1451                 " Can't cancel receipt.";
1452             return;
1453         }
1454         $query = qq{
1455             UPDATE aqorders
1456             SET quantity = ?
1457             WHERE ordernumber = ?
1458         };
1459         $sth = $dbh->prepare($query);
1460         my $rv = $sth->execute(
1461             $order->{'quantity'} + $parent_order->{'quantity'},
1462             $parent_ordernumber
1463         );
1464         unless($rv) {
1465             warn "Cannot update parent order line, so do not cancel".
1466                 " receipt";
1467             return;
1468         }
1469         if(C4::Context->preference('AcqCreateItem') eq 'receiving') {
1470             # Remove items that were created at receipt
1471             $query = qq{
1472                 DELETE FROM items, aqorders_items
1473                 USING items, aqorders_items
1474                 WHERE items.itemnumber = ? AND aqorders_items.itemnumber = ?
1475             };
1476             $sth = $dbh->prepare($query);
1477             my @itemnumbers = GetItemnumbersFromOrder($ordernumber);
1478             foreach my $itemnumber (@itemnumbers) {
1479                 $sth->execute($itemnumber, $itemnumber);
1480             }
1481         } else {
1482             # Update items
1483             my @itemnumbers = GetItemnumbersFromOrder($ordernumber);
1484             foreach my $itemnumber (@itemnumbers) {
1485                 ModItemOrder($itemnumber, $parent_ordernumber);
1486             }
1487         }
1488         # Delete order line
1489         $query = qq{
1490             DELETE FROM aqorders
1491             WHERE ordernumber = ?
1492         };
1493         $sth = $dbh->prepare($query);
1494         $sth->execute($ordernumber);
1495
1496     }
1497
1498     return $parent_ordernumber;
1499 }
1500
1501 #------------------------------------------------------------#
1502
1503 =head3 SearchOrder
1504
1505 @results = &SearchOrder($search, $biblionumber, $complete);
1506
1507 Searches for orders.
1508
1509 C<$search> may take one of several forms: if it is an ISBN,
1510 C<&ordersearch> returns orders with that ISBN. If C<$search> is an
1511 order number, C<&ordersearch> returns orders with that order number
1512 and biblionumber C<$biblionumber>. Otherwise, C<$search> is considered
1513 to be a space-separated list of search terms; in this case, all of the
1514 terms must appear in the title (matching the beginning of title
1515 words).
1516
1517 If C<$complete> is C<yes>, the results will include only completed
1518 orders. In any case, C<&ordersearch> ignores cancelled orders.
1519
1520 C<&ordersearch> returns an array.
1521 C<@results> is an array of references-to-hash with the following keys:
1522
1523 =over 4
1524
1525 =item C<author>
1526
1527 =item C<seriestitle>
1528
1529 =item C<branchcode>
1530
1531 =item C<budget_id>
1532
1533 =back
1534
1535 =cut
1536
1537 sub SearchOrder {
1538 #### -------- SearchOrder-------------------------------
1539     my ( $ordernumber, $search, $ean, $supplierid, $basket ) = @_;
1540
1541     my $dbh = C4::Context->dbh;
1542     my @args = ();
1543     my $query =
1544             "SELECT *
1545             FROM aqorders
1546             LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1547             LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
1548             LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
1549                 WHERE  (datecancellationprinted is NULL)";
1550
1551     if($ordernumber){
1552         $query .= " AND (aqorders.ordernumber=?)";
1553         push @args, $ordernumber;
1554     }
1555     if($search){
1556         $query .= " AND (biblio.title like ? OR biblio.author LIKE ? OR biblioitems.isbn like ?)";
1557         push @args, ("%$search%","%$search%","%$search%");
1558     }
1559     if ($ean) {
1560         $query .= " AND biblioitems.ean = ?";
1561         push @args, $ean;
1562     }
1563     if ($supplierid) {
1564         $query .= "AND aqbasket.booksellerid = ?";
1565         push @args, $supplierid;
1566     }
1567     if($basket){
1568         $query .= "AND aqorders.basketno = ?";
1569         push @args, $basket;
1570     }
1571
1572     my $sth = $dbh->prepare($query);
1573     $sth->execute(@args);
1574     my $results = $sth->fetchall_arrayref({});
1575     $sth->finish;
1576     return $results;
1577 }
1578
1579 #------------------------------------------------------------#
1580
1581 =head3 DelOrder
1582
1583   &DelOrder($biblionumber, $ordernumber);
1584
1585 Cancel the order with the given order and biblio numbers. It does not
1586 delete any entries in the aqorders table, it merely marks them as
1587 cancelled.
1588
1589 =cut
1590
1591 sub DelOrder {
1592     my ( $bibnum, $ordernumber ) = @_;
1593     my $dbh = C4::Context->dbh;
1594     my $query = "
1595         UPDATE aqorders
1596         SET    datecancellationprinted=now()
1597         WHERE  biblionumber=? AND ordernumber=?
1598     ";
1599     my $sth = $dbh->prepare($query);
1600     $sth->execute( $bibnum, $ordernumber );
1601     $sth->finish;
1602     my @itemnumbers = GetItemnumbersFromOrder( $ordernumber );
1603     foreach my $itemnumber (@itemnumbers){
1604         C4::Items::DelItem( $dbh, $bibnum, $itemnumber );
1605     }
1606
1607 }
1608
1609 =head3 TransferOrder
1610
1611     my $newordernumber = TransferOrder($ordernumber, $basketno);
1612
1613 Transfer an order line to a basket.
1614 Mark $ordernumber as cancelled with an internal note 'Cancelled and transfered
1615 to BOOKSELLER on DATE' and create new order with internal note
1616 'Transfered from BOOKSELLER on DATE'.
1617 Move all attached items to the new order.
1618 Received orders cannot be transfered.
1619 Return the ordernumber of created order.
1620
1621 =cut
1622
1623 sub TransferOrder {
1624     my ($ordernumber, $basketno) = @_;
1625
1626     return unless ($ordernumber and $basketno);
1627
1628     my $order = GetOrder( $ordernumber );
1629     return if $order->{datereceived};
1630     my $basket = GetBasket($basketno);
1631     return unless $basket;
1632
1633     my $dbh = C4::Context->dbh;
1634     my ($query, $sth, $rv);
1635
1636     $query = qq{
1637         UPDATE aqorders
1638         SET datecancellationprinted = CAST(NOW() AS date)
1639         WHERE ordernumber = ?
1640     };
1641     $sth = $dbh->prepare($query);
1642     $rv = $sth->execute($ordernumber);
1643
1644     delete $order->{'ordernumber'};
1645     $order->{'basketno'} = $basketno;
1646     my $newordernumber;
1647     (undef, $newordernumber) = NewOrder($order);
1648
1649     $query = qq{
1650         UPDATE aqorders_items
1651         SET ordernumber = ?
1652         WHERE ordernumber = ?
1653     };
1654     $sth = $dbh->prepare($query);
1655     $sth->execute($newordernumber, $ordernumber);
1656
1657     $query = q{
1658         INSERT INTO aqorders_transfers (ordernumber_from, ordernumber_to)
1659         VALUES (?, ?)
1660     };
1661     $sth = $dbh->prepare($query);
1662     $sth->execute($ordernumber, $newordernumber);
1663
1664     return $newordernumber;
1665 }
1666
1667 =head2 FUNCTIONS ABOUT PARCELS
1668
1669 =cut
1670
1671 #------------------------------------------------------------#
1672
1673 =head3 GetParcel
1674
1675   @results = &GetParcel($booksellerid, $code, $date);
1676
1677 Looks up all of the received items from the supplier with the given
1678 bookseller ID at the given date, for the given code (bookseller Invoice number). Ignores cancelled and completed orders.
1679
1680 C<@results> is an array of references-to-hash. The keys of each element are fields from
1681 the aqorders, biblio, and biblioitems tables of the Koha database.
1682
1683 C<@results> is sorted alphabetically by book title.
1684
1685 =cut
1686
1687 sub GetParcel {
1688     #gets all orders from a certain supplier, orders them alphabetically
1689     my ( $supplierid, $code, $datereceived ) = @_;
1690     my $dbh     = C4::Context->dbh;
1691     my @results = ();
1692     $code .= '%'
1693     if $code;  # add % if we search on a given code (otherwise, let him empty)
1694     my $strsth ="
1695         SELECT  authorisedby,
1696                 creationdate,
1697                 aqbasket.basketno,
1698                 closedate,surname,
1699                 firstname,
1700                 aqorders.biblionumber,
1701                 aqorders.ordernumber,
1702                 aqorders.parent_ordernumber,
1703                 aqorders.quantity,
1704                 aqorders.quantityreceived,
1705                 aqorders.unitprice,
1706                 aqorders.listprice,
1707                 aqorders.rrp,
1708                 aqorders.ecost,
1709                 aqorders.gstrate,
1710                 biblio.title
1711         FROM aqorders
1712         LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
1713         LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
1714         LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1715         LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid
1716         WHERE
1717             aqbasket.booksellerid = ?
1718             AND aqinvoices.invoicenumber LIKE ?
1719             AND aqorders.datereceived = ? ";
1720
1721     my @query_params = ( $supplierid, $code, $datereceived );
1722     if ( C4::Context->preference("IndependentBranches") ) {
1723         my $userenv = C4::Context->userenv;
1724         if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
1725             $strsth .= " and (borrowers.branchcode = ?
1726                         or borrowers.branchcode  = '')";
1727             push @query_params, $userenv->{branch};
1728         }
1729     }
1730     $strsth .= " ORDER BY aqbasket.basketno";
1731     # ## parcelinformation : $strsth
1732     my $sth = $dbh->prepare($strsth);
1733     $sth->execute( @query_params );
1734     while ( my $data = $sth->fetchrow_hashref ) {
1735         push( @results, $data );
1736     }
1737     # ## countparcelbiblio: scalar(@results)
1738     $sth->finish;
1739
1740     return @results;
1741 }
1742
1743 #------------------------------------------------------------#
1744
1745 =head3 GetParcels
1746
1747   $results = &GetParcels($bookseller, $order, $code, $datefrom, $dateto);
1748
1749 get a lists of parcels.
1750
1751 * Input arg :
1752
1753 =over
1754
1755 =item $bookseller
1756 is the bookseller this function has to get parcels.
1757
1758 =item $order
1759 To know on what criteria the results list has to be ordered.
1760
1761 =item $code
1762 is the booksellerinvoicenumber.
1763
1764 =item $datefrom & $dateto
1765 to know on what date this function has to filter its search.
1766
1767 =back
1768
1769 * return:
1770 a pointer on a hash list containing parcel informations as such :
1771
1772 =over
1773
1774 =item Creation date
1775
1776 =item Last operation
1777
1778 =item Number of biblio
1779
1780 =item Number of items
1781
1782 =back
1783
1784 =cut
1785
1786 sub GetParcels {
1787     my ($bookseller,$order, $code, $datefrom, $dateto) = @_;
1788     my $dbh    = C4::Context->dbh;
1789     my @query_params = ();
1790     my $strsth ="
1791         SELECT  aqinvoices.invoicenumber,
1792                 datereceived,purchaseordernumber,
1793                 count(DISTINCT biblionumber) AS biblio,
1794                 sum(quantity) AS itemsexpected,
1795                 sum(quantityreceived) AS itemsreceived
1796         FROM   aqorders LEFT JOIN aqbasket ON aqbasket.basketno = aqorders.basketno
1797         LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid
1798         WHERE aqbasket.booksellerid = ? and datereceived IS NOT NULL
1799     ";
1800     push @query_params, $bookseller;
1801
1802     if ( defined $code ) {
1803         $strsth .= ' and aqinvoices.invoicenumber like ? ';
1804         # add a % to the end of the code to allow stemming.
1805         push @query_params, "$code%";
1806     }
1807
1808     if ( defined $datefrom ) {
1809         $strsth .= ' and datereceived >= ? ';
1810         push @query_params, $datefrom;
1811     }
1812
1813     if ( defined $dateto ) {
1814         $strsth .=  'and datereceived <= ? ';
1815         push @query_params, $dateto;
1816     }
1817
1818     $strsth .= "group by aqinvoices.invoicenumber,datereceived ";
1819
1820     # can't use a placeholder to place this column name.
1821     # but, we could probably be checking to make sure it is a column that will be fetched.
1822     $strsth .= "order by $order " if ($order);
1823
1824     my $sth = $dbh->prepare($strsth);
1825
1826     $sth->execute( @query_params );
1827     my $results = $sth->fetchall_arrayref({});
1828     $sth->finish;
1829     return @$results;
1830 }
1831
1832 #------------------------------------------------------------#
1833
1834 =head3 GetLateOrders
1835
1836   @results = &GetLateOrders;
1837
1838 Searches for bookseller with late orders.
1839
1840 return:
1841 the table of supplier with late issues. This table is full of hashref.
1842
1843 =cut
1844
1845 sub GetLateOrders {
1846     my $delay      = shift;
1847     my $supplierid = shift;
1848     my $branch     = shift;
1849     my $estimateddeliverydatefrom = shift;
1850     my $estimateddeliverydateto = shift;
1851
1852     my $dbh = C4::Context->dbh;
1853
1854     #BEWARE, order of parenthesis and LEFT JOIN is important for speed
1855     my $dbdriver = C4::Context->config("db_scheme") || "mysql";
1856
1857     my @query_params = ();
1858     my $select = "
1859     SELECT aqbasket.basketno,
1860         aqorders.ordernumber,
1861         DATE(aqbasket.closedate)  AS orderdate,
1862         aqorders.rrp              AS unitpricesupplier,
1863         aqorders.ecost            AS unitpricelib,
1864         aqorders.claims_count     AS claims_count,
1865         aqorders.claimed_date     AS claimed_date,
1866         aqbudgets.budget_name     AS budget,
1867         borrowers.branchcode      AS branch,
1868         aqbooksellers.name        AS supplier,
1869         aqbooksellers.id          AS supplierid,
1870         biblio.author, biblio.title,
1871         biblioitems.publishercode AS publisher,
1872         biblioitems.publicationyear,
1873         ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) AS estimateddeliverydate,
1874     ";
1875     my $from = "
1876     FROM
1877         aqorders LEFT JOIN biblio     ON biblio.biblionumber         = aqorders.biblionumber
1878         LEFT JOIN biblioitems         ON biblioitems.biblionumber    = biblio.biblionumber
1879         LEFT JOIN aqbudgets           ON aqorders.budget_id          = aqbudgets.budget_id,
1880         aqbasket LEFT JOIN borrowers  ON aqbasket.authorisedby       = borrowers.borrowernumber
1881         LEFT JOIN aqbooksellers       ON aqbasket.booksellerid       = aqbooksellers.id
1882         WHERE aqorders.basketno = aqbasket.basketno
1883         AND ( datereceived = ''
1884             OR datereceived IS NULL
1885             OR aqorders.quantityreceived < aqorders.quantity
1886         )
1887         AND aqbasket.closedate IS NOT NULL
1888         AND (aqorders.datecancellationprinted IS NULL OR aqorders.datecancellationprinted='0000-00-00')
1889     ";
1890     my $having = "";
1891     if ($dbdriver eq "mysql") {
1892         $select .= "
1893         aqorders.quantity - COALESCE(aqorders.quantityreceived,0)                 AS quantity,
1894         (aqorders.quantity - COALESCE(aqorders.quantityreceived,0)) * aqorders.rrp AS subtotal,
1895         DATEDIFF(CAST(now() AS date),closedate) AS latesince
1896         ";
1897         if ( defined $delay ) {
1898             $from .= " AND (closedate <= DATE_SUB(CAST(now() AS date),INTERVAL ? DAY)) " ;
1899             push @query_params, $delay;
1900         }
1901         $having = "
1902         HAVING quantity          <> 0
1903             AND unitpricesupplier <> 0
1904             AND unitpricelib      <> 0
1905         ";
1906     } else {
1907         # FIXME: account for IFNULL as above
1908         $select .= "
1909                 aqorders.quantity                AS quantity,
1910                 aqorders.quantity * aqorders.rrp AS subtotal,
1911                 (CAST(now() AS date) - closedate)            AS latesince
1912         ";
1913         if ( defined $delay ) {
1914             $from .= " AND (closedate <= (CAST(now() AS date) -(INTERVAL ? DAY)) ";
1915             push @query_params, $delay;
1916         }
1917     }
1918     if (defined $supplierid) {
1919         $from .= ' AND aqbasket.booksellerid = ? ';
1920         push @query_params, $supplierid;
1921     }
1922     if (defined $branch) {
1923         $from .= ' AND borrowers.branchcode LIKE ? ';
1924         push @query_params, $branch;
1925     }
1926
1927     if ( defined $estimateddeliverydatefrom or defined $estimateddeliverydateto ) {
1928         $from .= ' AND aqbooksellers.deliverytime IS NOT NULL ';
1929     }
1930     if ( defined $estimateddeliverydatefrom ) {
1931         $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) >= ?';
1932         push @query_params, $estimateddeliverydatefrom;
1933     }
1934     if ( defined $estimateddeliverydateto ) {
1935         $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) <= ?';
1936         push @query_params, $estimateddeliverydateto;
1937     }
1938     if ( defined $estimateddeliverydatefrom and not defined $estimateddeliverydateto ) {
1939         $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) <= CAST(now() AS date)';
1940     }
1941     if (C4::Context->preference("IndependentBranches")
1942             && C4::Context->userenv
1943             && C4::Context->userenv->{flags} != 1 ) {
1944         $from .= ' AND borrowers.branchcode LIKE ? ';
1945         push @query_params, C4::Context->userenv->{branch};
1946     }
1947     my $query = "$select $from $having\nORDER BY latesince, basketno, borrowers.branchcode, supplier";
1948     $debug and print STDERR "GetLateOrders query: $query\nGetLateOrders args: " . join(" ",@query_params);
1949     my $sth = $dbh->prepare($query);
1950     $sth->execute(@query_params);
1951     my @results;
1952     while (my $data = $sth->fetchrow_hashref) {
1953         $data->{orderdate} = format_date($data->{orderdate});
1954         $data->{claimed_date} = format_date($data->{claimed_date});
1955         push @results, $data;
1956     }
1957     return @results;
1958 }
1959
1960 #------------------------------------------------------------#
1961
1962 =head3 GetHistory
1963
1964   (\@order_loop, $total_qty, $total_price, $total_qtyreceived) = GetHistory( %params );
1965
1966 Retreives some acquisition history information
1967
1968 params:
1969   title
1970   author
1971   name
1972   from_placed_on
1973   to_placed_on
1974   basket                  - search both basket name and number
1975   booksellerinvoicenumber
1976
1977 returns:
1978     $order_loop is a list of hashrefs that each look like this:
1979             {
1980                 'author'           => 'Twain, Mark',
1981                 'basketno'         => '1',
1982                 'biblionumber'     => '215',
1983                 'count'            => 1,
1984                 'creationdate'     => 'MM/DD/YYYY',
1985                 'datereceived'     => undef,
1986                 'ecost'            => '1.00',
1987                 'id'               => '1',
1988                 'invoicenumber'    => undef,
1989                 'name'             => '',
1990                 'ordernumber'      => '1',
1991                 'quantity'         => 1,
1992                 'quantityreceived' => undef,
1993                 'title'            => 'The Adventures of Huckleberry Finn'
1994             }
1995     $total_qty is the sum of all of the quantities in $order_loop
1996     $total_price is the cost of each in $order_loop times the quantity
1997     $total_qtyreceived is the sum of all of the quantityreceived entries in $order_loop
1998
1999 =cut
2000
2001 sub GetHistory {
2002 # don't run the query if there are no parameters (list would be too long for sure !)
2003     croak "No search params" unless @_;
2004     my %params = @_;
2005     my $title = $params{title};
2006     my $author = $params{author};
2007     my $isbn   = $params{isbn};
2008     my $ean    = $params{ean};
2009     my $name = $params{name};
2010     my $from_placed_on = $params{from_placed_on};
2011     my $to_placed_on = $params{to_placed_on};
2012     my $basket = $params{basket};
2013     my $booksellerinvoicenumber = $params{booksellerinvoicenumber};
2014     my $basketgroupname = $params{basketgroupname};
2015     my @order_loop;
2016     my $total_qty         = 0;
2017     my $total_qtyreceived = 0;
2018     my $total_price       = 0;
2019
2020     my $dbh   = C4::Context->dbh;
2021     my $query ="
2022         SELECT
2023             biblio.title,
2024             biblio.author,
2025             biblioitems.isbn,
2026         biblioitems.ean,
2027             aqorders.basketno,
2028             aqbasket.basketname,
2029             aqbasket.basketgroupid,
2030             aqbasketgroups.name as groupname,
2031             aqbooksellers.name,
2032             aqbasket.creationdate,
2033             aqorders.datereceived,
2034             aqorders.quantity,
2035             aqorders.quantityreceived,
2036             aqorders.ecost,
2037             aqorders.ordernumber,
2038             aqorders.invoiceid,
2039             aqinvoices.invoicenumber,
2040             aqbooksellers.id as id,
2041             aqorders.biblionumber
2042         FROM aqorders
2043         LEFT JOIN aqbasket ON aqorders.basketno=aqbasket.basketno
2044         LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid=aqbasketgroups.id
2045         LEFT JOIN aqbooksellers ON aqbasket.booksellerid=aqbooksellers.id
2046         LEFT JOIN biblioitems ON biblioitems.biblionumber=aqorders.biblionumber
2047         LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber
2048     LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid";
2049
2050     $query .= " LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber"
2051     if ( C4::Context->preference("IndependentBranches") );
2052
2053     $query .= " WHERE (datecancellationprinted is NULL or datecancellationprinted='0000-00-00') ";
2054
2055     my @query_params  = ();
2056
2057     if ( $title ) {
2058         $query .= " AND biblio.title LIKE ? ";
2059         $title =~ s/\s+/%/g;
2060         push @query_params, "%$title%";
2061     }
2062
2063     if ( $author ) {
2064         $query .= " AND biblio.author LIKE ? ";
2065         push @query_params, "%$author%";
2066     }
2067
2068     if ( $isbn ) {
2069         $query .= " AND biblioitems.isbn LIKE ? ";
2070         push @query_params, "%$isbn%";
2071     }
2072     if ( defined $ean and $ean ) {
2073         $query .= " AND biblioitems.ean = ? ";
2074         push @query_params, "$ean";
2075     }
2076     if ( $name ) {
2077         $query .= " AND aqbooksellers.name LIKE ? ";
2078         push @query_params, "%$name%";
2079     }
2080
2081     if ( $from_placed_on ) {
2082         $query .= " AND creationdate >= ? ";
2083         push @query_params, $from_placed_on;
2084     }
2085
2086     if ( $to_placed_on ) {
2087         $query .= " AND creationdate <= ? ";
2088         push @query_params, $to_placed_on;
2089     }
2090
2091     if ($basket) {
2092         if ($basket =~ m/^\d+$/) {
2093             $query .= " AND aqorders.basketno = ? ";
2094             push @query_params, $basket;
2095         } else {
2096             $query .= " AND aqbasket.basketname LIKE ? ";
2097             push @query_params, "%$basket%";
2098         }
2099     }
2100
2101     if ($booksellerinvoicenumber) {
2102         $query .= " AND aqinvoices.invoicenumber LIKE ? ";
2103         push @query_params, "%$booksellerinvoicenumber%";
2104     }
2105
2106     if ($basketgroupname) {
2107         $query .= " AND aqbasketgroups.name LIKE ? ";
2108         push @query_params, "%$basketgroupname%";
2109     }
2110
2111     if ( C4::Context->preference("IndependentBranches") ) {
2112         my $userenv = C4::Context->userenv;
2113         if ( $userenv && ($userenv->{flags} || 0) != 1 ) {
2114             $query .= " AND (borrowers.branchcode = ? OR borrowers.branchcode ='' ) ";
2115             push @query_params, $userenv->{branch};
2116         }
2117     }
2118     $query .= " ORDER BY id";
2119     my $sth = $dbh->prepare($query);
2120     $sth->execute( @query_params );
2121     my $cnt = 1;
2122     while ( my $line = $sth->fetchrow_hashref ) {
2123         $line->{count} = $cnt++;
2124         $line->{toggle} = 1 if $cnt % 2;
2125         push @order_loop, $line;
2126         $total_qty         += $line->{'quantity'};
2127         $total_qtyreceived += $line->{'quantityreceived'};
2128         $total_price       += $line->{'quantity'} * $line->{'ecost'};
2129     }
2130     return \@order_loop, $total_qty, $total_price, $total_qtyreceived;
2131 }
2132
2133 =head2 GetRecentAcqui
2134
2135   $results = GetRecentAcqui($days);
2136
2137 C<$results> is a ref to a table which containts hashref
2138
2139 =cut
2140
2141 sub GetRecentAcqui {
2142     my $limit  = shift;
2143     my $dbh    = C4::Context->dbh;
2144     my $query = "
2145         SELECT *
2146         FROM   biblio
2147         ORDER BY timestamp DESC
2148         LIMIT  0,".$limit;
2149
2150     my $sth = $dbh->prepare($query);
2151     $sth->execute;
2152     my $results = $sth->fetchall_arrayref({});
2153     return $results;
2154 }
2155
2156 =head3 GetContracts
2157
2158   $contractlist = &GetContracts($booksellerid, $activeonly);
2159
2160 Looks up the contracts that belong to a bookseller
2161
2162 Returns a list of contracts
2163
2164 =over
2165
2166 =item C<$booksellerid> is the "id" field in the "aqbooksellers" table.
2167
2168 =item C<$activeonly> if exists get only contracts that are still active.
2169
2170 =back
2171
2172 =cut
2173
2174 sub GetContracts {
2175     my ( $booksellerid, $activeonly ) = @_;
2176     my $dbh = C4::Context->dbh;
2177     my $query;
2178     if (! $activeonly) {
2179         $query = "
2180             SELECT *
2181             FROM   aqcontract
2182             WHERE  booksellerid=?
2183         ";
2184     } else {
2185         $query = "SELECT *
2186             FROM aqcontract
2187             WHERE booksellerid=?
2188                 AND contractenddate >= CURDATE( )";
2189     }
2190     my $sth = $dbh->prepare($query);
2191     $sth->execute( $booksellerid );
2192     my @results;
2193     while (my $data = $sth->fetchrow_hashref ) {
2194         push(@results, $data);
2195     }
2196     $sth->finish;
2197     return @results;
2198 }
2199
2200 #------------------------------------------------------------#
2201
2202 =head3 GetContract
2203
2204   $contract = &GetContract($contractID);
2205
2206 Looks up the contract that has PRIMKEY (contractnumber) value $contractID
2207
2208 Returns a contract
2209
2210 =cut
2211
2212 sub GetContract {
2213     my ( $contractno ) = @_;
2214     my $dbh = C4::Context->dbh;
2215     my $query = "
2216         SELECT *
2217         FROM   aqcontract
2218         WHERE  contractnumber=?
2219         ";
2220
2221     my $sth = $dbh->prepare($query);
2222     $sth->execute( $contractno );
2223     my $result = $sth->fetchrow_hashref;
2224     return $result;
2225 }
2226
2227 =head3 AddClaim
2228
2229 =over 4
2230
2231 &AddClaim($ordernumber);
2232
2233 Add a claim for an order
2234
2235 =back
2236
2237 =cut
2238 sub AddClaim {
2239     my ($ordernumber) = @_;
2240     my $dbh          = C4::Context->dbh;
2241     my $query        = "
2242         UPDATE aqorders SET
2243             claims_count = claims_count + 1,
2244             claimed_date = CURDATE()
2245         WHERE ordernumber = ?
2246         ";
2247     my $sth = $dbh->prepare($query);
2248     $sth->execute($ordernumber);
2249 }
2250
2251 =head3 GetInvoices
2252
2253     my @invoices = GetInvoices(
2254         invoicenumber => $invoicenumber,
2255         suppliername => $suppliername,
2256         shipmentdatefrom => $shipmentdatefrom, # ISO format
2257         shipmentdateto => $shipmentdateto, # ISO format
2258         billingdatefrom => $billingdatefrom, # ISO format
2259         billingdateto => $billingdateto, # ISO format
2260         isbneanissn => $isbn_or_ean_or_issn,
2261         title => $title,
2262         author => $author,
2263         publisher => $publisher,
2264         publicationyear => $publicationyear,
2265         branchcode => $branchcode,
2266         order_by => $order_by
2267     );
2268
2269 Return a list of invoices that match all given criteria.
2270
2271 $order_by is "column_name (asc|desc)", where column_name is any of
2272 'invoicenumber', 'booksellerid', 'shipmentdate', 'billingdate', 'closedate',
2273 'shipmentcost', 'shipmentcost_budgetid'.
2274
2275 asc is the default if omitted
2276
2277 =cut
2278
2279 sub GetInvoices {
2280     my %args = @_;
2281
2282     my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2283         closedate shipmentcost shipmentcost_budgetid);
2284
2285     my $dbh = C4::Context->dbh;
2286     my $query = qq{
2287         SELECT aqinvoices.*, aqbooksellers.name AS suppliername,
2288           COUNT(
2289             DISTINCT IF(
2290               aqorders.datereceived IS NOT NULL,
2291               aqorders.biblionumber,
2292               NULL
2293             )
2294           ) AS receivedbiblios,
2295           SUM(aqorders.quantityreceived) AS receiveditems
2296         FROM aqinvoices
2297           LEFT JOIN aqbooksellers ON aqbooksellers.id = aqinvoices.booksellerid
2298           LEFT JOIN aqorders ON aqorders.invoiceid = aqinvoices.invoiceid
2299           LEFT JOIN biblio ON aqorders.biblionumber = biblio.biblionumber
2300           LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
2301           LEFT JOIN subscription ON biblio.biblionumber = subscription.biblionumber
2302     };
2303
2304     my @bind_args;
2305     my @bind_strs;
2306     if($args{supplierid}) {
2307         push @bind_strs, " aqinvoices.booksellerid = ? ";
2308         push @bind_args, $args{supplierid};
2309     }
2310     if($args{invoicenumber}) {
2311         push @bind_strs, " aqinvoices.invoicenumber LIKE ? ";
2312         push @bind_args, "%$args{invoicenumber}%";
2313     }
2314     if($args{suppliername}) {
2315         push @bind_strs, " aqbooksellers.name LIKE ? ";
2316         push @bind_args, "%$args{suppliername}%";
2317     }
2318     if($args{shipmentdatefrom}) {
2319         push @bind_strs, " aqinvoices.shipementdate >= ? ";
2320         push @bind_args, $args{shipmentdatefrom};
2321     }
2322     if($args{shipmentdateto}) {
2323         push @bind_strs, " aqinvoices.shipementdate <= ? ";
2324         push @bind_args, $args{shipmentdateto};
2325     }
2326     if($args{billingdatefrom}) {
2327         push @bind_strs, " aqinvoices.billingdate >= ? ";
2328         push @bind_args, $args{billingdatefrom};
2329     }
2330     if($args{billingdateto}) {
2331         push @bind_strs, " aqinvoices.billingdate <= ? ";
2332         push @bind_args, $args{billingdateto};
2333     }
2334     if($args{isbneanissn}) {
2335         push @bind_strs, " (biblioitems.isbn LIKE ? OR biblioitems.ean LIKE ? OR biblioitems.issn LIKE ? ) ";
2336         push @bind_args, $args{isbneanissn}, $args{isbneanissn}, $args{isbneanissn};
2337     }
2338     if($args{title}) {
2339         push @bind_strs, " biblio.title LIKE ? ";
2340         push @bind_args, $args{title};
2341     }
2342     if($args{author}) {
2343         push @bind_strs, " biblio.author LIKE ? ";
2344         push @bind_args, $args{author};
2345     }
2346     if($args{publisher}) {
2347         push @bind_strs, " biblioitems.publishercode LIKE ? ";
2348         push @bind_args, $args{publisher};
2349     }
2350     if($args{publicationyear}) {
2351         push @bind_strs, " biblioitems.publicationyear = ? ";
2352         push @bind_args, $args{publicationyear};
2353     }
2354     if($args{branchcode}) {
2355         push @bind_strs, " aqorders.branchcode = ? ";
2356         push @bind_args, $args{branchcode};
2357     }
2358
2359     $query .= " WHERE " . join(" AND ", @bind_strs) if @bind_strs;
2360     $query .= " GROUP BY aqinvoices.invoiceid ";
2361
2362     if($args{order_by}) {
2363         my ($column, $direction) = split / /, $args{order_by};
2364         if(grep /^$column$/, @columns) {
2365             $direction ||= 'ASC';
2366             $query .= " ORDER BY $column $direction";
2367         }
2368     }
2369
2370     my $sth = $dbh->prepare($query);
2371     $sth->execute(@bind_args);
2372
2373     my $results = $sth->fetchall_arrayref({});
2374     return @$results;
2375 }
2376
2377 =head3 GetInvoice
2378
2379     my $invoice = GetInvoice($invoiceid);
2380
2381 Get informations about invoice with given $invoiceid
2382
2383 Return a hash filled with aqinvoices.* fields
2384
2385 =cut
2386
2387 sub GetInvoice {
2388     my ($invoiceid) = @_;
2389     my $invoice;
2390
2391     return unless $invoiceid;
2392
2393     my $dbh = C4::Context->dbh;
2394     my $query = qq{
2395         SELECT *
2396         FROM aqinvoices
2397         WHERE invoiceid = ?
2398     };
2399     my $sth = $dbh->prepare($query);
2400     $sth->execute($invoiceid);
2401
2402     $invoice = $sth->fetchrow_hashref;
2403     return $invoice;
2404 }
2405
2406 =head3 GetInvoiceDetails
2407
2408     my $invoice = GetInvoiceDetails($invoiceid)
2409
2410 Return informations about an invoice + the list of related order lines
2411
2412 Orders informations are in $invoice->{orders} (array ref)
2413
2414 =cut
2415
2416 sub GetInvoiceDetails {
2417     my ($invoiceid) = @_;
2418
2419     if ( !defined $invoiceid ) {
2420         carp 'GetInvoiceDetails called without an invoiceid';
2421         return;
2422     }
2423
2424     my $dbh = C4::Context->dbh;
2425     my $query = qq{
2426         SELECT aqinvoices.*, aqbooksellers.name AS suppliername
2427         FROM aqinvoices
2428           LEFT JOIN aqbooksellers ON aqinvoices.booksellerid = aqbooksellers.id
2429         WHERE invoiceid = ?
2430     };
2431     my $sth = $dbh->prepare($query);
2432     $sth->execute($invoiceid);
2433
2434     my $invoice = $sth->fetchrow_hashref;
2435
2436     $query = qq{
2437         SELECT aqorders.*, biblio.*
2438         FROM aqorders
2439           LEFT JOIN biblio ON aqorders.biblionumber = biblio.biblionumber
2440         WHERE invoiceid = ?
2441     };
2442     $sth = $dbh->prepare($query);
2443     $sth->execute($invoiceid);
2444     $invoice->{orders} = $sth->fetchall_arrayref({});
2445     $invoice->{orders} ||= []; # force an empty arrayref if fetchall_arrayref fails
2446
2447     return $invoice;
2448 }
2449
2450 =head3 AddInvoice
2451
2452     my $invoiceid = AddInvoice(
2453         invoicenumber => $invoicenumber,
2454         booksellerid => $booksellerid,
2455         shipmentdate => $shipmentdate,
2456         billingdate => $billingdate,
2457         closedate => $closedate,
2458         shipmentcost => $shipmentcost,
2459         shipmentcost_budgetid => $shipmentcost_budgetid
2460     );
2461
2462 Create a new invoice and return its id or undef if it fails.
2463
2464 =cut
2465
2466 sub AddInvoice {
2467     my %invoice = @_;
2468
2469     return unless(%invoice and $invoice{invoicenumber});
2470
2471     my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2472         closedate shipmentcost shipmentcost_budgetid);
2473
2474     my @set_strs;
2475     my @set_args;
2476     foreach my $key (keys %invoice) {
2477         if(0 < grep(/^$key$/, @columns)) {
2478             push @set_strs, "$key = ?";
2479             push @set_args, ($invoice{$key} || undef);
2480         }
2481     }
2482
2483     my $rv;
2484     if(@set_args > 0) {
2485         my $dbh = C4::Context->dbh;
2486         my $query = "INSERT INTO aqinvoices SET ";
2487         $query .= join (",", @set_strs);
2488         my $sth = $dbh->prepare($query);
2489         $rv = $sth->execute(@set_args);
2490         if($rv) {
2491             $rv = $dbh->last_insert_id(undef, undef, 'aqinvoices', undef);
2492         }
2493     }
2494     return $rv;
2495 }
2496
2497 =head3 ModInvoice
2498
2499     ModInvoice(
2500         invoiceid => $invoiceid,    # Mandatory
2501         invoicenumber => $invoicenumber,
2502         booksellerid => $booksellerid,
2503         shipmentdate => $shipmentdate,
2504         billingdate => $billingdate,
2505         closedate => $closedate,
2506         shipmentcost => $shipmentcost,
2507         shipmentcost_budgetid => $shipmentcost_budgetid
2508     );
2509
2510 Modify an invoice, invoiceid is mandatory.
2511
2512 Return undef if it fails.
2513
2514 =cut
2515
2516 sub ModInvoice {
2517     my %invoice = @_;
2518
2519     return unless(%invoice and $invoice{invoiceid});
2520
2521     my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2522         closedate shipmentcost shipmentcost_budgetid);
2523
2524     my @set_strs;
2525     my @set_args;
2526     foreach my $key (keys %invoice) {
2527         if(0 < grep(/^$key$/, @columns)) {
2528             push @set_strs, "$key = ?";
2529             push @set_args, ($invoice{$key} || undef);
2530         }
2531     }
2532
2533     my $dbh = C4::Context->dbh;
2534     my $query = "UPDATE aqinvoices SET ";
2535     $query .= join(",", @set_strs);
2536     $query .= " WHERE invoiceid = ?";
2537
2538     my $sth = $dbh->prepare($query);
2539     $sth->execute(@set_args, $invoice{invoiceid});
2540 }
2541
2542 =head3 CloseInvoice
2543
2544     CloseInvoice($invoiceid);
2545
2546 Close an invoice.
2547
2548 Equivalent to ModInvoice(invoiceid => $invoiceid, closedate => undef);
2549
2550 =cut
2551
2552 sub CloseInvoice {
2553     my ($invoiceid) = @_;
2554
2555     return unless $invoiceid;
2556
2557     my $dbh = C4::Context->dbh;
2558     my $query = qq{
2559         UPDATE aqinvoices
2560         SET closedate = CAST(NOW() AS DATE)
2561         WHERE invoiceid = ?
2562     };
2563     my $sth = $dbh->prepare($query);
2564     $sth->execute($invoiceid);
2565 }
2566
2567 =head3 ReopenInvoice
2568
2569     ReopenInvoice($invoiceid);
2570
2571 Reopen an invoice
2572
2573 Equivalent to ModInvoice(invoiceid => $invoiceid, closedate => C4::Dates->new()->output('iso'))
2574
2575 =cut
2576
2577 sub ReopenInvoice {
2578     my ($invoiceid) = @_;
2579
2580     return unless $invoiceid;
2581
2582     my $dbh = C4::Context->dbh;
2583     my $query = qq{
2584         UPDATE aqinvoices
2585         SET closedate = NULL
2586         WHERE invoiceid = ?
2587     };
2588     my $sth = $dbh->prepare($query);
2589     $sth->execute($invoiceid);
2590 }
2591
2592 =head3 DelInvoice
2593
2594     DelInvoice($invoiceid);
2595
2596 Delete an invoice if there are no items attached to it.
2597
2598 =cut
2599
2600 sub DelInvoice {
2601     my ($invoiceid) = @_;
2602
2603     return unless $invoiceid;
2604
2605     my $dbh   = C4::Context->dbh;
2606     my $query = qq{
2607         SELECT COUNT(*)
2608         FROM aqorders
2609         WHERE invoiceid = ?
2610     };
2611     my $sth = $dbh->prepare($query);
2612     $sth->execute($invoiceid);
2613     my $res = $sth->fetchrow_arrayref;
2614     if ( $res && $res->[0] == 0 ) {
2615         $query = qq{
2616             DELETE FROM aqinvoices
2617             WHERE invoiceid = ?
2618         };
2619         my $sth = $dbh->prepare($query);
2620         return ( $sth->execute($invoiceid) > 0 );
2621     }
2622     return;
2623 }
2624
2625 1;
2626 __END__
2627
2628 =head1 AUTHOR
2629
2630 Koha Development Team <http://koha-community.org/>
2631
2632 =cut