C4/Acquisition.pm

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