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