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