C4/Acquisition.pm

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