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