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