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         #FIXME Be careful. If aqorders would have columns with diacritics,
1196         #you should need to decode what you get back from NAME.
1197         #See report 10110 and guided_reports.pl
1198     my $query = "UPDATE aqorders SET ";
1199
1200     foreach my $orderinfokey (grep(!/ordernumber/, keys %$orderinfo)){
1201         # ... and skip hash entries that are not in the aqorders table
1202         # FIXME : probably not the best way to do it (would be better to have a correct hash)
1203         next unless grep(/^$orderinfokey$/, @$colnames);
1204             $query .= "$orderinfokey=?, ";
1205             push(@params, $orderinfo->{$orderinfokey});
1206     }
1207
1208     $query .= "timestamp=NOW()  WHERE  ordernumber=?";
1209 #   push(@params, $specorderinfo{'ordernumber'});
1210     push(@params, $orderinfo->{'ordernumber'} );
1211     $sth = $dbh->prepare($query);
1212     $sth->execute(@params);
1213     $sth->finish;
1214 }
1215
1216 #------------------------------------------------------------#
1217
1218 =head3 ModOrderItem
1219
1220   &ModOrderItem(\%hashref);
1221
1222 Modifies the itemnumber in the aqorders_items table. The input hash needs three entities:
1223
1224 =over
1225
1226 =item - itemnumber: the old itemnumber
1227 =item - ordernumber: the order this item is attached to
1228 =item - newitemnumber: the new itemnumber we want to attach the line to
1229
1230 =back
1231
1232 =cut
1233
1234 sub ModOrderItem {
1235     my $orderiteminfo = shift;
1236     if (! $orderiteminfo->{'ordernumber'} || ! $orderiteminfo->{'itemnumber'} || ! $orderiteminfo->{'newitemnumber'}){
1237         die "Ordernumber, itemnumber and newitemnumber is required";
1238     }
1239
1240     my $dbh = C4::Context->dbh;
1241
1242     my $query = "UPDATE aqorders_items set itemnumber=? where itemnumber=? and ordernumber=?";
1243     my @params = ($orderiteminfo->{'newitemnumber'}, $orderiteminfo->{'itemnumber'}, $orderiteminfo->{'ordernumber'});
1244     my $sth = $dbh->prepare($query);
1245     $sth->execute(@params);
1246     return 0;
1247 }
1248
1249 =head3 ModItemOrder
1250
1251     ModItemOrder($itemnumber, $ordernumber);
1252
1253 Modifies the ordernumber of an item in aqorders_items.
1254
1255 =cut
1256
1257 sub ModItemOrder {
1258     my ($itemnumber, $ordernumber) = @_;
1259
1260     return unless ($itemnumber and $ordernumber);
1261
1262     my $dbh = C4::Context->dbh;
1263     my $query = qq{
1264         UPDATE aqorders_items
1265         SET ordernumber = ?
1266         WHERE itemnumber = ?
1267     };
1268     my $sth = $dbh->prepare($query);
1269     return $sth->execute($ordernumber, $itemnumber);
1270 }
1271
1272 #------------------------------------------------------------#
1273
1274
1275 =head3 ModOrderBibliotemNumber
1276
1277   &ModOrderBiblioitemNumber($biblioitemnumber,$ordernumber, $biblionumber);
1278
1279 Modifies the biblioitemnumber for an existing order.
1280 Updates the order with order number C<$ordernum> and biblionumber C<$biblionumber>.
1281
1282 =cut
1283
1284 #FIXME: is this used at all?
1285 sub ModOrderBiblioitemNumber {
1286     my ($biblioitemnumber,$ordernumber, $biblionumber) = @_;
1287     my $dbh = C4::Context->dbh;
1288     my $query = "
1289     UPDATE aqorders
1290     SET    biblioitemnumber = ?
1291     WHERE  ordernumber = ?
1292     AND biblionumber =  ?";
1293     my $sth = $dbh->prepare($query);
1294     $sth->execute( $biblioitemnumber, $ordernumber, $biblionumber );
1295 }
1296
1297 =head3 GetCancelledOrders
1298
1299   my @orders = GetCancelledOrders($basketno, $orderby);
1300
1301 Returns cancelled orders for a basket
1302
1303 =cut
1304
1305 sub GetCancelledOrders {
1306     my ( $basketno, $orderby ) = @_;
1307
1308     return () unless $basketno;
1309
1310     my $dbh   = C4::Context->dbh;
1311     my $query = "
1312         SELECT biblio.*, biblioitems.*, aqorders.*, aqbudgets.*
1313         FROM aqorders
1314           LEFT JOIN aqbudgets   ON aqbudgets.budget_id = aqorders.budget_id
1315           LEFT JOIN biblio      ON biblio.biblionumber = aqorders.biblionumber
1316           LEFT JOIN biblioitems ON biblioitems.biblionumber = biblio.biblionumber
1317         WHERE basketno = ?
1318           AND (datecancellationprinted IS NOT NULL
1319                AND datecancellationprinted <> '0000-00-00')
1320     ";
1321
1322     $orderby = "aqorders.datecancellationprinted desc, aqorders.timestamp desc"
1323         unless $orderby;
1324     $query .= " ORDER BY $orderby";
1325     my $sth = $dbh->prepare($query);
1326     $sth->execute($basketno);
1327     my $results = $sth->fetchall_arrayref( {} );
1328
1329     return @$results;
1330 }
1331
1332
1333 #------------------------------------------------------------#
1334
1335 =head3 ModReceiveOrder
1336
1337   &ModReceiveOrder($biblionumber, $ordernumber, $quantityreceived, $user,
1338     $unitprice, $invoiceid, $biblioitemnumber,
1339     $bookfund, $rrp, \@received_itemnumbers);
1340
1341 Updates an order, to reflect the fact that it was received, at least
1342 in part. All arguments not mentioned below update the fields with the
1343 same name in the aqorders table of the Koha database.
1344
1345 If a partial order is received, splits the order into two.
1346
1347 Updates the order with bibilionumber C<$biblionumber> and ordernumber
1348 C<$ordernumber>.
1349
1350 =cut
1351
1352
1353 sub ModReceiveOrder {
1354     my (
1355         $biblionumber,    $ordernumber,  $quantrec, $user, $cost, $ecost,
1356         $invoiceid, $rrp, $budget_id, $datereceived, $received_items
1357     )
1358     = @_;
1359
1360     my $dbh = C4::Context->dbh;
1361     $datereceived = C4::Dates->output('iso') unless $datereceived;
1362     my $suggestionid = GetSuggestionFromBiblionumber( $biblionumber );
1363     if ($suggestionid) {
1364         ModSuggestion( {suggestionid=>$suggestionid,
1365                         STATUS=>'AVAILABLE',
1366                         biblionumber=> $biblionumber}
1367                         );
1368     }
1369
1370     my $sth=$dbh->prepare("
1371         SELECT * FROM   aqorders
1372         WHERE           biblionumber=? AND aqorders.ordernumber=?");
1373
1374     $sth->execute($biblionumber,$ordernumber);
1375     my $order = $sth->fetchrow_hashref();
1376     $sth->finish();
1377
1378     my $new_ordernumber = $ordernumber;
1379     if ( $order->{quantity} > $quantrec ) {
1380         # Split order line in two parts: the first is the original order line
1381         # without received items (the quantity is decreased),
1382         # the second part is a new order line with quantity=quantityrec
1383         # (entirely received)
1384         $sth=$dbh->prepare("
1385             UPDATE aqorders
1386             SET quantity = ?
1387             WHERE ordernumber = ?
1388         ");
1389
1390         $sth->execute($order->{quantity} - $quantrec, $ordernumber);
1391
1392         $sth->finish;
1393
1394         delete $order->{'ordernumber'};
1395         $order->{'quantity'} = $quantrec;
1396         $order->{'quantityreceived'} = $quantrec;
1397         $order->{'datereceived'} = $datereceived;
1398         $order->{'invoiceid'} = $invoiceid;
1399         $order->{'unitprice'} = $cost;
1400         $order->{'rrp'} = $rrp;
1401         $order->{ecost} = $ecost;
1402         $order->{'orderstatus'} = 3;    # totally received
1403         $new_ordernumber = NewOrder($order);
1404
1405         if ($received_items) {
1406             foreach my $itemnumber (@$received_items) {
1407                 ModItemOrder($itemnumber, $new_ordernumber);
1408             }
1409         }
1410     } else {
1411         $sth=$dbh->prepare("update aqorders
1412                             set quantityreceived=?,datereceived=?,invoiceid=?,
1413                                 unitprice=?,rrp=?,ecost=?
1414                             where biblionumber=? and ordernumber=?");
1415         $sth->execute($quantrec,$datereceived,$invoiceid,$cost,$rrp,$ecost,$biblionumber,$ordernumber);
1416         $sth->finish;
1417     }
1418     return ($datereceived, $new_ordernumber);
1419 }
1420
1421 =head3 CancelReceipt
1422
1423     my $parent_ordernumber = CancelReceipt($ordernumber);
1424
1425     Cancel an order line receipt and update the parent order line, as if no
1426     receipt was made.
1427     If items are created at receipt (AcqCreateItem = receiving) then delete
1428     these items.
1429
1430 =cut
1431
1432 sub CancelReceipt {
1433     my $ordernumber = shift;
1434
1435     return unless $ordernumber;
1436
1437     my $dbh = C4::Context->dbh;
1438     my $query = qq{
1439         SELECT datereceived, parent_ordernumber, quantity
1440         FROM aqorders
1441         WHERE ordernumber = ?
1442     };
1443     my $sth = $dbh->prepare($query);
1444     $sth->execute($ordernumber);
1445     my $order = $sth->fetchrow_hashref;
1446     unless($order) {
1447         warn "CancelReceipt: order $ordernumber does not exist";
1448         return;
1449     }
1450     unless($order->{'datereceived'}) {
1451         warn "CancelReceipt: order $ordernumber is not received";
1452         return;
1453     }
1454
1455     my $parent_ordernumber = $order->{'parent_ordernumber'};
1456
1457     if($parent_ordernumber == $ordernumber || not $parent_ordernumber) {
1458         # The order line has no parent, just mark it as not received
1459         $query = qq{
1460             UPDATE aqorders
1461             SET quantityreceived = ?,
1462                 datereceived = ?,
1463                 invoiceid = ?
1464             WHERE ordernumber = ?
1465         };
1466         $sth = $dbh->prepare($query);
1467         $sth->execute(0, undef, undef, $ordernumber);
1468     } else {
1469         # The order line has a parent, increase parent quantity and delete
1470         # the order line.
1471         $query = qq{
1472             SELECT quantity, datereceived
1473             FROM aqorders
1474             WHERE ordernumber = ?
1475         };
1476         $sth = $dbh->prepare($query);
1477         $sth->execute($parent_ordernumber);
1478         my $parent_order = $sth->fetchrow_hashref;
1479         unless($parent_order) {
1480             warn "Parent order $parent_ordernumber does not exist.";
1481             return;
1482         }
1483         if($parent_order->{'datereceived'}) {
1484             warn "CancelReceipt: parent order is received.".
1485                 " Can't cancel receipt.";
1486             return;
1487         }
1488         $query = qq{
1489             UPDATE aqorders
1490             SET quantity = ?
1491             WHERE ordernumber = ?
1492         };
1493         $sth = $dbh->prepare($query);
1494         my $rv = $sth->execute(
1495             $order->{'quantity'} + $parent_order->{'quantity'},
1496             $parent_ordernumber
1497         );
1498         unless($rv) {
1499             warn "Cannot update parent order line, so do not cancel".
1500                 " receipt";
1501             return;
1502         }
1503         if(C4::Context->preference('AcqCreateItem') eq 'receiving') {
1504             # Remove items that were created at receipt
1505             $query = qq{
1506                 DELETE FROM items, aqorders_items
1507                 USING items, aqorders_items
1508                 WHERE items.itemnumber = ? AND aqorders_items.itemnumber = ?
1509             };
1510             $sth = $dbh->prepare($query);
1511             my @itemnumbers = GetItemnumbersFromOrder($ordernumber);
1512             foreach my $itemnumber (@itemnumbers) {
1513                 $sth->execute($itemnumber, $itemnumber);
1514             }
1515         } else {
1516             # Update items
1517             my @itemnumbers = GetItemnumbersFromOrder($ordernumber);
1518             foreach my $itemnumber (@itemnumbers) {
1519                 ModItemOrder($itemnumber, $parent_ordernumber);
1520             }
1521         }
1522         # Delete order line
1523         $query = qq{
1524             DELETE FROM aqorders
1525             WHERE ordernumber = ?
1526         };
1527         $sth = $dbh->prepare($query);
1528         $sth->execute($ordernumber);
1529
1530     }
1531
1532     return $parent_ordernumber;
1533 }
1534
1535 #------------------------------------------------------------#
1536
1537 =head3 SearchOrder
1538
1539 @results = &SearchOrder($search, $biblionumber, $complete);
1540
1541 Searches for orders.
1542
1543 C<$search> may take one of several forms: if it is an ISBN,
1544 C<&ordersearch> returns orders with that ISBN. If C<$search> is an
1545 order number, C<&ordersearch> returns orders with that order number
1546 and biblionumber C<$biblionumber>. Otherwise, C<$search> is considered
1547 to be a space-separated list of search terms; in this case, all of the
1548 terms must appear in the title (matching the beginning of title
1549 words).
1550
1551 If C<$complete> is C<yes>, the results will include only completed
1552 orders. In any case, C<&ordersearch> ignores cancelled orders.
1553
1554 C<&ordersearch> returns an array.
1555 C<@results> is an array of references-to-hash with the following keys:
1556
1557 =over 4
1558
1559 =item C<author>
1560
1561 =item C<seriestitle>
1562
1563 =item C<branchcode>
1564
1565 =item C<budget_id>
1566
1567 =back
1568
1569 =cut
1570
1571 sub SearchOrder {
1572 #### -------- SearchOrder-------------------------------
1573     my ( $ordernumber, $search, $ean, $supplierid, $basket ) = @_;
1574
1575     my $dbh = C4::Context->dbh;
1576     my @args = ();
1577     my $query =
1578             "SELECT *
1579             FROM aqorders
1580             LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1581             LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
1582             LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
1583                 WHERE  (datecancellationprinted is NULL)";
1584
1585     if($ordernumber){
1586         $query .= " AND (aqorders.ordernumber=?)";
1587         push @args, $ordernumber;
1588     }
1589     if($search){
1590         $query .= " AND (biblio.title like ? OR biblio.author LIKE ? OR biblioitems.isbn like ?)";
1591         push @args, ("%$search%","%$search%","%$search%");
1592     }
1593     if ($ean) {
1594         $query .= " AND biblioitems.ean = ?";
1595         push @args, $ean;
1596     }
1597     if ($supplierid) {
1598         $query .= "AND aqbasket.booksellerid = ?";
1599         push @args, $supplierid;
1600     }
1601     if($basket){
1602         $query .= "AND aqorders.basketno = ?";
1603         push @args, $basket;
1604     }
1605
1606     my $sth = $dbh->prepare($query);
1607     $sth->execute(@args);
1608     my $results = $sth->fetchall_arrayref({});
1609     $sth->finish;
1610     return $results;
1611 }
1612
1613 #------------------------------------------------------------#
1614
1615 =head3 DelOrder
1616
1617   &DelOrder($biblionumber, $ordernumber);
1618
1619 Cancel the order with the given order and biblio numbers. It does not
1620 delete any entries in the aqorders table, it merely marks them as
1621 cancelled.
1622
1623 =cut
1624
1625 sub DelOrder {
1626     my ( $bibnum, $ordernumber ) = @_;
1627     my $dbh = C4::Context->dbh;
1628     my $query = "
1629         UPDATE aqorders
1630         SET    datecancellationprinted=now()
1631         WHERE  biblionumber=? AND ordernumber=?
1632     ";
1633     my $sth = $dbh->prepare($query);
1634     $sth->execute( $bibnum, $ordernumber );
1635     $sth->finish;
1636     my @itemnumbers = GetItemnumbersFromOrder( $ordernumber );
1637     foreach my $itemnumber (@itemnumbers){
1638         C4::Items::DelItem( $dbh, $bibnum, $itemnumber );
1639     }
1640
1641 }
1642
1643 =head2 FUNCTIONS ABOUT PARCELS
1644
1645 =cut
1646
1647 #------------------------------------------------------------#
1648
1649 =head3 GetParcel
1650
1651   @results = &GetParcel($booksellerid, $code, $date);
1652
1653 Looks up all of the received items from the supplier with the given
1654 bookseller ID at the given date, for the given code (bookseller Invoice number). Ignores cancelled and completed orders.
1655
1656 C<@results> is an array of references-to-hash. The keys of each element are fields from
1657 the aqorders, biblio, and biblioitems tables of the Koha database.
1658
1659 C<@results> is sorted alphabetically by book title.
1660
1661 =cut
1662
1663 sub GetParcel {
1664     #gets all orders from a certain supplier, orders them alphabetically
1665     my ( $supplierid, $code, $datereceived ) = @_;
1666     my $dbh     = C4::Context->dbh;
1667     my @results = ();
1668     $code .= '%'
1669     if $code;  # add % if we search on a given code (otherwise, let him empty)
1670     my $strsth ="
1671         SELECT  authorisedby,
1672                 creationdate,
1673                 aqbasket.basketno,
1674                 closedate,surname,
1675                 firstname,
1676                 aqorders.biblionumber,
1677                 aqorders.ordernumber,
1678                 aqorders.parent_ordernumber,
1679                 aqorders.quantity,
1680                 aqorders.quantityreceived,
1681                 aqorders.unitprice,
1682                 aqorders.listprice,
1683                 aqorders.rrp,
1684                 aqorders.ecost,
1685                 aqorders.gstrate,
1686                 biblio.title
1687         FROM aqorders
1688         LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
1689         LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
1690         LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1691         LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid
1692         WHERE
1693             aqbasket.booksellerid = ?
1694             AND aqinvoices.invoicenumber LIKE ?
1695             AND aqorders.datereceived = ? ";
1696
1697     my @query_params = ( $supplierid, $code, $datereceived );
1698     if ( C4::Context->preference("IndependantBranches") ) {
1699         my $userenv = C4::Context->userenv;
1700         if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
1701             $strsth .= " and (borrowers.branchcode = ?
1702                         or borrowers.branchcode  = '')";
1703             push @query_params, $userenv->{branch};
1704         }
1705     }
1706     $strsth .= " ORDER BY aqbasket.basketno";
1707     # ## parcelinformation : $strsth
1708     my $sth = $dbh->prepare($strsth);
1709     $sth->execute( @query_params );
1710     while ( my $data = $sth->fetchrow_hashref ) {
1711         push( @results, $data );
1712     }
1713     # ## countparcelbiblio: scalar(@results)
1714     $sth->finish;
1715
1716     return @results;
1717 }
1718
1719 #------------------------------------------------------------#
1720
1721 =head3 GetParcels
1722
1723   $results = &GetParcels($bookseller, $order, $code, $datefrom, $dateto);
1724
1725 get a lists of parcels.
1726
1727 * Input arg :
1728
1729 =over
1730
1731 =item $bookseller
1732 is the bookseller this function has to get parcels.
1733
1734 =item $order
1735 To know on what criteria the results list has to be ordered.
1736
1737 =item $code
1738 is the booksellerinvoicenumber.
1739
1740 =item $datefrom & $dateto
1741 to know on what date this function has to filter its search.
1742
1743 =back
1744
1745 * return:
1746 a pointer on a hash list containing parcel informations as such :
1747
1748 =over
1749
1750 =item Creation date
1751
1752 =item Last operation
1753
1754 =item Number of biblio
1755
1756 =item Number of items
1757
1758 =back
1759
1760 =cut
1761
1762 sub GetParcels {
1763     my ($bookseller,$order, $code, $datefrom, $dateto) = @_;
1764     my $dbh    = C4::Context->dbh;
1765     my @query_params = ();
1766     my $strsth ="
1767         SELECT  aqinvoices.invoicenumber,
1768                 datereceived,purchaseordernumber,
1769                 count(DISTINCT biblionumber) AS biblio,
1770                 sum(quantity) AS itemsexpected,
1771                 sum(quantityreceived) AS itemsreceived
1772         FROM   aqorders LEFT JOIN aqbasket ON aqbasket.basketno = aqorders.basketno
1773         LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid
1774         WHERE aqbasket.booksellerid = ? and datereceived IS NOT NULL
1775     ";
1776     push @query_params, $bookseller;
1777
1778     if ( defined $code ) {
1779         $strsth .= ' and aqinvoices.invoicenumber like ? ';
1780         # add a % to the end of the code to allow stemming.
1781         push @query_params, "$code%";
1782     }
1783
1784     if ( defined $datefrom ) {
1785         $strsth .= ' and datereceived >= ? ';
1786         push @query_params, $datefrom;
1787     }
1788
1789     if ( defined $dateto ) {
1790         $strsth .=  'and datereceived <= ? ';
1791         push @query_params, $dateto;
1792     }
1793
1794     $strsth .= "group by aqinvoices.invoicenumber,datereceived ";
1795
1796     # can't use a placeholder to place this column name.
1797     # but, we could probably be checking to make sure it is a column that will be fetched.
1798     $strsth .= "order by $order " if ($order);
1799
1800     my $sth = $dbh->prepare($strsth);
1801
1802     $sth->execute( @query_params );
1803     my $results = $sth->fetchall_arrayref({});
1804     $sth->finish;
1805     return @$results;
1806 }
1807
1808 #------------------------------------------------------------#
1809
1810 =head3 GetLateOrders
1811
1812   @results = &GetLateOrders;
1813
1814 Searches for bookseller with late orders.
1815
1816 return:
1817 the table of supplier with late issues. This table is full of hashref.
1818
1819 =cut
1820
1821 sub GetLateOrders {
1822     my $delay      = shift;
1823     my $supplierid = shift;
1824     my $branch     = shift;
1825     my $estimateddeliverydatefrom = shift;
1826     my $estimateddeliverydateto = shift;
1827
1828     my $dbh = C4::Context->dbh;
1829
1830     #BEWARE, order of parenthesis and LEFT JOIN is important for speed
1831     my $dbdriver = C4::Context->config("db_scheme") || "mysql";
1832
1833     my @query_params = ();
1834     my $select = "
1835     SELECT aqbasket.basketno,
1836         aqorders.ordernumber,
1837         DATE(aqbasket.closedate)  AS orderdate,
1838         aqorders.rrp              AS unitpricesupplier,
1839         aqorders.ecost            AS unitpricelib,
1840         aqorders.claims_count     AS claims_count,
1841         aqorders.claimed_date     AS claimed_date,
1842         aqbudgets.budget_name     AS budget,
1843         borrowers.branchcode      AS branch,
1844         aqbooksellers.name        AS supplier,
1845         aqbooksellers.id          AS supplierid,
1846         biblio.author, biblio.title,
1847         biblioitems.publishercode AS publisher,
1848         biblioitems.publicationyear,
1849         ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) AS estimateddeliverydate,
1850     ";
1851     my $from = "
1852     FROM
1853         aqorders LEFT JOIN biblio     ON biblio.biblionumber         = aqorders.biblionumber
1854         LEFT JOIN biblioitems         ON biblioitems.biblionumber    = biblio.biblionumber
1855         LEFT JOIN aqbudgets           ON aqorders.budget_id          = aqbudgets.budget_id,
1856         aqbasket LEFT JOIN borrowers  ON aqbasket.authorisedby       = borrowers.borrowernumber
1857         LEFT JOIN aqbooksellers       ON aqbasket.booksellerid       = aqbooksellers.id
1858         WHERE aqorders.basketno = aqbasket.basketno
1859         AND ( datereceived = ''
1860             OR datereceived IS NULL
1861             OR aqorders.quantityreceived < aqorders.quantity
1862         )
1863         AND aqbasket.closedate IS NOT NULL
1864         AND (aqorders.datecancellationprinted IS NULL OR aqorders.datecancellationprinted='0000-00-00')
1865     ";
1866     my $having = "";
1867     if ($dbdriver eq "mysql") {
1868         $select .= "
1869         aqorders.quantity - COALESCE(aqorders.quantityreceived,0)                 AS quantity,
1870         (aqorders.quantity - COALESCE(aqorders.quantityreceived,0)) * aqorders.rrp AS subtotal,
1871         DATEDIFF(CAST(now() AS date),closedate) AS latesince
1872         ";
1873         if ( defined $delay ) {
1874             $from .= " AND (closedate <= DATE_SUB(CAST(now() AS date),INTERVAL ? DAY)) " ;
1875             push @query_params, $delay;
1876         }
1877         $having = "
1878         HAVING quantity          <> 0
1879             AND unitpricesupplier <> 0
1880             AND unitpricelib      <> 0
1881         ";
1882     } else {
1883         # FIXME: account for IFNULL as above
1884         $select .= "
1885                 aqorders.quantity                AS quantity,
1886                 aqorders.quantity * aqorders.rrp AS subtotal,
1887                 (CAST(now() AS date) - closedate)            AS latesince
1888         ";
1889         if ( defined $delay ) {
1890             $from .= " AND (closedate <= (CAST(now() AS date) -(INTERVAL ? DAY)) ";
1891             push @query_params, $delay;
1892         }
1893     }
1894     if (defined $supplierid) {
1895         $from .= ' AND aqbasket.booksellerid = ? ';
1896         push @query_params, $supplierid;
1897     }
1898     if (defined $branch) {
1899         $from .= ' AND borrowers.branchcode LIKE ? ';
1900         push @query_params, $branch;
1901     }
1902
1903     if ( defined $estimateddeliverydatefrom or defined $estimateddeliverydateto ) {
1904         $from .= ' AND aqbooksellers.deliverytime IS NOT NULL ';
1905     }
1906     if ( defined $estimateddeliverydatefrom ) {
1907         $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) >= ?';
1908         push @query_params, $estimateddeliverydatefrom;
1909     }
1910     if ( defined $estimateddeliverydateto ) {
1911         $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) <= ?';
1912         push @query_params, $estimateddeliverydateto;
1913     }
1914     if ( defined $estimateddeliverydatefrom and not defined $estimateddeliverydateto ) {
1915         $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) <= CAST(now() AS date)';
1916     }
1917     if (C4::Context->preference("IndependantBranches")
1918             && C4::Context->userenv
1919             && C4::Context->userenv->{flags} != 1 ) {
1920         $from .= ' AND borrowers.branchcode LIKE ? ';
1921         push @query_params, C4::Context->userenv->{branch};
1922     }
1923     my $query = "$select $from $having\nORDER BY latesince, basketno, borrowers.branchcode, supplier";
1924     $debug and print STDERR "GetLateOrders query: $query\nGetLateOrders args: " . join(" ",@query_params);
1925     my $sth = $dbh->prepare($query);
1926     $sth->execute(@query_params);
1927     my @results;
1928     while (my $data = $sth->fetchrow_hashref) {
1929         $data->{orderdate} = format_date($data->{orderdate});
1930         $data->{claimed_date} = format_date($data->{claimed_date});
1931         push @results, $data;
1932     }
1933     return @results;
1934 }
1935
1936 #------------------------------------------------------------#
1937
1938 =head3 GetHistory
1939
1940   (\@order_loop, $total_qty, $total_price, $total_qtyreceived) = GetHistory( %params );
1941
1942 Retreives some acquisition history information
1943
1944 params:
1945   title
1946   author
1947   name
1948   from_placed_on
1949   to_placed_on
1950   basket                  - search both basket name and number
1951   booksellerinvoicenumber
1952
1953 returns:
1954     $order_loop is a list of hashrefs that each look like this:
1955             {
1956                 'author'           => 'Twain, Mark',
1957                 'basketno'         => '1',
1958                 'biblionumber'     => '215',
1959                 'count'            => 1,
1960                 'creationdate'     => 'MM/DD/YYYY',
1961                 'datereceived'     => undef,
1962                 'ecost'            => '1.00',
1963                 'id'               => '1',
1964                 'invoicenumber'    => undef,
1965                 'name'             => '',
1966                 'ordernumber'      => '1',
1967                 'quantity'         => 1,
1968                 'quantityreceived' => undef,
1969                 'title'            => 'The Adventures of Huckleberry Finn'
1970             }
1971     $total_qty is the sum of all of the quantities in $order_loop
1972     $total_price is the cost of each in $order_loop times the quantity
1973     $total_qtyreceived is the sum of all of the quantityreceived entries in $order_loop
1974
1975 =cut
1976
1977 sub GetHistory {
1978 # don't run the query if there are no parameters (list would be too long for sure !)
1979     croak "No search params" unless @_;
1980     my %params = @_;
1981     my $title = $params{title};
1982     my $author = $params{author};
1983     my $isbn   = $params{isbn};
1984     my $ean    = $params{ean};
1985     my $name = $params{name};
1986     my $from_placed_on = $params{from_placed_on};
1987     my $to_placed_on = $params{to_placed_on};
1988     my $basket = $params{basket};
1989     my $booksellerinvoicenumber = $params{booksellerinvoicenumber};
1990     my $basketgroupname = $params{basketgroupname};
1991     my @order_loop;
1992     my $total_qty         = 0;
1993     my $total_qtyreceived = 0;
1994     my $total_price       = 0;
1995
1996     my $dbh   = C4::Context->dbh;
1997     my $query ="
1998         SELECT
1999             biblio.title,
2000             biblio.author,
2001             biblioitems.isbn,
2002         biblioitems.ean,
2003             aqorders.basketno,
2004             aqbasket.basketname,
2005             aqbasket.basketgroupid,
2006             aqbasketgroups.name as groupname,
2007             aqbooksellers.name,
2008             aqbasket.creationdate,
2009             aqorders.datereceived,
2010             aqorders.quantity,
2011             aqorders.quantityreceived,
2012             aqorders.ecost,
2013             aqorders.ordernumber,
2014             aqinvoices.invoicenumber,
2015             aqbooksellers.id as id,
2016             aqorders.biblionumber
2017         FROM aqorders
2018         LEFT JOIN aqbasket ON aqorders.basketno=aqbasket.basketno
2019         LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid=aqbasketgroups.id
2020         LEFT JOIN aqbooksellers ON aqbasket.booksellerid=aqbooksellers.id
2021         LEFT JOIN biblioitems ON biblioitems.biblionumber=aqorders.biblionumber
2022         LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber
2023     LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid";
2024
2025     $query .= " LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber"
2026     if ( C4::Context->preference("IndependantBranches") );
2027
2028     $query .= " WHERE (datecancellationprinted is NULL or datecancellationprinted='0000-00-00') ";
2029
2030     my @query_params  = ();
2031
2032     if ( $title ) {
2033         $query .= " AND biblio.title LIKE ? ";
2034         $title =~ s/\s+/%/g;
2035         push @query_params, "%$title%";
2036     }
2037
2038     if ( $author ) {
2039         $query .= " AND biblio.author LIKE ? ";
2040         push @query_params, "%$author%";
2041     }
2042
2043     if ( $isbn ) {
2044         $query .= " AND biblioitems.isbn LIKE ? ";
2045         push @query_params, "%$isbn%";
2046     }
2047     if ( defined $ean and $ean ) {
2048         $query .= " AND biblioitems.ean = ? ";
2049         push @query_params, "$ean";
2050     }
2051     if ( $name ) {
2052         $query .= " AND aqbooksellers.name LIKE ? ";
2053         push @query_params, "%$name%";
2054     }
2055
2056     if ( $from_placed_on ) {
2057         $query .= " AND creationdate >= ? ";
2058         push @query_params, $from_placed_on;
2059     }
2060
2061     if ( $to_placed_on ) {
2062         $query .= " AND creationdate <= ? ";
2063         push @query_params, $to_placed_on;
2064     }
2065
2066     if ($basket) {
2067         if ($basket =~ m/^\d+$/) {
2068             $query .= " AND aqorders.basketno = ? ";
2069             push @query_params, $basket;
2070         } else {
2071             $query .= " AND aqbasket.basketname LIKE ? ";
2072             push @query_params, "%$basket%";
2073         }
2074     }
2075
2076     if ($booksellerinvoicenumber) {
2077         $query .= " AND aqinvoices.invoicenumber LIKE ? ";
2078         push @query_params, "%$booksellerinvoicenumber%";
2079     }
2080
2081     if ($basketgroupname) {
2082         $query .= " AND aqbasketgroups.name LIKE ? ";
2083         push @query_params, "%$basketgroupname%";
2084     }
2085
2086     if ( C4::Context->preference("IndependantBranches") ) {
2087         my $userenv = C4::Context->userenv;
2088         if ( $userenv && ($userenv->{flags} || 0) != 1 ) {
2089             $query .= " AND (borrowers.branchcode = ? OR borrowers.branchcode ='' ) ";
2090             push @query_params, $userenv->{branch};
2091         }
2092     }
2093     $query .= " ORDER BY id";
2094     my $sth = $dbh->prepare($query);
2095     $sth->execute( @query_params );
2096     my $cnt = 1;
2097     while ( my $line = $sth->fetchrow_hashref ) {
2098         $line->{count} = $cnt++;
2099         $line->{toggle} = 1 if $cnt % 2;
2100         push @order_loop, $line;
2101         $total_qty         += $line->{'quantity'};
2102         $total_qtyreceived += $line->{'quantityreceived'};
2103         $total_price       += $line->{'quantity'} * $line->{'ecost'};
2104     }
2105     return \@order_loop, $total_qty, $total_price, $total_qtyreceived;
2106 }
2107
2108 =head2 GetRecentAcqui
2109
2110   $results = GetRecentAcqui($days);
2111
2112 C<$results> is a ref to a table which containts hashref
2113
2114 =cut
2115
2116 sub GetRecentAcqui {
2117     my $limit  = shift;
2118     my $dbh    = C4::Context->dbh;
2119     my $query = "
2120         SELECT *
2121         FROM   biblio
2122         ORDER BY timestamp DESC
2123         LIMIT  0,".$limit;
2124
2125     my $sth = $dbh->prepare($query);
2126     $sth->execute;
2127     my $results = $sth->fetchall_arrayref({});
2128     return $results;
2129 }
2130
2131 =head3 GetContracts
2132
2133   $contractlist = &GetContracts($booksellerid, $activeonly);
2134
2135 Looks up the contracts that belong to a bookseller
2136
2137 Returns a list of contracts
2138
2139 =over
2140
2141 =item C<$booksellerid> is the "id" field in the "aqbooksellers" table.
2142
2143 =item C<$activeonly> if exists get only contracts that are still active.
2144
2145 =back
2146
2147 =cut
2148
2149 sub GetContracts {
2150     my ( $booksellerid, $activeonly ) = @_;
2151     my $dbh = C4::Context->dbh;
2152     my $query;
2153     if (! $activeonly) {
2154         $query = "
2155             SELECT *
2156             FROM   aqcontract
2157             WHERE  booksellerid=?
2158         ";
2159     } else {
2160         $query = "SELECT *
2161             FROM aqcontract
2162             WHERE booksellerid=?
2163                 AND contractenddate >= CURDATE( )";
2164     }
2165     my $sth = $dbh->prepare($query);
2166     $sth->execute( $booksellerid );
2167     my @results;
2168     while (my $data = $sth->fetchrow_hashref ) {
2169         push(@results, $data);
2170     }
2171     $sth->finish;
2172     return @results;
2173 }
2174
2175 #------------------------------------------------------------#
2176
2177 =head3 GetContract
2178
2179   $contract = &GetContract($contractID);
2180
2181 Looks up the contract that has PRIMKEY (contractnumber) value $contractID
2182
2183 Returns a contract
2184
2185 =cut
2186
2187 sub GetContract {
2188     my ( $contractno ) = @_;
2189     my $dbh = C4::Context->dbh;
2190     my $query = "
2191         SELECT *
2192         FROM   aqcontract
2193         WHERE  contractnumber=?
2194         ";
2195
2196     my $sth = $dbh->prepare($query);
2197     $sth->execute( $contractno );
2198     my $result = $sth->fetchrow_hashref;
2199     return $result;
2200 }
2201
2202 =head3 AddClaim
2203
2204 =over 4
2205
2206 &AddClaim($ordernumber);
2207
2208 Add a claim for an order
2209
2210 =back
2211
2212 =cut
2213 sub AddClaim {
2214     my ($ordernumber) = @_;
2215     my $dbh          = C4::Context->dbh;
2216     my $query        = "
2217         UPDATE aqorders SET
2218             claims_count = claims_count + 1,
2219             claimed_date = CURDATE()
2220         WHERE ordernumber = ?
2221         ";
2222     my $sth = $dbh->prepare($query);
2223     $sth->execute($ordernumber);
2224 }
2225
2226 =head3 GetInvoices
2227
2228     my @invoices = GetInvoices(
2229         invoicenumber => $invoicenumber,
2230         suppliername => $suppliername,
2231         shipmentdatefrom => $shipmentdatefrom, # ISO format
2232         shipmentdateto => $shipmentdateto, # ISO format
2233         billingdatefrom => $billingdatefrom, # ISO format
2234         billingdateto => $billingdateto, # ISO format
2235         isbneanissn => $isbn_or_ean_or_issn,
2236         title => $title,
2237         author => $author,
2238         publisher => $publisher,
2239         publicationyear => $publicationyear,
2240         branchcode => $branchcode,
2241         order_by => $order_by
2242     );
2243
2244 Return a list of invoices that match all given criteria.
2245
2246 $order_by is "column_name (asc|desc)", where column_name is any of
2247 'invoicenumber', 'booksellerid', 'shipmentdate', 'billingdate', 'closedate',
2248 'shipmentcost', 'shipmentcost_budgetid'.
2249
2250 asc is the default if omitted
2251
2252 =cut
2253
2254 sub GetInvoices {
2255     my %args = @_;
2256
2257     my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2258         closedate shipmentcost shipmentcost_budgetid);
2259
2260     my $dbh = C4::Context->dbh;
2261     my $query = qq{
2262         SELECT aqinvoices.*, aqbooksellers.name AS suppliername,
2263           COUNT(
2264             DISTINCT IF(
2265               aqorders.datereceived IS NOT NULL,
2266               aqorders.biblionumber,
2267               NULL
2268             )
2269           ) AS receivedbiblios,
2270           SUM(aqorders.quantityreceived) AS receiveditems
2271         FROM aqinvoices
2272           LEFT JOIN aqbooksellers ON aqbooksellers.id = aqinvoices.booksellerid
2273           LEFT JOIN aqorders ON aqorders.invoiceid = aqinvoices.invoiceid
2274           LEFT JOIN biblio ON aqorders.biblionumber = biblio.biblionumber
2275           LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
2276           LEFT JOIN subscription ON biblio.biblionumber = subscription.biblionumber
2277     };
2278
2279     my @bind_args;
2280     my @bind_strs;
2281     if($args{supplierid}) {
2282         push @bind_strs, " aqinvoices.booksellerid = ? ";
2283         push @bind_args, $args{supplierid};
2284     }
2285     if($args{invoicenumber}) {
2286         push @bind_strs, " aqinvoices.invoicenumber LIKE ? ";
2287         push @bind_args, "%$args{invoicenumber}%";
2288     }
2289     if($args{suppliername}) {
2290         push @bind_strs, " aqbooksellers.name LIKE ? ";
2291         push @bind_args, "%$args{suppliername}%";
2292     }
2293     if($args{shipmentdatefrom}) {
2294         push @bind_strs, " aqinvoices.shipementdate >= ? ";
2295         push @bind_args, $args{shipmentdatefrom};
2296     }
2297     if($args{shipmentdateto}) {
2298         push @bind_strs, " aqinvoices.shipementdate <= ? ";
2299         push @bind_args, $args{shipmentdateto};
2300     }
2301     if($args{billingdatefrom}) {
2302         push @bind_strs, " aqinvoices.billingdate >= ? ";
2303         push @bind_args, $args{billingdatefrom};
2304     }
2305     if($args{billingdateto}) {
2306         push @bind_strs, " aqinvoices.billingdate <= ? ";
2307         push @bind_args, $args{billingdateto};
2308     }
2309     if($args{isbneanissn}) {
2310         push @bind_strs, " (biblioitems.isbn LIKE ? OR biblioitems.ean LIKE ? OR biblioitems.issn LIKE ? ) ";
2311         push @bind_args, $args{isbneanissn}, $args{isbneanissn}, $args{isbneanissn};
2312     }
2313     if($args{title}) {
2314         push @bind_strs, " biblio.title LIKE ? ";
2315         push @bind_args, $args{title};
2316     }
2317     if($args{author}) {
2318         push @bind_strs, " biblio.author LIKE ? ";
2319         push @bind_args, $args{author};
2320     }
2321     if($args{publisher}) {
2322         push @bind_strs, " biblioitems.publishercode LIKE ? ";
2323         push @bind_args, $args{publisher};
2324     }
2325     if($args{publicationyear}) {
2326         push @bind_strs, " biblioitems.publicationyear = ? ";
2327         push @bind_args, $args{publicationyear};
2328     }
2329     if($args{branchcode}) {
2330         push @bind_strs, " aqorders.branchcode = ? ";
2331         push @bind_args, $args{branchcode};
2332     }
2333
2334     $query .= " WHERE " . join(" AND ", @bind_strs) if @bind_strs;
2335     $query .= " GROUP BY aqinvoices.invoiceid ";
2336
2337     if($args{order_by}) {
2338         my ($column, $direction) = split / /, $args{order_by};
2339         if(grep /^$column$/, @columns) {
2340             $direction ||= 'ASC';
2341             $query .= " ORDER BY $column $direction";
2342         }
2343     }
2344
2345     my $sth = $dbh->prepare($query);
2346     $sth->execute(@bind_args);
2347
2348     my $results = $sth->fetchall_arrayref({});
2349     return @$results;
2350 }
2351
2352 =head3 GetInvoice
2353
2354     my $invoice = GetInvoice($invoiceid);
2355
2356 Get informations about invoice with given $invoiceid
2357
2358 Return a hash filled with aqinvoices.* fields
2359
2360 =cut
2361
2362 sub GetInvoice {
2363     my ($invoiceid) = @_;
2364     my $invoice;
2365
2366     return unless $invoiceid;
2367
2368     my $dbh = C4::Context->dbh;
2369     my $query = qq{
2370         SELECT *
2371         FROM aqinvoices
2372         WHERE invoiceid = ?
2373     };
2374     my $sth = $dbh->prepare($query);
2375     $sth->execute($invoiceid);
2376
2377     $invoice = $sth->fetchrow_hashref;
2378     return $invoice;
2379 }
2380
2381 =head3 GetInvoiceDetails
2382
2383     my $invoice = GetInvoiceDetails($invoiceid)
2384
2385 Return informations about an invoice + the list of related order lines
2386
2387 Orders informations are in $invoice->{orders} (array ref)
2388
2389 =cut
2390
2391 sub GetInvoiceDetails {
2392     my ($invoiceid) = @_;
2393
2394     if ( !defined $invoiceid ) {
2395         carp 'GetInvoiceDetails called without an invoiceid';
2396         return;
2397     }
2398
2399     my $dbh = C4::Context->dbh;
2400     my $query = qq{
2401         SELECT aqinvoices.*, aqbooksellers.name AS suppliername
2402         FROM aqinvoices
2403           LEFT JOIN aqbooksellers ON aqinvoices.booksellerid = aqbooksellers.id
2404         WHERE invoiceid = ?
2405     };
2406     my $sth = $dbh->prepare($query);
2407     $sth->execute($invoiceid);
2408
2409     my $invoice = $sth->fetchrow_hashref;
2410
2411     $query = qq{
2412         SELECT aqorders.*, biblio.*
2413         FROM aqorders
2414           LEFT JOIN biblio ON aqorders.biblionumber = biblio.biblionumber
2415         WHERE invoiceid = ?
2416     };
2417     $sth = $dbh->prepare($query);
2418     $sth->execute($invoiceid);
2419     $invoice->{orders} = $sth->fetchall_arrayref({});
2420     $invoice->{orders} ||= []; # force an empty arrayref if fetchall_arrayref fails
2421
2422     return $invoice;
2423 }
2424
2425 =head3 AddInvoice
2426
2427     my $invoiceid = AddInvoice(
2428         invoicenumber => $invoicenumber,
2429         booksellerid => $booksellerid,
2430         shipmentdate => $shipmentdate,
2431         billingdate => $billingdate,
2432         closedate => $closedate,
2433         shipmentcost => $shipmentcost,
2434         shipmentcost_budgetid => $shipmentcost_budgetid
2435     );
2436
2437 Create a new invoice and return its id or undef if it fails.
2438
2439 =cut
2440
2441 sub AddInvoice {
2442     my %invoice = @_;
2443
2444     return unless(%invoice and $invoice{invoicenumber});
2445
2446     my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2447         closedate shipmentcost shipmentcost_budgetid);
2448
2449     my @set_strs;
2450     my @set_args;
2451     foreach my $key (keys %invoice) {
2452         if(0 < grep(/^$key$/, @columns)) {
2453             push @set_strs, "$key = ?";
2454             push @set_args, ($invoice{$key} || undef);
2455         }
2456     }
2457
2458     my $rv;
2459     if(@set_args > 0) {
2460         my $dbh = C4::Context->dbh;
2461         my $query = "INSERT INTO aqinvoices SET ";
2462         $query .= join (",", @set_strs);
2463         my $sth = $dbh->prepare($query);
2464         $rv = $sth->execute(@set_args);
2465         if($rv) {
2466             $rv = $dbh->last_insert_id(undef, undef, 'aqinvoices', undef);
2467         }
2468     }
2469     return $rv;
2470 }
2471
2472 =head3 ModInvoice
2473
2474     ModInvoice(
2475         invoiceid => $invoiceid,    # Mandatory
2476         invoicenumber => $invoicenumber,
2477         booksellerid => $booksellerid,
2478         shipmentdate => $shipmentdate,
2479         billingdate => $billingdate,
2480         closedate => $closedate,
2481         shipmentcost => $shipmentcost,
2482         shipmentcost_budgetid => $shipmentcost_budgetid
2483     );
2484
2485 Modify an invoice, invoiceid is mandatory.
2486
2487 Return undef if it fails.
2488
2489 =cut
2490
2491 sub ModInvoice {
2492     my %invoice = @_;
2493
2494     return unless(%invoice and $invoice{invoiceid});
2495
2496     my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2497         closedate shipmentcost shipmentcost_budgetid);
2498
2499     my @set_strs;
2500     my @set_args;
2501     foreach my $key (keys %invoice) {
2502         if(0 < grep(/^$key$/, @columns)) {
2503             push @set_strs, "$key = ?";
2504             push @set_args, ($invoice{$key} || undef);
2505         }
2506     }
2507
2508     my $dbh = C4::Context->dbh;
2509     my $query = "UPDATE aqinvoices SET ";
2510     $query .= join(",", @set_strs);
2511     $query .= " WHERE invoiceid = ?";
2512
2513     my $sth = $dbh->prepare($query);
2514     $sth->execute(@set_args, $invoice{invoiceid});
2515 }
2516
2517 =head3 CloseInvoice
2518
2519     CloseInvoice($invoiceid);
2520
2521 Close an invoice.
2522
2523 Equivalent to ModInvoice(invoiceid => $invoiceid, closedate => undef);
2524
2525 =cut
2526
2527 sub CloseInvoice {
2528     my ($invoiceid) = @_;
2529
2530     return unless $invoiceid;
2531
2532     my $dbh = C4::Context->dbh;
2533     my $query = qq{
2534         UPDATE aqinvoices
2535         SET closedate = CAST(NOW() AS DATE)
2536         WHERE invoiceid = ?
2537     };
2538     my $sth = $dbh->prepare($query);
2539     $sth->execute($invoiceid);
2540 }
2541
2542 =head3 ReopenInvoice
2543
2544     ReopenInvoice($invoiceid);
2545
2546 Reopen an invoice
2547
2548 Equivalent to ModInvoice(invoiceid => $invoiceid, closedate => C4::Dates->new()->output('iso'))
2549
2550 =cut
2551
2552 sub ReopenInvoice {
2553     my ($invoiceid) = @_;
2554
2555     return unless $invoiceid;
2556
2557     my $dbh = C4::Context->dbh;
2558     my $query = qq{
2559         UPDATE aqinvoices
2560         SET closedate = NULL
2561         WHERE invoiceid = ?
2562     };
2563     my $sth = $dbh->prepare($query);
2564     $sth->execute($invoiceid);
2565 }
2566
2567 1;
2568 __END__
2569
2570 =head1 AUTHOR
2571
2572 Koha Development Team <http://koha-community.org/>
2573
2574 =cut