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