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