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