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