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", "gst", "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,
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         $sth->finish;
1310
1311         delete $order->{'ordernumber'};
1312         $order->{'quantity'} = $quantrec;
1313         $order->{'quantityreceived'} = $quantrec;
1314         $order->{'datereceived'} = $datereceived;
1315         $order->{'invoiceid'} = $invoiceid;
1316         $order->{'unitprice'} = $cost;
1317         $order->{'rrp'} = $rrp;
1318         $order->{'orderstatus'} = 3;    # totally received
1319         $new_ordernumber = NewOrder($order);
1320
1321         if ($received_items) {
1322             foreach my $itemnumber (@$received_items) {
1323                 ModItemOrder($itemnumber, $new_ordernumber);
1324             }
1325         }
1326     } else {
1327         $sth=$dbh->prepare("update aqorders
1328                             set quantityreceived=?,datereceived=?,invoiceid=?,
1329                                 unitprice=?,rrp=?
1330                             where biblionumber=? and ordernumber=?");
1331         $sth->execute($quantrec,$datereceived,$invoiceid,$cost,$rrp,$biblionumber,$ordernumber);
1332         $sth->finish;
1333     }
1334     return ($datereceived, $new_ordernumber);
1335 }
1336
1337 =head3 CancelReceipt
1338
1339     my $parent_ordernumber = CancelReceipt($ordernumber);
1340
1341     Cancel an order line receipt and update the parent order line, as if no
1342     receipt was made.
1343     If items are created at receipt (AcqCreateItem = receiving) then delete
1344     these items.
1345
1346 =cut
1347
1348 sub CancelReceipt {
1349     my $ordernumber = shift;
1350
1351     return unless $ordernumber;
1352
1353     my $dbh = C4::Context->dbh;
1354     my $query = qq{
1355         SELECT datereceived, parent_ordernumber, quantity
1356         FROM aqorders
1357         WHERE ordernumber = ?
1358     };
1359     my $sth = $dbh->prepare($query);
1360     $sth->execute($ordernumber);
1361     my $order = $sth->fetchrow_hashref;
1362     unless($order) {
1363         warn "CancelReceipt: order $ordernumber does not exist";
1364         return;
1365     }
1366     unless($order->{'datereceived'}) {
1367         warn "CancelReceipt: order $ordernumber is not received";
1368         return;
1369     }
1370
1371     my $parent_ordernumber = $order->{'parent_ordernumber'};
1372
1373     if($parent_ordernumber == $ordernumber || not $parent_ordernumber) {
1374         # The order line has no parent, just mark it as not received
1375         $query = qq{
1376             UPDATE aqorders
1377             SET quantityreceived = ?,
1378                 datereceived = ?,
1379                 invoiceid = ?
1380             WHERE ordernumber = ?
1381         };
1382         $sth = $dbh->prepare($query);
1383         $sth->execute(0, undef, undef, $ordernumber);
1384     } else {
1385         # The order line has a parent, increase parent quantity and delete
1386         # the order line.
1387         $query = qq{
1388             SELECT quantity, datereceived
1389             FROM aqorders
1390             WHERE ordernumber = ?
1391         };
1392         $sth = $dbh->prepare($query);
1393         $sth->execute($parent_ordernumber);
1394         my $parent_order = $sth->fetchrow_hashref;
1395         unless($parent_order) {
1396             warn "Parent order $parent_ordernumber does not exist.";
1397             return;
1398         }
1399         if($parent_order->{'datereceived'}) {
1400             warn "CancelReceipt: parent order is received.".
1401                 " Can't cancel receipt.";
1402             return;
1403         }
1404         $query = qq{
1405             UPDATE aqorders
1406             SET quantity = ?
1407             WHERE ordernumber = ?
1408         };
1409         $sth = $dbh->prepare($query);
1410         my $rv = $sth->execute(
1411             $order->{'quantity'} + $parent_order->{'quantity'},
1412             $parent_ordernumber
1413         );
1414         unless($rv) {
1415             warn "Cannot update parent order line, so do not cancel".
1416                 " receipt";
1417             return;
1418         }
1419         if(C4::Context->preference('AcqCreateItem') eq 'receiving') {
1420             # Remove items that were created at receipt
1421             $query = qq{
1422                 DELETE FROM items, aqorders_items
1423                 USING items, aqorders_items
1424                 WHERE items.itemnumber = ? AND aqorders_items.itemnumber = ?
1425             };
1426             $sth = $dbh->prepare($query);
1427             my @itemnumbers = GetItemnumbersFromOrder($ordernumber);
1428             foreach my $itemnumber (@itemnumbers) {
1429                 $sth->execute($itemnumber, $itemnumber);
1430             }
1431         } else {
1432             # Update items
1433             my @itemnumbers = GetItemnumbersFromOrder($ordernumber);
1434             foreach my $itemnumber (@itemnumbers) {
1435                 ModItemOrder($itemnumber, $parent_ordernumber);
1436             }
1437         }
1438         # Delete order line
1439         $query = qq{
1440             DELETE FROM aqorders
1441             WHERE ordernumber = ?
1442         };
1443         $sth = $dbh->prepare($query);
1444         $sth->execute($ordernumber);
1445
1446     }
1447
1448     return $parent_ordernumber;
1449 }
1450
1451 #------------------------------------------------------------#
1452
1453 =head3 SearchOrder
1454
1455 @results = &SearchOrder($search, $biblionumber, $complete);
1456
1457 Searches for orders.
1458
1459 C<$search> may take one of several forms: if it is an ISBN,
1460 C<&ordersearch> returns orders with that ISBN. If C<$search> is an
1461 order number, C<&ordersearch> returns orders with that order number
1462 and biblionumber C<$biblionumber>. Otherwise, C<$search> is considered
1463 to be a space-separated list of search terms; in this case, all of the
1464 terms must appear in the title (matching the beginning of title
1465 words).
1466
1467 If C<$complete> is C<yes>, the results will include only completed
1468 orders. In any case, C<&ordersearch> ignores cancelled orders.
1469
1470 C<&ordersearch> returns an array.
1471 C<@results> is an array of references-to-hash with the following keys:
1472
1473 =over 4
1474
1475 =item C<author>
1476
1477 =item C<seriestitle>
1478
1479 =item C<branchcode>
1480
1481 =item C<bookfundid>
1482
1483 =back
1484
1485 =cut
1486
1487 sub SearchOrder {
1488 #### -------- SearchOrder-------------------------------
1489     my ( $ordernumber, $search, $ean, $supplierid, $basket ) = @_;
1490
1491     my $dbh = C4::Context->dbh;
1492     my @args = ();
1493     my $query =
1494             "SELECT *
1495             FROM aqorders
1496             LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1497             LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
1498             LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
1499                 WHERE  (datecancellationprinted is NULL)";
1500
1501     if($ordernumber){
1502         $query .= " AND (aqorders.ordernumber=?)";
1503         push @args, $ordernumber;
1504     }
1505     if($search){
1506         $query .= " AND (biblio.title like ? OR biblio.author LIKE ? OR biblioitems.isbn like ?)";
1507         push @args, ("%$search%","%$search%","%$search%");
1508     }
1509     if ($ean) {
1510         $query .= " AND biblioitems.ean = ?";
1511         push @args, $ean;
1512     }
1513     if ($supplierid) {
1514         $query .= "AND aqbasket.booksellerid = ?";
1515         push @args, $supplierid;
1516     }
1517     if($basket){
1518         $query .= "AND aqorders.basketno = ?";
1519         push @args, $basket;
1520     }
1521
1522     my $sth = $dbh->prepare($query);
1523     $sth->execute(@args);
1524     my $results = $sth->fetchall_arrayref({});
1525     $sth->finish;
1526     return $results;
1527 }
1528
1529 #------------------------------------------------------------#
1530
1531 =head3 DelOrder
1532
1533   &DelOrder($biblionumber, $ordernumber);
1534
1535 Cancel the order with the given order and biblio numbers. It does not
1536 delete any entries in the aqorders table, it merely marks them as
1537 cancelled.
1538
1539 =cut
1540
1541 sub DelOrder {
1542     my ( $bibnum, $ordernumber ) = @_;
1543     my $dbh = C4::Context->dbh;
1544     my $query = "
1545         UPDATE aqorders
1546         SET    datecancellationprinted=now()
1547         WHERE  biblionumber=? AND ordernumber=?
1548     ";
1549     my $sth = $dbh->prepare($query);
1550     $sth->execute( $bibnum, $ordernumber );
1551     $sth->finish;
1552     my @itemnumbers = GetItemnumbersFromOrder( $ordernumber );
1553     foreach my $itemnumber (@itemnumbers){
1554         C4::Items::DelItem( $dbh, $bibnum, $itemnumber );
1555     }
1556
1557 }
1558
1559 =head2 FUNCTIONS ABOUT PARCELS
1560
1561 =cut
1562
1563 #------------------------------------------------------------#
1564
1565 =head3 GetParcel
1566
1567   @results = &GetParcel($booksellerid, $code, $date);
1568
1569 Looks up all of the received items from the supplier with the given
1570 bookseller ID at the given date, for the given code (bookseller Invoice number). Ignores cancelled and completed orders.
1571
1572 C<@results> is an array of references-to-hash. The keys of each element are fields from
1573 the aqorders, biblio, and biblioitems tables of the Koha database.
1574
1575 C<@results> is sorted alphabetically by book title.
1576
1577 =cut
1578
1579 sub GetParcel {
1580     #gets all orders from a certain supplier, orders them alphabetically
1581     my ( $supplierid, $code, $datereceived ) = @_;
1582     my $dbh     = C4::Context->dbh;
1583     my @results = ();
1584     $code .= '%'
1585     if $code;  # add % if we search on a given code (otherwise, let him empty)
1586     my $strsth ="
1587         SELECT  authorisedby,
1588                 creationdate,
1589                 aqbasket.basketno,
1590                 closedate,surname,
1591                 firstname,
1592                 aqorders.biblionumber,
1593                 aqorders.ordernumber,
1594                 aqorders.parent_ordernumber,
1595                 aqorders.quantity,
1596                 aqorders.quantityreceived,
1597                 aqorders.unitprice,
1598                 aqorders.listprice,
1599                 aqorders.rrp,
1600                 aqorders.ecost,
1601                 biblio.title
1602         FROM aqorders
1603         LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
1604         LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
1605         LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1606         LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid
1607         WHERE
1608             aqbasket.booksellerid = ?
1609             AND aqinvoices.invoicenumber LIKE ?
1610             AND aqorders.datereceived = ? ";
1611
1612     my @query_params = ( $supplierid, $code, $datereceived );
1613     if ( C4::Context->preference("IndependantBranches") ) {
1614         my $userenv = C4::Context->userenv;
1615         if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
1616             $strsth .= " and (borrowers.branchcode = ?
1617                         or borrowers.branchcode  = '')";
1618             push @query_params, $userenv->{branch};
1619         }
1620     }
1621     $strsth .= " ORDER BY aqbasket.basketno";
1622     # ## parcelinformation : $strsth
1623     my $sth = $dbh->prepare($strsth);
1624     $sth->execute( @query_params );
1625     while ( my $data = $sth->fetchrow_hashref ) {
1626         push( @results, $data );
1627     }
1628     # ## countparcelbiblio: scalar(@results)
1629     $sth->finish;
1630
1631     return @results;
1632 }
1633
1634 #------------------------------------------------------------#
1635
1636 =head3 GetParcels
1637
1638   $results = &GetParcels($bookseller, $order, $code, $datefrom, $dateto);
1639
1640 get a lists of parcels.
1641
1642 * Input arg :
1643
1644 =over
1645
1646 =item $bookseller
1647 is the bookseller this function has to get parcels.
1648
1649 =item $order
1650 To know on what criteria the results list has to be ordered.
1651
1652 =item $code
1653 is the booksellerinvoicenumber.
1654
1655 =item $datefrom & $dateto
1656 to know on what date this function has to filter its search.
1657
1658 =back
1659
1660 * return:
1661 a pointer on a hash list containing parcel informations as such :
1662
1663 =over
1664
1665 =item Creation date
1666
1667 =item Last operation
1668
1669 =item Number of biblio
1670
1671 =item Number of items
1672
1673 =back
1674
1675 =cut
1676
1677 sub GetParcels {
1678     my ($bookseller,$order, $code, $datefrom, $dateto) = @_;
1679     my $dbh    = C4::Context->dbh;
1680     my @query_params = ();
1681     my $strsth ="
1682         SELECT  aqinvoices.invoicenumber,
1683                 datereceived,purchaseordernumber,
1684                 count(DISTINCT biblionumber) AS biblio,
1685                 sum(quantity) AS itemsexpected,
1686                 sum(quantityreceived) AS itemsreceived
1687         FROM   aqorders LEFT JOIN aqbasket ON aqbasket.basketno = aqorders.basketno
1688         LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid
1689         WHERE aqbasket.booksellerid = ? and datereceived IS NOT NULL
1690     ";
1691     push @query_params, $bookseller;
1692
1693     if ( defined $code ) {
1694         $strsth .= ' and aqinvoices.invoicenumber like ? ';
1695         # add a % to the end of the code to allow stemming.
1696         push @query_params, "$code%";
1697     }
1698
1699     if ( defined $datefrom ) {
1700         $strsth .= ' and datereceived >= ? ';
1701         push @query_params, $datefrom;
1702     }
1703
1704     if ( defined $dateto ) {
1705         $strsth .=  'and datereceived <= ? ';
1706         push @query_params, $dateto;
1707     }
1708
1709     $strsth .= "group by aqinvoices.invoicenumber,datereceived ";
1710
1711     # can't use a placeholder to place this column name.
1712     # but, we could probably be checking to make sure it is a column that will be fetched.
1713     $strsth .= "order by $order " if ($order);
1714
1715     my $sth = $dbh->prepare($strsth);
1716
1717     $sth->execute( @query_params );
1718     my $results = $sth->fetchall_arrayref({});
1719     $sth->finish;
1720     return @$results;
1721 }
1722
1723 #------------------------------------------------------------#
1724
1725 =head3 GetLateOrders
1726
1727   @results = &GetLateOrders;
1728
1729 Searches for bookseller with late orders.
1730
1731 return:
1732 the table of supplier with late issues. This table is full of hashref.
1733
1734 =cut
1735
1736 sub GetLateOrders {
1737     my $delay      = shift;
1738     my $supplierid = shift;
1739     my $branch     = shift;
1740     my $estimateddeliverydatefrom = shift;
1741     my $estimateddeliverydateto = shift;
1742
1743     my $dbh = C4::Context->dbh;
1744
1745     #BEWARE, order of parenthesis and LEFT JOIN is important for speed
1746     my $dbdriver = C4::Context->config("db_scheme") || "mysql";
1747
1748     my @query_params = ();
1749     my $select = "
1750     SELECT aqbasket.basketno,
1751         aqorders.ordernumber,
1752         DATE(aqbasket.closedate)  AS orderdate,
1753         aqorders.rrp              AS unitpricesupplier,
1754         aqorders.ecost            AS unitpricelib,
1755         aqorders.claims_count     AS claims_count,
1756         aqorders.claimed_date     AS claimed_date,
1757         aqbudgets.budget_name     AS budget,
1758         borrowers.branchcode      AS branch,
1759         aqbooksellers.name        AS supplier,
1760         aqbooksellers.id          AS supplierid,
1761         biblio.author, biblio.title,
1762         biblioitems.publishercode AS publisher,
1763         biblioitems.publicationyear,
1764         ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) AS estimateddeliverydate,
1765     ";
1766     my $from = "
1767     FROM
1768         aqorders LEFT JOIN biblio     ON biblio.biblionumber         = aqorders.biblionumber
1769         LEFT JOIN biblioitems         ON biblioitems.biblionumber    = biblio.biblionumber
1770         LEFT JOIN aqbudgets           ON aqorders.budget_id          = aqbudgets.budget_id,
1771         aqbasket LEFT JOIN borrowers  ON aqbasket.authorisedby       = borrowers.borrowernumber
1772         LEFT JOIN aqbooksellers       ON aqbasket.booksellerid       = aqbooksellers.id
1773         WHERE aqorders.basketno = aqbasket.basketno
1774         AND ( datereceived = ''
1775             OR datereceived IS NULL
1776             OR aqorders.quantityreceived < aqorders.quantity
1777         )
1778         AND aqbasket.closedate IS NOT NULL
1779         AND (aqorders.datecancellationprinted IS NULL OR aqorders.datecancellationprinted='0000-00-00')
1780     ";
1781     my $having = "";
1782     if ($dbdriver eq "mysql") {
1783         $select .= "
1784         aqorders.quantity - IFNULL(aqorders.quantityreceived,0)                 AS quantity,
1785         (aqorders.quantity - IFNULL(aqorders.quantityreceived,0)) * aqorders.rrp AS subtotal,
1786         DATEDIFF(CAST(now() AS date),closedate) AS latesince
1787         ";
1788         if ( defined $delay ) {
1789             $from .= " AND (closedate <= DATE_SUB(CAST(now() AS date),INTERVAL ? DAY)) " ;
1790             push @query_params, $delay;
1791         }
1792         $having = "
1793         HAVING quantity          <> 0
1794             AND unitpricesupplier <> 0
1795             AND unitpricelib      <> 0
1796         ";
1797     } else {
1798         # FIXME: account for IFNULL as above
1799         $select .= "
1800                 aqorders.quantity                AS quantity,
1801                 aqorders.quantity * aqorders.rrp AS subtotal,
1802                 (CAST(now() AS date) - closedate)            AS latesince
1803         ";
1804         if ( defined $delay ) {
1805             $from .= " AND (closedate <= (CAST(now() AS date) -(INTERVAL ? DAY)) ";
1806             push @query_params, $delay;
1807         }
1808     }
1809     if (defined $supplierid) {
1810         $from .= ' AND aqbasket.booksellerid = ? ';
1811         push @query_params, $supplierid;
1812     }
1813     if (defined $branch) {
1814         $from .= ' AND borrowers.branchcode LIKE ? ';
1815         push @query_params, $branch;
1816     }
1817     if ( defined $estimateddeliverydatefrom ) {
1818         $from .= '
1819             AND aqbooksellers.deliverytime IS NOT NULL
1820             AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) >= ?';
1821         push @query_params, $estimateddeliverydatefrom;
1822     }
1823     if ( defined $estimateddeliverydatefrom and defined $estimateddeliverydateto ) {
1824         $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) <= ?';
1825         push @query_params, $estimateddeliverydateto;
1826     } elsif ( defined $estimateddeliverydatefrom ) {
1827         $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) <= CAST(now() AS date)';
1828     }
1829     if (C4::Context->preference("IndependantBranches")
1830             && C4::Context->userenv
1831             && C4::Context->userenv->{flags} != 1 ) {
1832         $from .= ' AND borrowers.branchcode LIKE ? ';
1833         push @query_params, C4::Context->userenv->{branch};
1834     }
1835     my $query = "$select $from $having\nORDER BY latesince, basketno, borrowers.branchcode, supplier";
1836     $debug and print STDERR "GetLateOrders query: $query\nGetLateOrders args: " . join(" ",@query_params);
1837     my $sth = $dbh->prepare($query);
1838     $sth->execute(@query_params);
1839     my @results;
1840     while (my $data = $sth->fetchrow_hashref) {
1841         $data->{orderdate} = format_date($data->{orderdate});
1842         $data->{claimed_date} = format_date($data->{claimed_date});
1843         push @results, $data;
1844     }
1845     return @results;
1846 }
1847
1848 #------------------------------------------------------------#
1849
1850 =head3 GetHistory
1851
1852   (\@order_loop, $total_qty, $total_price, $total_qtyreceived) = GetHistory( %params );
1853
1854 Retreives some acquisition history information
1855
1856 params:
1857   title
1858   author
1859   name
1860   from_placed_on
1861   to_placed_on
1862   basket                  - search both basket name and number
1863   booksellerinvoicenumber
1864
1865 returns:
1866     $order_loop is a list of hashrefs that each look like this:
1867             {
1868                 'author'           => 'Twain, Mark',
1869                 'basketno'         => '1',
1870                 'biblionumber'     => '215',
1871                 'count'            => 1,
1872                 'creationdate'     => 'MM/DD/YYYY',
1873                 'datereceived'     => undef,
1874                 'ecost'            => '1.00',
1875                 'id'               => '1',
1876                 'invoicenumber'    => undef,
1877                 'name'             => '',
1878                 'ordernumber'      => '1',
1879                 'quantity'         => 1,
1880                 'quantityreceived' => undef,
1881                 'title'            => 'The Adventures of Huckleberry Finn'
1882             }
1883     $total_qty is the sum of all of the quantities in $order_loop
1884     $total_price is the cost of each in $order_loop times the quantity
1885     $total_qtyreceived is the sum of all of the quantityreceived entries in $order_loop
1886
1887 =cut
1888
1889 sub GetHistory {
1890 # don't run the query if there are no parameters (list would be too long for sure !)
1891     croak "No search params" unless @_;
1892     my %params = @_;
1893     my $title = $params{title};
1894     my $author = $params{author};
1895     my $isbn   = $params{isbn};
1896     my $ean    = $params{ean};
1897     my $name = $params{name};
1898     my $from_placed_on = $params{from_placed_on};
1899     my $to_placed_on = $params{to_placed_on};
1900     my $basket = $params{basket};
1901     my $booksellerinvoicenumber = $params{booksellerinvoicenumber};
1902     my $basketgroupname = $params{basketgroupname};
1903     my @order_loop;
1904     my $total_qty         = 0;
1905     my $total_qtyreceived = 0;
1906     my $total_price       = 0;
1907
1908     my $dbh   = C4::Context->dbh;
1909     my $query ="
1910         SELECT
1911             biblio.title,
1912             biblio.author,
1913             biblioitems.isbn,
1914         biblioitems.ean,
1915             aqorders.basketno,
1916             aqbasket.basketname,
1917             aqbasket.basketgroupid,
1918             aqbasketgroups.name as groupname,
1919             aqbooksellers.name,
1920             aqbasket.creationdate,
1921             aqorders.datereceived,
1922             aqorders.quantity,
1923             aqorders.quantityreceived,
1924             aqorders.ecost,
1925             aqorders.ordernumber,
1926             aqinvoices.invoicenumber,
1927             aqbooksellers.id as id,
1928             aqorders.biblionumber
1929         FROM aqorders
1930         LEFT JOIN aqbasket ON aqorders.basketno=aqbasket.basketno
1931         LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid=aqbasketgroups.id
1932         LEFT JOIN aqbooksellers ON aqbasket.booksellerid=aqbooksellers.id
1933         LEFT JOIN biblioitems ON biblioitems.biblionumber=aqorders.biblionumber
1934         LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber
1935     LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid";
1936
1937     $query .= " LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber"
1938     if ( C4::Context->preference("IndependantBranches") );
1939
1940     $query .= " WHERE (datecancellationprinted is NULL or datecancellationprinted='0000-00-00') ";
1941
1942     my @query_params  = ();
1943
1944     if ( $title ) {
1945         $query .= " AND biblio.title LIKE ? ";
1946         $title =~ s/\s+/%/g;
1947         push @query_params, "%$title%";
1948     }
1949
1950     if ( $author ) {
1951         $query .= " AND biblio.author LIKE ? ";
1952         push @query_params, "%$author%";
1953     }
1954
1955     if ( $isbn ) {
1956         $query .= " AND biblioitems.isbn LIKE ? ";
1957         push @query_params, "%$isbn%";
1958     }
1959     if ( defined $ean and $ean ) {
1960         $query .= " AND biblioitems.ean = ? ";
1961         push @query_params, "$ean";
1962     }
1963     if ( $name ) {
1964         $query .= " AND aqbooksellers.name LIKE ? ";
1965         push @query_params, "%$name%";
1966     }
1967
1968     if ( $from_placed_on ) {
1969         $query .= " AND creationdate >= ? ";
1970         push @query_params, $from_placed_on;
1971     }
1972
1973     if ( $to_placed_on ) {
1974         $query .= " AND creationdate <= ? ";
1975         push @query_params, $to_placed_on;
1976     }
1977
1978     if ($basket) {
1979         if ($basket =~ m/^\d+$/) {
1980             $query .= " AND aqorders.basketno = ? ";
1981             push @query_params, $basket;
1982         } else {
1983             $query .= " AND aqbasket.basketname LIKE ? ";
1984             push @query_params, "%$basket%";
1985         }
1986     }
1987
1988     if ($booksellerinvoicenumber) {
1989         $query .= " AND aqinvoices.invoicenumber LIKE ? ";
1990         push @query_params, "%$booksellerinvoicenumber%";
1991     }
1992
1993     if ($basketgroupname) {
1994         $query .= " AND aqbasketgroups.name LIKE ? ";
1995         push @query_params, "%$basketgroupname%";
1996     }
1997
1998     if ( C4::Context->preference("IndependantBranches") ) {
1999         my $userenv = C4::Context->userenv;
2000         if ( $userenv && ($userenv->{flags} || 0) != 1 ) {
2001             $query .= " AND (borrowers.branchcode = ? OR borrowers.branchcode ='' ) ";
2002             push @query_params, $userenv->{branch};
2003         }
2004     }
2005     $query .= " ORDER BY id";
2006     my $sth = $dbh->prepare($query);
2007     $sth->execute( @query_params );
2008     my $cnt = 1;
2009     while ( my $line = $sth->fetchrow_hashref ) {
2010         $line->{count} = $cnt++;
2011         $line->{toggle} = 1 if $cnt % 2;
2012         push @order_loop, $line;
2013         $total_qty         += $line->{'quantity'};
2014         $total_qtyreceived += $line->{'quantityreceived'};
2015         $total_price       += $line->{'quantity'} * $line->{'ecost'};
2016     }
2017     return \@order_loop, $total_qty, $total_price, $total_qtyreceived;
2018 }
2019
2020 =head2 GetRecentAcqui
2021
2022   $results = GetRecentAcqui($days);
2023
2024 C<$results> is a ref to a table which containts hashref
2025
2026 =cut
2027
2028 sub GetRecentAcqui {
2029     my $limit  = shift;
2030     my $dbh    = C4::Context->dbh;
2031     my $query = "
2032         SELECT *
2033         FROM   biblio
2034         ORDER BY timestamp DESC
2035         LIMIT  0,".$limit;
2036
2037     my $sth = $dbh->prepare($query);
2038     $sth->execute;
2039     my $results = $sth->fetchall_arrayref({});
2040     return $results;
2041 }
2042
2043 =head3 GetContracts
2044
2045   $contractlist = &GetContracts($booksellerid, $activeonly);
2046
2047 Looks up the contracts that belong to a bookseller
2048
2049 Returns a list of contracts
2050
2051 =over
2052
2053 =item C<$booksellerid> is the "id" field in the "aqbooksellers" table.
2054
2055 =item C<$activeonly> if exists get only contracts that are still active.
2056
2057 =back
2058
2059 =cut
2060
2061 sub GetContracts {
2062     my ( $booksellerid, $activeonly ) = @_;
2063     my $dbh = C4::Context->dbh;
2064     my $query;
2065     if (! $activeonly) {
2066         $query = "
2067             SELECT *
2068             FROM   aqcontract
2069             WHERE  booksellerid=?
2070         ";
2071     } else {
2072         $query = "SELECT *
2073             FROM aqcontract
2074             WHERE booksellerid=?
2075                 AND contractenddate >= CURDATE( )";
2076     }
2077     my $sth = $dbh->prepare($query);
2078     $sth->execute( $booksellerid );
2079     my @results;
2080     while (my $data = $sth->fetchrow_hashref ) {
2081         push(@results, $data);
2082     }
2083     $sth->finish;
2084     return @results;
2085 }
2086
2087 #------------------------------------------------------------#
2088
2089 =head3 GetContract
2090
2091   $contract = &GetContract($contractID);
2092
2093 Looks up the contract that has PRIMKEY (contractnumber) value $contractID
2094
2095 Returns a contract
2096
2097 =cut
2098
2099 sub GetContract {
2100     my ( $contractno ) = @_;
2101     my $dbh = C4::Context->dbh;
2102     my $query = "
2103         SELECT *
2104         FROM   aqcontract
2105         WHERE  contractnumber=?
2106         ";
2107
2108     my $sth = $dbh->prepare($query);
2109     $sth->execute( $contractno );
2110     my $result = $sth->fetchrow_hashref;
2111     return $result;
2112 }
2113
2114 =head3 AddClaim
2115
2116 =over 4
2117
2118 &AddClaim($ordernumber);
2119
2120 Add a claim for an order
2121
2122 =back
2123
2124 =cut
2125 sub AddClaim {
2126     my ($ordernumber) = @_;
2127     my $dbh          = C4::Context->dbh;
2128     my $query        = "
2129         UPDATE aqorders SET
2130             claims_count = claims_count + 1,
2131             claimed_date = CURDATE()
2132         WHERE ordernumber = ?
2133         ";
2134     my $sth = $dbh->prepare($query);
2135     $sth->execute($ordernumber);
2136 }
2137
2138 =head3 GetInvoices
2139
2140     my @invoices = GetInvoices(
2141         invoicenumber => $invoicenumber,
2142         suppliername => $suppliername,
2143         shipmentdatefrom => $shipmentdatefrom, # ISO format
2144         shipmentdateto => $shipmentdateto, # ISO format
2145         billingdatefrom => $billingdatefrom, # ISO format
2146         billingdateto => $billingdateto, # ISO format
2147         isbneanissn => $isbn_or_ean_or_issn,
2148         title => $title,
2149         author => $author,
2150         publisher => $publisher,
2151         publicationyear => $publicationyear,
2152         branchcode => $branchcode,
2153         order_by => $order_by
2154     );
2155
2156 Return a list of invoices that match all given criteria.
2157
2158 $order_by is "column_name (asc|desc)", where column_name is any of
2159 'invoicenumber', 'booksellerid', 'shipmentdate', 'billingdate', 'closedate',
2160 'shipmentcost', 'shipmentcost_budgetid'.
2161
2162 asc is the default if omitted
2163
2164 =cut
2165
2166 sub GetInvoices {
2167     my %args = @_;
2168
2169     my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2170         closedate shipmentcost shipmentcost_budgetid);
2171
2172     my $dbh = C4::Context->dbh;
2173     my $query = qq{
2174         SELECT aqinvoices.*, aqbooksellers.name AS suppliername,
2175           COUNT(
2176             DISTINCT IF(
2177               aqorders.datereceived IS NOT NULL,
2178               aqorders.biblionumber,
2179               NULL
2180             )
2181           ) AS receivedbiblios,
2182           SUM(aqorders.quantityreceived) AS receiveditems
2183         FROM aqinvoices
2184           LEFT JOIN aqbooksellers ON aqbooksellers.id = aqinvoices.booksellerid
2185           LEFT JOIN aqorders ON aqorders.invoiceid = aqinvoices.invoiceid
2186           LEFT JOIN biblio ON aqorders.biblionumber = biblio.biblionumber
2187           LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
2188           LEFT JOIN subscription ON biblio.biblionumber = subscription.biblionumber
2189     };
2190
2191     my @bind_args;
2192     my @bind_strs;
2193     if($args{supplierid}) {
2194         push @bind_strs, " aqinvoices.booksellerid = ? ";
2195         push @bind_args, $args{supplierid};
2196     }
2197     if($args{invoicenumber}) {
2198         push @bind_strs, " aqinvoices.invoicenumber LIKE ? ";
2199         push @bind_args, "%$args{invoicenumber}%";
2200     }
2201     if($args{suppliername}) {
2202         push @bind_strs, " aqbooksellers.name LIKE ? ";
2203         push @bind_args, "%$args{suppliername}%";
2204     }
2205     if($args{shipmentdatefrom}) {
2206         push @bind_strs, " aqinvoices.shipementdate >= ? ";
2207         push @bind_args, $args{shipementdatefrom};
2208     }
2209     if($args{shipmentdateto}) {
2210         push @bind_strs, " aqinvoices.shipementdate <= ? ";
2211         push @bind_args, $args{shipementdateto};
2212     }
2213     if($args{billingdatefrom}) {
2214         push @bind_strs, " aqinvoices.billingdate >= ? ";
2215         push @bind_args, $args{billingdatefrom};
2216     }
2217     if($args{billingdateto}) {
2218         push @bind_strs, " aqinvoices.billingdate <= ? ";
2219         push @bind_args, $args{billingdateto};
2220     }
2221     if($args{isbneanissn}) {
2222         push @bind_strs, " (biblioitems.isbn LIKE ? OR biblioitems.ean LIKE ? OR biblioitems.issn LIKE ? ) ";
2223         push @bind_args, $args{isbneanissn}, $args{isbneanissn}, $args{isbneanissn};
2224     }
2225     if($args{title}) {
2226         push @bind_strs, " biblio.title LIKE ? ";
2227         push @bind_args, $args{title};
2228     }
2229     if($args{author}) {
2230         push @bind_strs, " biblio.author LIKE ? ";
2231         push @bind_args, $args{author};
2232     }
2233     if($args{publisher}) {
2234         push @bind_strs, " biblioitems.publishercode LIKE ? ";
2235         push @bind_args, $args{publisher};
2236     }
2237     if($args{publicationyear}) {
2238         push @bind_strs, " biblioitems.publicationyear = ? ";
2239         push @bind_args, $args{publicationyear};
2240     }
2241     if($args{branchcode}) {
2242         push @bind_strs, " aqorders.branchcode = ? ";
2243         push @bind_args, $args{branchcode};
2244     }
2245
2246     $query .= " WHERE " . join(" AND ", @bind_strs) if @bind_strs;
2247     $query .= " GROUP BY aqinvoices.invoiceid ";
2248
2249     if($args{order_by}) {
2250         my ($column, $direction) = split / /, $args{order_by};
2251         if(grep /^$column$/, @columns) {
2252             $direction ||= 'ASC';
2253             $query .= " ORDER BY $column $direction";
2254         }
2255     }
2256
2257     my $sth = $dbh->prepare($query);
2258     $sth->execute(@bind_args);
2259
2260     my $results = $sth->fetchall_arrayref({});
2261     return @$results;
2262 }
2263
2264 =head3 GetInvoice
2265
2266     my $invoice = GetInvoice($invoiceid);
2267
2268 Get informations about invoice with given $invoiceid
2269
2270 Return a hash filled with aqinvoices.* fields
2271
2272 =cut
2273
2274 sub GetInvoice {
2275     my ($invoiceid) = @_;
2276     my $invoice;
2277
2278     return unless $invoiceid;
2279
2280     my $dbh = C4::Context->dbh;
2281     my $query = qq{
2282         SELECT *
2283         FROM aqinvoices
2284         WHERE invoiceid = ?
2285     };
2286     my $sth = $dbh->prepare($query);
2287     $sth->execute($invoiceid);
2288
2289     $invoice = $sth->fetchrow_hashref;
2290     return $invoice;
2291 }
2292
2293 =head3 GetInvoiceDetails
2294
2295     my $invoice = GetInvoiceDetails($invoiceid)
2296
2297 Return informations about an invoice + the list of related order lines
2298
2299 Orders informations are in $invoice->{orders} (array ref)
2300
2301 =cut
2302
2303 sub GetInvoiceDetails {
2304     my ($invoiceid) = @_;
2305     my $invoice;
2306
2307     return unless $invoiceid;
2308
2309     my $dbh = C4::Context->dbh;
2310     my $query = qq{
2311         SELECT aqinvoices.*, aqbooksellers.name AS suppliername
2312         FROM aqinvoices
2313           LEFT JOIN aqbooksellers ON aqinvoices.booksellerid = aqbooksellers.id
2314         WHERE invoiceid = ?
2315     };
2316     my $sth = $dbh->prepare($query);
2317     $sth->execute($invoiceid);
2318
2319     $invoice = $sth->fetchrow_hashref;
2320
2321     $query = qq{
2322         SELECT aqorders.*, biblio.*
2323         FROM aqorders
2324           LEFT JOIN biblio ON aqorders.biblionumber = biblio.biblionumber
2325         WHERE invoiceid = ?
2326     };
2327     $sth = $dbh->prepare($query);
2328     $sth->execute($invoiceid);
2329     $invoice->{orders} = $sth->fetchall_arrayref({});
2330     $invoice->{orders} ||= []; # force an empty arrayref if fetchall_arrayref fails
2331
2332     return $invoice;
2333 }
2334
2335 =head3 AddInvoice
2336
2337     my $invoiceid = AddInvoice(
2338         invoicenumber => $invoicenumber,
2339         booksellerid => $booksellerid,
2340         shipmentdate => $shipmentdate,
2341         billingdate => $billingdate,
2342         closedate => $closedate,
2343         shipmentcost => $shipmentcost,
2344         shipmentcost_budgetid => $shipmentcost_budgetid
2345     );
2346
2347 Create a new invoice and return its id or undef if it fails.
2348
2349 =cut
2350
2351 sub AddInvoice {
2352     my %invoice = @_;
2353
2354     return unless(%invoice and $invoice{invoicenumber});
2355
2356     my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2357         closedate shipmentcost shipmentcost_budgetid);
2358
2359     my @set_strs;
2360     my @set_args;
2361     foreach my $key (keys %invoice) {
2362         if(0 < grep(/^$key$/, @columns)) {
2363             push @set_strs, "$key = ?";
2364             push @set_args, ($invoice{$key} || undef);
2365         }
2366     }
2367
2368     my $rv;
2369     if(@set_args > 0) {
2370         my $dbh = C4::Context->dbh;
2371         my $query = "INSERT INTO aqinvoices SET ";
2372         $query .= join (",", @set_strs);
2373         my $sth = $dbh->prepare($query);
2374         $rv = $sth->execute(@set_args);
2375         if($rv) {
2376             $rv = $dbh->last_insert_id(undef, undef, 'aqinvoices', undef);
2377         }
2378     }
2379     return $rv;
2380 }
2381
2382 =head3 ModInvoice
2383
2384     ModInvoice(
2385         invoiceid => $invoiceid,    # Mandatory
2386         invoicenumber => $invoicenumber,
2387         booksellerid => $booksellerid,
2388         shipmentdate => $shipmentdate,
2389         billingdate => $billingdate,
2390         closedate => $closedate,
2391         shipmentcost => $shipmentcost,
2392         shipmentcost_budgetid => $shipmentcost_budgetid
2393     );
2394
2395 Modify an invoice, invoiceid is mandatory.
2396
2397 Return undef if it fails.
2398
2399 =cut
2400
2401 sub ModInvoice {
2402     my %invoice = @_;
2403
2404     return unless(%invoice and $invoice{invoiceid});
2405
2406     my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2407         closedate shipmentcost shipmentcost_budgetid);
2408
2409     my @set_strs;
2410     my @set_args;
2411     foreach my $key (keys %invoice) {
2412         if(0 < grep(/^$key$/, @columns)) {
2413             push @set_strs, "$key = ?";
2414             push @set_args, ($invoice{$key} || undef);
2415         }
2416     }
2417
2418     my $dbh = C4::Context->dbh;
2419     my $query = "UPDATE aqinvoices SET ";
2420     $query .= join(",", @set_strs);
2421     $query .= " WHERE invoiceid = ?";
2422
2423     my $sth = $dbh->prepare($query);
2424     $sth->execute(@set_args, $invoice{invoiceid});
2425 }
2426
2427 =head3 CloseInvoice
2428
2429     CloseInvoice($invoiceid);
2430
2431 Close an invoice.
2432
2433 Equivalent to ModInvoice(invoiceid => $invoiceid, closedate => undef);
2434
2435 =cut
2436
2437 sub CloseInvoice {
2438     my ($invoiceid) = @_;
2439
2440     return unless $invoiceid;
2441
2442     my $dbh = C4::Context->dbh;
2443     my $query = qq{
2444         UPDATE aqinvoices
2445         SET closedate = CAST(NOW() AS DATE)
2446         WHERE invoiceid = ?
2447     };
2448     my $sth = $dbh->prepare($query);
2449     $sth->execute($invoiceid);
2450 }
2451
2452 =head3 ReopenInvoice
2453
2454     ReopenInvoice($invoiceid);
2455
2456 Reopen an invoice
2457
2458 Equivalent to ModInvoice(invoiceid => $invoiceid, closedate => C4::Dates->new()->output('iso'))
2459
2460 =cut
2461
2462 sub ReopenInvoice {
2463     my ($invoiceid) = @_;
2464
2465     return unless $invoiceid;
2466
2467     my $dbh = C4::Context->dbh;
2468     my $query = qq{
2469         UPDATE aqinvoices
2470         SET closedate = NULL
2471         WHERE invoiceid = ?
2472     };
2473     my $sth = $dbh->prepare($query);
2474     $sth->execute($invoiceid);
2475 }
2476
2477 1;
2478 __END__
2479
2480 =head1 AUTHOR
2481
2482 Koha Development Team <http://koha-community.org/>
2483
2484 =cut