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
  33 use Time::localtime;
  34 use HTML::Entities;
  35
  36 use vars qw($VERSION @ISA @EXPORT);
  37
  38 BEGIN {
  39     # set the version for version checking
  40     $VERSION = 3.08.01.002;
  41     require Exporter;
  42     @ISA    = qw(Exporter);
  43     @EXPORT = qw(
  44         &GetBasket &NewBasket &CloseBasket &DelBasket &ModBasket
  45         &GetBasketAsCSV
  46         &GetBasketsByBookseller &GetBasketsByBasketgroup
  47         &GetBasketsInfosByBookseller
  48
  49         &ModBasketHeader
  50
  51         &ModBasketgroup &NewBasketgroup &DelBasketgroup &GetBasketgroup &CloseBasketgroup
  52         &GetBasketgroups &ReOpenBasketgroup
  53
  54         &NewOrder &DelOrder &ModOrder &GetPendingOrders &GetOrder &GetOrders
  55         &GetOrderNumber &GetLateOrders &GetOrderFromItemnumber
  56         &SearchOrder &GetHistory &GetRecentAcqui
  57         &ModReceiveOrder &ModOrderBiblioitemNumber
  58         &GetCancelledOrders
  59
  60         &NewOrderItem &ModOrderItem
  61
  62         &GetParcels &GetParcel
  63         &GetContracts &GetContract
  64
  65         &GetItemnumbersFromOrder
  66
  67         &AddClaim
  68     );
  69 }
  70
  71
  72
  73
  74
  75 sub GetOrderFromItemnumber {
  76     my ($itemnumber) = @_;
  77     my $dbh          = C4::Context->dbh;
  78     my $query        = qq|
  79
  80     SELECT  * from aqorders    LEFT JOIN aqorders_items
  81     ON (     aqorders.ordernumber = aqorders_items.ordernumber   )
  82     WHERE itemnumber = ?  |;
  83
  84     my $sth = $dbh->prepare($query);
  85
  86 #    $sth->trace(3);
  87
  88     $sth->execute($itemnumber);
  89
  90     my $order = $sth->fetchrow_hashref;
  91     return ( $order  );
  92
  93 }
  94
  95 # Returns the itemnumber(s) associated with the ordernumber given in parameter
  96 sub GetItemnumbersFromOrder {
  97     my ($ordernumber) = @_;
  98     my $dbh          = C4::Context->dbh;
  99     my $query        = "SELECT itemnumber FROM aqorders_items WHERE ordernumber=?";
 100     my $sth = $dbh->prepare($query);
 101     $sth->execute($ordernumber);
 102     my @tab;
 103
 104     while (my $order = $sth->fetchrow_hashref) {
 105     push @tab, $order->{'itemnumber'};
 106     }
 107
 108     return @tab;
 109
 110 }
 111
 112
 113
 114
 115
 116
 117 =head1 NAME
 118
 119 C4::Acquisition - Koha functions for dealing with orders and acquisitions
 120
 121 =head1 SYNOPSIS
 122
 123 use C4::Acquisition;
 124
 125 =head1 DESCRIPTION
 126
 127 The functions in this module deal with acquisitions, managing book
 128 orders, basket and parcels.
 129
 130 =head1 FUNCTIONS
 131
 132 =head2 FUNCTIONS ABOUT BASKETS
 133
 134 =head3 GetBasket
 135
 136   $aqbasket = &GetBasket($basketnumber);
 137
 138 get all basket informations in aqbasket for a given basket
 139
 140 B<returns:> informations for a given basket returned as a hashref.
 141
 142 =cut
 143
 144 sub GetBasket {
 145     my ($basketno) = @_;
 146     my $dbh        = C4::Context->dbh;
 147     my $query = "
 148         SELECT  aqbasket.*,
 149                 concat( b.firstname,' ',b.surname) AS authorisedbyname,
 150                 b.branchcode AS branch
 151         FROM    aqbasket
 152         LEFT JOIN borrowers b ON aqbasket.authorisedby=b.borrowernumber
 153         WHERE basketno=?
 154     ";
 155     my $sth=$dbh->prepare($query);
 156     $sth->execute($basketno);
 157     my $basket = $sth->fetchrow_hashref;
 158     return ( $basket );
 159 }
 160
 161 #------------------------------------------------------------#
 162
 163 =head3 NewBasket
 164
 165   $basket = &NewBasket( $booksellerid, $authorizedby, $basketname,
 166       $basketnote, $basketbooksellernote, $basketcontractnumber );
 167
 168 Create a new basket in aqbasket table
 169
 170 =over
 171
 172 =item C<$booksellerid> is a foreign key in the aqbasket table
 173
 174 =item C<$authorizedby> is the username of who created the basket
 175
 176 =back
 177
 178 The other parameters are optional, see ModBasketHeader for more info on them.
 179
 180 =cut
 181
 182 # FIXME : this function seems to be unused.
 183
 184 sub NewBasket {
 185     my ( $booksellerid, $authorisedby, $basketname, $basketnote, $basketbooksellernote, $basketcontractnumber ) = @_;
 186     my $dbh = C4::Context->dbh;
 187     my $query = "
 188         INSERT INTO aqbasket
 189                 (creationdate,booksellerid,authorisedby)
 190         VALUES  (now(),'$booksellerid','$authorisedby')
 191     ";
 192     my $sth =
 193     $dbh->do($query);
 194 #find & return basketno MYSQL dependant, but $dbh->last_insert_id always returns null :-(
 195     my $basket = $dbh->{'mysql_insertid'};
 196     ModBasketHeader($basket, $basketname || '', $basketnote || '', $basketbooksellernote || '', $basketcontractnumber || undef, $booksellerid);
 197     return $basket;
 198 }
 199
 200 #------------------------------------------------------------#
 201
 202 =head3 CloseBasket
 203
 204   &CloseBasket($basketno);
 205
 206 close a basket (becomes unmodifiable,except for recieves)
 207
 208 =cut
 209
 210 sub CloseBasket {
 211     my ($basketno) = @_;
 212     my $dbh        = C4::Context->dbh;
 213     my $query = "
 214         UPDATE aqbasket
 215         SET    closedate=now()
 216         WHERE  basketno=?
 217     ";
 218     my $sth = $dbh->prepare($query);
 219     $sth->execute($basketno);
 220 }
 221
 222 #------------------------------------------------------------#
 223
 224 =head3 GetBasketAsCSV
 225
 226   &GetBasketAsCSV($basketno);
 227
 228 Export a basket as CSV
 229
 230 =cut
 231
 232 sub GetBasketAsCSV {
 233     my ($basketno) = @_;
 234     my $basket = GetBasket($basketno);
 235     my @orders = GetOrders($basketno);
 236     my $contract = GetContract($basket->{'contractnumber'});
 237     my $csv = Text::CSV->new();
 238     my $output;
 239
 240     # TODO: Translate headers
 241     my @headers = qw(contractname ordernumber entrydate isbn author title publishercode collectiontitle notes quantity rrp);
 242
 243     $csv->combine(@headers);
 244     $output = $csv->string() . "\n";
 245
 246     my @rows;
 247     foreach my $order (@orders) {
 248         my @cols;
 249         # newlines are not valid characters for Text::CSV combine()
 250         $order->{'notes'} =~ s/[\r\n]+//g;
 251         push(@cols,
 252                 $contract->{'contractname'},
 253                 $order->{'ordernumber'},
 254                 $order->{'entrydate'},
 255                 $order->{'isbn'},
 256                 $order->{'author'},
 257                 $order->{'title'},
 258                 $order->{'publishercode'},
 259                 $order->{'collectiontitle'},
 260                 $order->{'notes'},
 261                 $order->{'quantity'},
 262                 $order->{'rrp'},
 263             );
 264         push (@rows, \@cols);
 265     }
 266
 267     foreach my $row (@rows) {
 268         $csv->combine(@$row);
 269         $output .= $csv->string() . "\n";
 270
 271     }
 272
 273     return $output;
 274
 275 }
 276
 277
 278 =head3 CloseBasketgroup
 279
 280   &CloseBasketgroup($basketgroupno);
 281
 282 close a basketgroup
 283
 284 =cut
 285
 286 sub CloseBasketgroup {
 287     my ($basketgroupno) = @_;
 288     my $dbh        = C4::Context->dbh;
 289     my $sth = $dbh->prepare("
 290         UPDATE aqbasketgroups
 291         SET    closed=1
 292         WHERE  id=?
 293     ");
 294     $sth->execute($basketgroupno);
 295 }
 296
 297 #------------------------------------------------------------#
 298
 299 =head3 ReOpenBaskergroup($basketgroupno)
 300
 301   &ReOpenBaskergroup($basketgroupno);
 302
 303 reopen a basketgroup
 304
 305 =cut
 306
 307 sub ReOpenBasketgroup {
 308     my ($basketgroupno) = @_;
 309     my $dbh        = C4::Context->dbh;
 310     my $sth = $dbh->prepare("
 311         UPDATE aqbasketgroups
 312         SET    closed=0
 313         WHERE  id=?
 314     ");
 315     $sth->execute($basketgroupno);
 316 }
 317
 318 #------------------------------------------------------------#
 319
 320
 321 =head3 DelBasket
 322
 323   &DelBasket($basketno);
 324
 325 Deletes the basket that has basketno field $basketno in the aqbasket table.
 326
 327 =over
 328
 329 =item C<$basketno> is the primary key of the basket in the aqbasket table.
 330
 331 =back
 332
 333 =cut
 334
 335 sub DelBasket {
 336     my ( $basketno ) = @_;
 337     my $query = "DELETE FROM aqbasket WHERE basketno=?";
 338     my $dbh = C4::Context->dbh;
 339     my $sth = $dbh->prepare($query);
 340     $sth->execute($basketno);
 341     $sth->finish;
 342 }
 343
 344 #------------------------------------------------------------#
 345
 346 =head3 ModBasket
 347
 348   &ModBasket($basketinfo);
 349
 350 Modifies a basket, using a hashref $basketinfo for the relevant information, only $basketinfo->{'basketno'} is required.
 351
 352 =over
 353
 354 =item C<$basketno> is the primary key of the basket in the aqbasket table.
 355
 356 =back
 357
 358 =cut
 359
 360 sub ModBasket {
 361     my $basketinfo = shift;
 362     my $query = "UPDATE aqbasket SET ";
 363     my @params;
 364     foreach my $key (keys %$basketinfo){
 365         if ($key ne 'basketno'){
 366             $query .= "$key=?, ";
 367             push(@params, $basketinfo->{$key} || undef );
 368         }
 369     }
 370 # get rid of the "," at the end of $query
 371     if (substr($query, length($query)-2) eq ', '){
 372         chop($query);
 373         chop($query);
 374         $query .= ' ';
 375     }
 376     $query .= "WHERE basketno=?";
 377     push(@params, $basketinfo->{'basketno'});
 378     my $dbh = C4::Context->dbh;
 379     my $sth = $dbh->prepare($query);
 380     $sth->execute(@params);
 381     $sth->finish;
 382 }
 383
 384 #------------------------------------------------------------#
 385
 386 =head3 ModBasketHeader
 387
 388   &ModBasketHeader($basketno, $basketname, $note, $booksellernote, $contractnumber);
 389
 390 Modifies a basket's header.
 391
 392 =over
 393
 394 =item C<$basketno> is the "basketno" field in the "aqbasket" table;
 395
 396 =item C<$basketname> is the "basketname" field in the "aqbasket" table;
 397
 398 =item C<$note> is the "note" field in the "aqbasket" table;
 399
 400 =item C<$booksellernote> is the "booksellernote" field in the "aqbasket" table;
 401
 402 =item C<$contractnumber> is the "contractnumber" (foreign) key in the "aqbasket" table.
 403
 404 =back
 405
 406 =cut
 407
 408 sub ModBasketHeader {
 409     my ($basketno, $basketname, $note, $booksellernote, $contractnumber) = @_;
 410     my $query = "UPDATE aqbasket SET basketname=?, note=?, booksellernote=? WHERE basketno=?";
 411     my $dbh = C4::Context->dbh;
 412     my $sth = $dbh->prepare($query);
 413     $sth->execute($basketname,$note,$booksellernote,$basketno);
 414     if ( $contractnumber ) {
 415         my $query2 ="UPDATE aqbasket SET contractnumber=? WHERE basketno=?";
 416         my $sth2 = $dbh->prepare($query2);
 417         $sth2->execute($contractnumber,$basketno);
 418         $sth2->finish;
 419     }
 420     $sth->finish;
 421 }
 422
 423 #------------------------------------------------------------#
 424
 425 =head3 GetBasketsByBookseller
 426
 427   @results = &GetBasketsByBookseller($booksellerid, $extra);
 428
 429 Returns a list of hashes of all the baskets that belong to bookseller 'booksellerid'.
 430
 431 =over
 432
 433 =item C<$booksellerid> is the 'id' field of the bookseller in the aqbooksellers table
 434
 435 =item C<$extra> is the extra sql parameters, can be
 436
 437  $extra->{groupby}: group baskets by column
 438     ex. $extra->{groupby} = aqbasket.basketgroupid
 439  $extra->{orderby}: order baskets by column
 440  $extra->{limit}: limit number of results (can be helpful for pagination)
 441
 442 =back
 443
 444 =cut
 445
 446 sub GetBasketsByBookseller {
 447     my ($booksellerid, $extra) = @_;
 448     my $query = "SELECT * FROM aqbasket WHERE booksellerid=?";
 449     if ($extra){
 450         if ($extra->{groupby}) {
 451             $query .= " GROUP by $extra->{groupby}";
 452         }
 453         if ($extra->{orderby}){
 454             $query .= " ORDER by $extra->{orderby}";
 455         }
 456         if ($extra->{limit}){
 457             $query .= " LIMIT $extra->{limit}";
 458         }
 459     }
 460     my $dbh = C4::Context->dbh;
 461     my $sth = $dbh->prepare($query);
 462     $sth->execute($booksellerid);
 463     my $results = $sth->fetchall_arrayref({});
 464     $sth->finish;
 465     return $results
 466 }
 467
 468 =head3 GetBasketsInfosByBookseller
 469
 470     my $baskets = GetBasketsInfosByBookseller($supplierid, $allbaskets);
 471
 472 The optional second parameter allbaskets is a boolean allowing you to
 473 select all baskets from the supplier; by default only active baskets (open or
 474 closed but still something to receive) are returned.
 475
 476 Returns in a arrayref of hashref all about booksellers baskets, plus:
 477     total_biblios: Number of distinct biblios in basket
 478     total_items: Number of items in basket
 479     expected_items: Number of non-received items in basket
 480
 481 =cut
 482
 483 sub GetBasketsInfosByBookseller {
 484     my ($supplierid, $allbaskets) = @_;
 485
 486     return unless $supplierid;
 487
 488     my $dbh = C4::Context->dbh;
 489     my $query = qq{
 490         SELECT aqbasket.*,
 491           SUM(aqorders.quantity) AS total_items,
 492           COUNT(DISTINCT aqorders.biblionumber) AS total_biblios,
 493           SUM(
 494             IF(aqorders.datereceived IS NULL
 495               AND aqorders.datecancellationprinted IS NULL
 496             , aqorders.quantity
 497             , 0)
 498           ) AS expected_items
 499         FROM aqbasket
 500           LEFT JOIN aqorders ON aqorders.basketno = aqbasket.basketno
 501         WHERE booksellerid = ?};
 502     if(!$allbaskets) {
 503         $query.=" AND (closedate IS NULL OR (aqorders.quantity > aqorders.quantityreceived AND datecancellationprinted IS NULL))";
 504     }
 505     $query.=" GROUP BY aqbasket.basketno";
 506
 507     my $sth = $dbh->prepare($query);
 508     $sth->execute($supplierid);
 509     return $sth->fetchall_arrayref({});
 510 }
 511
 512
 513 #------------------------------------------------------------#
 514
 515 =head3 GetBasketsByBasketgroup
 516
 517   $baskets = &GetBasketsByBasketgroup($basketgroupid);
 518
 519 Returns a reference to all baskets that belong to basketgroup $basketgroupid.
 520
 521 =cut
 522
 523 sub GetBasketsByBasketgroup {
 524     my $basketgroupid = shift;
 525     my $query = "SELECT * FROM aqbasket
 526                 LEFT JOIN aqcontract USING(contractnumber) WHERE basketgroupid=?";
 527     my $dbh = C4::Context->dbh;
 528     my $sth = $dbh->prepare($query);
 529     $sth->execute($basketgroupid);
 530     my $results = $sth->fetchall_arrayref({});
 531     $sth->finish;
 532     return $results
 533 }
 534
 535 #------------------------------------------------------------#
 536
 537 =head3 NewBasketgroup
 538
 539   $basketgroupid = NewBasketgroup(\%hashref);
 540
 541 Adds a basketgroup to the aqbasketgroups table, and add the initial baskets to it.
 542
 543 $hashref->{'booksellerid'} is the 'id' field of the bookseller in the aqbooksellers table,
 544
 545 $hashref->{'name'} is the 'name' field of the basketgroup in the aqbasketgroups table,
 546
 547 $hashref->{'basketlist'} is a list reference of the 'id's of the baskets that belong to this group,
 548
 549 $hashref->{'deliveryplace'} is the 'deliveryplace' field of the basketgroup in the aqbasketgroups table,
 550
 551 $hashref->{'deliverycomment'} is the 'deliverycomment' field of the basketgroup in the aqbasketgroups table,
 552
 553 $hashref->{'closed'} is the 'closed' field of the aqbasketgroups table, it is false if 0, true otherwise.
 554
 555 =cut
 556
 557 sub NewBasketgroup {
 558     my $basketgroupinfo = shift;
 559     die "booksellerid is required to create a basketgroup" unless $basketgroupinfo->{'booksellerid'};
 560     my $query = "INSERT INTO aqbasketgroups (";
 561     my @params;
 562     foreach my $field ('name', 'deliveryplace', 'deliverycomment', 'closed') {
 563         if ( $basketgroupinfo->{$field} ) {
 564             $query .= "$field, ";
 565             push(@params, $basketgroupinfo->{$field});
 566         }
 567     }
 568     $query .= "booksellerid) VALUES (";
 569     foreach (@params) {
 570         $query .= "?, ";
 571     }
 572     $query .= "?)";
 573     push(@params, $basketgroupinfo->{'booksellerid'});
 574     my $dbh = C4::Context->dbh;
 575     my $sth = $dbh->prepare($query);
 576     $sth->execute(@params);
 577     my $basketgroupid = $dbh->{'mysql_insertid'};
 578     if( $basketgroupinfo->{'basketlist'} ) {
 579         foreach my $basketno (@{$basketgroupinfo->{'basketlist'}}) {
 580             my $query2 = "UPDATE aqbasket SET basketgroupid=? WHERE basketno=?";
 581             my $sth2 = $dbh->prepare($query2);
 582             $sth2->execute($basketgroupid, $basketno);
 583         }
 584     }
 585     return $basketgroupid;
 586 }
 587
 588 #------------------------------------------------------------#
 589
 590 =head3 ModBasketgroup
 591
 592   ModBasketgroup(\%hashref);
 593
 594 Modifies a basketgroup in the aqbasketgroups table, and add the baskets to it.
 595
 596 $hashref->{'id'} is the 'id' field of the basketgroup in the aqbasketgroup table, this parameter is mandatory,
 597
 598 $hashref->{'name'} is the 'name' field of the basketgroup in the aqbasketgroups table,
 599
 600 $hashref->{'basketlist'} is a list reference of the 'id's of the baskets that belong to this group,
 601
 602 $hashref->{'billingplace'} is the 'billingplace' field of the basketgroup in the aqbasketgroups table,
 603
 604 $hashref->{'deliveryplace'} is the 'deliveryplace' field of the basketgroup in the aqbasketgroups table,
 605
 606 $hashref->{'deliverycomment'} is the 'deliverycomment' field of the basketgroup in the aqbasketgroups table,
 607
 608 $hashref->{'closed'} is the 'closed' field of the aqbasketgroups table, it is false if 0, true otherwise.
 609
 610 =cut
 611
 612 sub ModBasketgroup {
 613     my $basketgroupinfo = shift;
 614     die "basketgroup id is required to edit a basketgroup" unless $basketgroupinfo->{'id'};
 615     my $dbh = C4::Context->dbh;
 616     my $query = "UPDATE aqbasketgroups SET ";
 617     my @params;
 618     foreach my $field (qw(name billingplace deliveryplace freedeliveryplace deliverycomment closed)) {
 619         if ( defined $basketgroupinfo->{$field} ) {
 620             $query .= "$field=?, ";
 621             push(@params, $basketgroupinfo->{$field});
 622         }
 623     }
 624     chop($query);
 625     chop($query);
 626     $query .= " WHERE id=?";
 627     push(@params, $basketgroupinfo->{'id'});
 628     my $sth = $dbh->prepare($query);
 629     $sth->execute(@params);
 630
 631     $sth = $dbh->prepare('UPDATE aqbasket SET basketgroupid = NULL WHERE basketgroupid = ?');
 632     $sth->execute($basketgroupinfo->{'id'});
 633
 634     if($basketgroupinfo->{'basketlist'} && @{$basketgroupinfo->{'basketlist'}}){
 635         $sth = $dbh->prepare("UPDATE aqbasket SET basketgroupid=? WHERE basketno=?");
 636         foreach my $basketno (@{$basketgroupinfo->{'basketlist'}}) {
 637             $sth->execute($basketgroupinfo->{'id'}, $basketno);
 638             $sth->finish;
 639         }
 640     }
 641     $sth->finish;
 642 }
 643
 644 #------------------------------------------------------------#
 645
 646 =head3 DelBasketgroup
 647
 648   DelBasketgroup($basketgroupid);
 649
 650 Deletes a basketgroup in the aqbasketgroups table, and removes the reference to it from the baskets,
 651
 652 =over
 653
 654 =item C<$basketgroupid> is the 'id' field of the basket in the aqbasketgroup table
 655
 656 =back
 657
 658 =cut
 659
 660 sub DelBasketgroup {
 661     my $basketgroupid = shift;
 662     die "basketgroup id is required to edit a basketgroup" unless $basketgroupid;
 663     my $query = "DELETE FROM aqbasketgroups WHERE id=?";
 664     my $dbh = C4::Context->dbh;
 665     my $sth = $dbh->prepare($query);
 666     $sth->execute($basketgroupid);
 667     $sth->finish;
 668 }
 669
 670 #------------------------------------------------------------#
 671
 672
 673 =head2 FUNCTIONS ABOUT ORDERS
 674
 675 =head3 GetBasketgroup
 676
 677   $basketgroup = &GetBasketgroup($basketgroupid);
 678
 679 Returns a reference to the hash containing all infermation about the basketgroup.
 680
 681 =cut
 682
 683 sub GetBasketgroup {
 684     my $basketgroupid = shift;
 685     die "basketgroup id is required to edit a basketgroup" unless $basketgroupid;
 686     my $query = "SELECT * FROM aqbasketgroups WHERE id=?";
 687     my $dbh = C4::Context->dbh;
 688     my $sth = $dbh->prepare($query);
 689     $sth->execute($basketgroupid);
 690     my $result = $sth->fetchrow_hashref;
 691     $sth->finish;
 692     return $result
 693 }
 694
 695 #------------------------------------------------------------#
 696
 697 =head3 GetBasketgroups
 698
 699   $basketgroups = &GetBasketgroups($booksellerid);
 700
 701 Returns a reference to the array of all the basketgroups of bookseller $booksellerid.
 702
 703 =cut
 704
 705 sub GetBasketgroups {
 706     my $booksellerid = shift;
 707     die "bookseller id is required to edit a basketgroup" unless $booksellerid;
 708     my $query = "SELECT * FROM aqbasketgroups WHERE booksellerid=? ORDER BY `id` DESC";
 709     my $dbh = C4::Context->dbh;
 710     my $sth = $dbh->prepare($query);
 711     $sth->execute($booksellerid);
 712     my $results = $sth->fetchall_arrayref({});
 713     $sth->finish;
 714     return $results
 715 }
 716
 717 #------------------------------------------------------------#
 718
 719 =head2 FUNCTIONS ABOUT ORDERS
 720
 721 =cut
 722
 723 #------------------------------------------------------------#
 724
 725 =head3 GetPendingOrders
 726
 727 $orders = &GetPendingOrders($supplierid,$grouped,$owner,$basketno,$ordernumber,$search,$ean);
 728
 729 Finds pending orders from the bookseller with the given ID. Ignores
 730 completed and cancelled orders.
 731
 732 C<$booksellerid> contains the bookseller identifier
 733 C<$owner> contains 0 or 1. 0 means any owner. 1 means only the list of orders entered by the user itself.
 734 C<$grouped> is a boolean that, if set to 1 will group all order lines of the same basket
 735 in a single result line
 736 C<$orders> is a reference-to-array; each element is a reference-to-hash.
 737
 738 Used also by the filter in parcel.pl
 739 I have added:
 740
 741 C<$ordernumber>
 742 C<$search>
 743 C<$ean>
 744
 745 These give the value of the corresponding field in the aqorders table
 746 of the Koha database.
 747
 748 Results are ordered from most to least recent.
 749
 750 =cut
 751
 752 sub GetPendingOrders {
 753     my ($supplierid,$grouped,$owner,$basketno,$ordernumber,$search,$ean) = @_;
 754     my $dbh = C4::Context->dbh;
 755     my $strsth = "
 756         SELECT ".($grouped?"count(*),":"")."aqbasket.basketno,
 757                surname,firstname,biblio.*,biblioitems.isbn,
 758                aqbasket.closedate, aqbasket.creationdate, aqbasket.basketname,
 759                aqorders.*
 760         FROM aqorders
 761         LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
 762         LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
 763         LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber
 764         LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
 765         WHERE (quantity > quantityreceived OR quantityreceived is NULL)
 766         AND datecancellationprinted IS NULL";
 767     my @query_params;
 768     my $userenv = C4::Context->userenv;
 769     if ( C4::Context->preference("IndependantBranches") ) {
 770         if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
 771             $strsth .= " AND (borrowers.branchcode = ?
 772                         or borrowers.branchcode  = '')";
 773             push @query_params, $userenv->{branch};
 774         }
 775     }
 776     if ($supplierid) {
 777         $strsth .= " AND aqbasket.booksellerid = ?";
 778         push @query_params, $supplierid;
 779     }
 780     if($ordernumber){
 781         $strsth .= " AND (aqorders.ordernumber=?)";
 782         push @query_params, $ordernumber;
 783     }
 784     if($search){
 785         $strsth .= " AND (biblio.title like ? OR biblio.author LIKE ? OR biblioitems.isbn like ?)";
 786         push @query_params, ("%$search%","%$search%","%$search%");
 787     }
 788     if ($ean) {
 789         $strsth .= " AND biblioitems.ean = ?";
 790         push @query_params, $ean;
 791     }
 792     if ($basketno) {
 793         $strsth .= " AND aqbasket.basketno=? ";
 794         push @query_params, $basketno;
 795     }
 796     if ($owner) {
 797         $strsth .= " AND aqbasket.authorisedby=? ";
 798         push @query_params, $userenv->{'number'};
 799     }
 800     $strsth .= " group by aqbasket.basketno" if $grouped;
 801     $strsth .= " order by aqbasket.basketno";
 802     my $sth = $dbh->prepare($strsth);
 803     $sth->execute( @query_params );
 804     my $results = $sth->fetchall_arrayref({});
 805     $sth->finish;
 806     return $results;
 807 }
 808
 809 #------------------------------------------------------------#
 810
 811 =head3 GetOrders
 812
 813   @orders = &GetOrders($basketnumber, $orderby);
 814
 815 Looks up the pending (non-cancelled) orders with the given basket
 816 number. If C<$booksellerID> is non-empty, only orders from that seller
 817 are returned.
 818
 819 return :
 820 C<&basket> returns a two-element array. C<@orders> is an array of
 821 references-to-hash, whose keys are the fields from the aqorders,
 822 biblio, and biblioitems tables in the Koha database.
 823
 824 =cut
 825
 826 sub GetOrders {
 827     my ( $basketno, $orderby ) = @_;
 828     my $dbh   = C4::Context->dbh;
 829     my $query  ="
 830         SELECT biblio.*,biblioitems.*,
 831                 aqorders.*,
 832                 aqbudgets.*,
 833                 biblio.title
 834         FROM    aqorders
 835             LEFT JOIN aqbudgets        ON aqbudgets.budget_id = aqorders.budget_id
 836             LEFT JOIN biblio           ON biblio.biblionumber = aqorders.biblionumber
 837             LEFT JOIN biblioitems      ON biblioitems.biblionumber =biblio.biblionumber
 838         WHERE   basketno=?
 839             AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00')
 840     ";
 841
 842     $orderby = "biblioitems.publishercode,biblio.title" unless $orderby;
 843     $query .= " ORDER BY $orderby";
 844     my $sth = $dbh->prepare($query);
 845     $sth->execute($basketno);
 846     my $results = $sth->fetchall_arrayref({});
 847     $sth->finish;
 848     return @$results;
 849 }
 850
 851 #------------------------------------------------------------#
 852
 853 =head3 GetOrderNumber
 854
 855   $ordernumber = &GetOrderNumber($biblioitemnumber, $biblionumber);
 856
 857 Looks up the ordernumber with the given biblionumber and biblioitemnumber.
 858
 859 Returns the number of this order.
 860
 861 =over
 862
 863 =item C<$ordernumber> is the order number.
 864
 865 =back
 866
 867 =cut
 868
 869 sub GetOrderNumber {
 870     my ( $biblionumber,$biblioitemnumber ) = @_;
 871     my $dbh = C4::Context->dbh;
 872     my $query = "
 873         SELECT ordernumber
 874         FROM   aqorders
 875         WHERE  biblionumber=?
 876         AND    biblioitemnumber=?
 877     ";
 878     my $sth = $dbh->prepare($query);
 879     $sth->execute( $biblionumber, $biblioitemnumber );
 880
 881     return $sth->fetchrow;
 882 }
 883
 884 #------------------------------------------------------------#
 885
 886 =head3 GetOrder
 887
 888   $order = &GetOrder($ordernumber);
 889
 890 Looks up an order by order number.
 891
 892 Returns a reference-to-hash describing the order. The keys of
 893 C<$order> are fields from the biblio, biblioitems, aqorders tables of the Koha database.
 894
 895 =cut
 896
 897 sub GetOrder {
 898     my ($ordernumber) = @_;
 899     my $dbh      = C4::Context->dbh;
 900     my $query = "
 901         SELECT biblioitems.*, biblio.*, aqorders.*
 902         FROM   aqorders
 903         LEFT JOIN biblio on           biblio.biblionumber=aqorders.biblionumber
 904         LEFT JOIN biblioitems on       biblioitems.biblionumber=aqorders.biblionumber
 905         WHERE aqorders.ordernumber=?
 906
 907     ";
 908     my $sth= $dbh->prepare($query);
 909     $sth->execute($ordernumber);
 910     my $data = $sth->fetchrow_hashref;
 911     $sth->finish;
 912     return $data;
 913 }
 914
 915 #------------------------------------------------------------#
 916
 917 =head3 NewOrder
 918
 919   &NewOrder(\%hashref);
 920
 921 Adds a new order to the database. Any argument that isn't described
 922 below is the new value of the field with the same name in the aqorders
 923 table of the Koha database.
 924
 925 =over
 926
 927 =item $hashref->{'basketno'} is the basketno foreign key in aqorders, it is mandatory
 928
 929 =item $hashref->{'ordernumber'} is a "minimum order number."
 930
 931 =item $hashref->{'budgetdate'} is effectively ignored.
 932 If it's undef (anything false) or the string 'now', the current day is used.
 933 Else, the upcoming July 1st is used.
 934
 935 =item $hashref->{'subscription'} may be either "yes", or anything else for "no".
 936
 937 =item $hashref->{'uncertainprice'} may be 0 for "the price is known" or 1 for "the price is uncertain"
 938
 939 =item defaults entrydate to Now
 940
 941 The following keys are used: "biblionumber", "title", "basketno", "quantity", "notes", "biblioitemnumber", "rrp", "ecost", "gst", "unitprice", "subscription", "sort1", "sort2", "booksellerinvoicenumber", "listprice", "budgetdate", "purchaseordernumber", "branchcode", "booksellerinvoicenumber", "bookfundid".
 942
 943 =back
 944
 945 =cut
 946
 947 sub NewOrder {
 948     my $orderinfo = shift;
 949 #### ------------------------------
 950     my $dbh = C4::Context->dbh;
 951     my @params;
 952
 953
 954     # if these parameters are missing, we can't continue
 955     for my $key (qw/basketno quantity biblionumber budget_id/) {
 956         croak "Mandatory parameter $key missing" unless $orderinfo->{$key};
 957     }
 958
 959     if ( defined $orderinfo->{subscription} && $orderinfo->{'subscription'} eq 'yes' ) {
 960         $orderinfo->{'subscription'} = 1;
 961     } else {
 962         $orderinfo->{'subscription'} = 0;
 963     }
 964     $orderinfo->{'entrydate'} ||= C4::Dates->new()->output("iso");
 965     if (!$orderinfo->{quantityreceived}) {
 966         $orderinfo->{quantityreceived} = 0;
 967     }
 968
 969     my $ordernumber=InsertInTable("aqorders",$orderinfo);
 970     return ( $orderinfo->{'basketno'}, $ordernumber );
 971 }
 972
 973
 974
 975 #------------------------------------------------------------#
 976
 977 =head3 NewOrderItem
 978
 979   &NewOrderItem();
 980
 981 =cut
 982
 983 sub NewOrderItem {
 984     my ($itemnumber, $ordernumber)  = @_;
 985     my $dbh = C4::Context->dbh;
 986     my $query = qq|
 987             INSERT INTO aqorders_items
 988                 (itemnumber, ordernumber)
 989             VALUES (?,?)    |;
 990
 991     my $sth = $dbh->prepare($query);
 992     $sth->execute( $itemnumber, $ordernumber);
 993 }
 994
 995 #------------------------------------------------------------#
 996
 997 =head3 ModOrder
 998
 999   &ModOrder(\%hashref);
1000
1001 Modifies an existing order. Updates the order with order number
1002 $hashref->{'ordernumber'} and biblionumber $hashref->{'biblionumber'}. All
1003 other keys of the hash update the fields with the same name in the aqorders
1004 table of the Koha database.
1005
1006 =cut
1007
1008 sub ModOrder {
1009     my $orderinfo = shift;
1010
1011     die "Ordernumber is required"     if $orderinfo->{'ordernumber'} eq  '' ;
1012     die "Biblionumber is required"  if  $orderinfo->{'biblionumber'} eq '';
1013
1014     my $dbh = C4::Context->dbh;
1015     my @params;
1016
1017     # update uncertainprice to an integer, just in case (under FF, checked boxes have the value "ON" by default)
1018     $orderinfo->{uncertainprice}=1 if $orderinfo->{uncertainprice};
1019
1020 #    delete($orderinfo->{'branchcode'});
1021     # the hash contains a lot of entries not in aqorders, so get the columns ...
1022     my $sth = $dbh->prepare("SELECT * FROM aqorders LIMIT 1;");
1023     $sth->execute;
1024     my $colnames = $sth->{NAME};
1025     my $query = "UPDATE aqorders SET ";
1026
1027     foreach my $orderinfokey (grep(!/ordernumber/, keys %$orderinfo)){
1028         # ... and skip hash entries that are not in the aqorders table
1029         # FIXME : probably not the best way to do it (would be better to have a correct hash)
1030         next unless grep(/^$orderinfokey$/, @$colnames);
1031             $query .= "$orderinfokey=?, ";
1032             push(@params, $orderinfo->{$orderinfokey});
1033     }
1034
1035     $query .= "timestamp=NOW()  WHERE  ordernumber=?";
1036 #   push(@params, $specorderinfo{'ordernumber'});
1037     push(@params, $orderinfo->{'ordernumber'} );
1038     $sth = $dbh->prepare($query);
1039     $sth->execute(@params);
1040     $sth->finish;
1041 }
1042
1043 #------------------------------------------------------------#
1044
1045 =head3 ModOrderItem
1046
1047   &ModOrderItem(\%hashref);
1048
1049 Modifies the itemnumber in the aqorders_items table. The input hash needs three entities:
1050
1051 =over
1052
1053 =item - itemnumber: the old itemnumber
1054 =item - ordernumber: the order this item is attached to
1055 =item - newitemnumber: the new itemnumber we want to attach the line to
1056
1057 =back
1058
1059 =cut
1060
1061 sub ModOrderItem {
1062     my $orderiteminfo = shift;
1063     if (! $orderiteminfo->{'ordernumber'} || ! $orderiteminfo->{'itemnumber'} || ! $orderiteminfo->{'newitemnumber'}){
1064         die "Ordernumber, itemnumber and newitemnumber is required";
1065     }
1066
1067     my $dbh = C4::Context->dbh;
1068
1069     my $query = "UPDATE aqorders_items set itemnumber=? where itemnumber=? and ordernumber=?";
1070     my @params = ($orderiteminfo->{'newitemnumber'}, $orderiteminfo->{'itemnumber'}, $orderiteminfo->{'ordernumber'});
1071     my $sth = $dbh->prepare($query);
1072     $sth->execute(@params);
1073     return 0;
1074 }
1075
1076 #------------------------------------------------------------#
1077
1078
1079 =head3 ModOrderBibliotemNumber
1080
1081   &ModOrderBiblioitemNumber($biblioitemnumber,$ordernumber, $biblionumber);
1082
1083 Modifies the biblioitemnumber for an existing order.
1084 Updates the order with order number C<$ordernum> and biblionumber C<$biblionumber>.
1085
1086 =cut
1087
1088 #FIXME: is this used at all?
1089 sub ModOrderBiblioitemNumber {
1090     my ($biblioitemnumber,$ordernumber, $biblionumber) = @_;
1091     my $dbh = C4::Context->dbh;
1092     my $query = "
1093     UPDATE aqorders
1094     SET    biblioitemnumber = ?
1095     WHERE  ordernumber = ?
1096     AND biblionumber =  ?";
1097     my $sth = $dbh->prepare($query);
1098     $sth->execute( $biblioitemnumber, $ordernumber, $biblionumber );
1099 }
1100
1101 =head3 GetCancelledOrders
1102
1103   my @orders = GetCancelledOrders($basketno, $orderby);
1104
1105 Returns cancelled orders for a basket
1106
1107 =cut
1108
1109 sub GetCancelledOrders {
1110     my ( $basketno, $orderby ) = @_;
1111
1112     return () unless $basketno;
1113
1114     my $dbh   = C4::Context->dbh;
1115     my $query = "
1116         SELECT biblio.*, biblioitems.*, aqorders.*, aqbudgets.*
1117         FROM aqorders
1118           LEFT JOIN aqbudgets   ON aqbudgets.budget_id = aqorders.budget_id
1119           LEFT JOIN biblio      ON biblio.biblionumber = aqorders.biblionumber
1120           LEFT JOIN biblioitems ON biblioitems.biblionumber = biblio.biblionumber
1121         WHERE basketno = ?
1122           AND (datecancellationprinted IS NOT NULL
1123                AND datecancellationprinted <> '0000-00-00')
1124     ";
1125
1126     $orderby = "aqorders.datecancellationprinted desc, aqorders.timestamp desc"
1127         unless $orderby;
1128     $query .= " ORDER BY $orderby";
1129     my $sth = $dbh->prepare($query);
1130     $sth->execute($basketno);
1131     my $results = $sth->fetchall_arrayref( {} );
1132
1133     return @$results;
1134 }
1135
1136
1137 #------------------------------------------------------------#
1138
1139 =head3 ModReceiveOrder
1140
1141   &ModReceiveOrder($biblionumber, $ordernumber, $quantityreceived, $user,
1142     $unitprice, $booksellerinvoicenumber, $biblioitemnumber,
1143     $freight, $bookfund, $rrp);
1144
1145 Updates an order, to reflect the fact that it was received, at least
1146 in part. All arguments not mentioned below update the fields with the
1147 same name in the aqorders table of the Koha database.
1148
1149 If a partial order is received, splits the order into two.  The received
1150 portion must have a booksellerinvoicenumber.
1151
1152 Updates the order with bibilionumber C<$biblionumber> and ordernumber
1153 C<$ordernumber>.
1154
1155 =cut
1156
1157
1158 sub ModReceiveOrder {
1159     my (
1160         $biblionumber,    $ordernumber,  $quantrec, $user, $cost,
1161         $invoiceno, $freight, $rrp, $budget_id, $datereceived
1162     )
1163     = @_;
1164     my $dbh = C4::Context->dbh;
1165     $datereceived = C4::Dates->output('iso') unless $datereceived;
1166     my $suggestionid = GetSuggestionFromBiblionumber( $biblionumber );
1167     if ($suggestionid) {
1168         ModSuggestion( {suggestionid=>$suggestionid,
1169                         STATUS=>'AVAILABLE',
1170                         biblionumber=> $biblionumber}
1171                         );
1172     }
1173
1174     my $sth=$dbh->prepare("
1175         SELECT * FROM   aqorders
1176         WHERE           biblionumber=? AND aqorders.ordernumber=?");
1177
1178     $sth->execute($biblionumber,$ordernumber);
1179     my $order = $sth->fetchrow_hashref();
1180     $sth->finish();
1181
1182     if ( $order->{quantity} > $quantrec ) {
1183         $sth=$dbh->prepare("
1184             UPDATE aqorders
1185             SET quantityreceived=?
1186                 , datereceived=?
1187                 , booksellerinvoicenumber=?
1188                 , unitprice=?
1189                 , freight=?
1190                 , rrp=?
1191                 , quantity=?
1192             WHERE biblionumber=? AND ordernumber=?");
1193
1194         $sth->execute($quantrec,$datereceived,$invoiceno,$cost,$freight,$rrp,$quantrec,$biblionumber,$ordernumber);
1195         $sth->finish;
1196
1197         # create a new order for the remaining items, and set its bookfund.
1198         foreach my $orderkey ( "linenumber", "allocation" ) {
1199             delete($order->{'$orderkey'});
1200         }
1201         $order->{'quantity'} -= $quantrec;
1202         $order->{'quantityreceived'} = 0;
1203         my $newOrder = NewOrder($order);
1204 } else {
1205         $sth=$dbh->prepare("update aqorders
1206                             set quantityreceived=?,datereceived=?,booksellerinvoicenumber=?,
1207                                 unitprice=?,freight=?,rrp=?
1208                             where biblionumber=? and ordernumber=?");
1209         $sth->execute($quantrec,$datereceived,$invoiceno,$cost,$freight,$rrp,$biblionumber,$ordernumber);
1210         $sth->finish;
1211     }
1212     return $datereceived;
1213 }
1214 #------------------------------------------------------------#
1215
1216 =head3 SearchOrder
1217
1218 @results = &SearchOrder($search, $biblionumber, $complete);
1219
1220 Searches for orders.
1221
1222 C<$search> may take one of several forms: if it is an ISBN,
1223 C<&ordersearch> returns orders with that ISBN. If C<$search> is an
1224 order number, C<&ordersearch> returns orders with that order number
1225 and biblionumber C<$biblionumber>. Otherwise, C<$search> is considered
1226 to be a space-separated list of search terms; in this case, all of the
1227 terms must appear in the title (matching the beginning of title
1228 words).
1229
1230 If C<$complete> is C<yes>, the results will include only completed
1231 orders. In any case, C<&ordersearch> ignores cancelled orders.
1232
1233 C<&ordersearch> returns an array.
1234 C<@results> is an array of references-to-hash with the following keys:
1235
1236 =over 4
1237
1238 =item C<author>
1239
1240 =item C<seriestitle>
1241
1242 =item C<branchcode>
1243
1244 =item C<bookfundid>
1245
1246 =back
1247
1248 =cut
1249
1250 sub SearchOrder {
1251 #### -------- SearchOrder-------------------------------
1252     my ($ordernumber, $search, $supplierid, $basket) = @_;
1253
1254     my $dbh = C4::Context->dbh;
1255     my @args = ();
1256     my $query =
1257             "SELECT *
1258             FROM aqorders
1259             LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1260             LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
1261             LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
1262                 WHERE  (datecancellationprinted is NULL)";
1263
1264     if($ordernumber){
1265         $query .= " AND (aqorders.ordernumber=?)";
1266         push @args, $ordernumber;
1267     }
1268     if($search){
1269         $query .= " AND (biblio.title like ? OR biblio.author LIKE ? OR biblioitems.isbn like ?)";
1270         push @args, ("%$search%","%$search%","%$search%");
1271     }
1272     if($supplierid){
1273         $query .= "AND aqbasket.booksellerid = ?";
1274         push @args, $supplierid;
1275     }
1276     if($basket){
1277         $query .= "AND aqorders.basketno = ?";
1278         push @args, $basket;
1279     }
1280
1281     my $sth = $dbh->prepare($query);
1282     $sth->execute(@args);
1283     my $results = $sth->fetchall_arrayref({});
1284     $sth->finish;
1285     return $results;
1286 }
1287
1288 #------------------------------------------------------------#
1289
1290 =head3 DelOrder
1291
1292   &DelOrder($biblionumber, $ordernumber);
1293
1294 Cancel the order with the given order and biblio numbers. It does not
1295 delete any entries in the aqorders table, it merely marks them as
1296 cancelled.
1297
1298 =cut
1299
1300 sub DelOrder {
1301     my ( $bibnum, $ordernumber ) = @_;
1302     my $dbh = C4::Context->dbh;
1303     my $query = "
1304         UPDATE aqorders
1305         SET    datecancellationprinted=now()
1306         WHERE  biblionumber=? AND ordernumber=?
1307     ";
1308     my $sth = $dbh->prepare($query);
1309     $sth->execute( $bibnum, $ordernumber );
1310     $sth->finish;
1311     my @itemnumbers = GetItemnumbersFromOrder( $ordernumber );
1312     foreach my $itemnumber (@itemnumbers){
1313         C4::Items::DelItem( $dbh, $bibnum, $itemnumber );
1314     }
1315
1316 }
1317
1318 =head2 FUNCTIONS ABOUT PARCELS
1319
1320 =cut
1321
1322 #------------------------------------------------------------#
1323
1324 =head3 GetParcel
1325
1326   @results = &GetParcel($booksellerid, $code, $date);
1327
1328 Looks up all of the received items from the supplier with the given
1329 bookseller ID at the given date, for the given code (bookseller Invoice number). Ignores cancelled and completed orders.
1330
1331 C<@results> is an array of references-to-hash. The keys of each element are fields from
1332 the aqorders, biblio, and biblioitems tables of the Koha database.
1333
1334 C<@results> is sorted alphabetically by book title.
1335
1336 =cut
1337
1338 sub GetParcel {
1339     #gets all orders from a certain supplier, orders them alphabetically
1340     my ( $supplierid, $code, $datereceived ) = @_;
1341     my $dbh     = C4::Context->dbh;
1342     my @results = ();
1343     $code .= '%'
1344     if $code;  # add % if we search on a given code (otherwise, let him empty)
1345     my $strsth ="
1346         SELECT  authorisedby,
1347                 creationdate,
1348                 aqbasket.basketno,
1349                 closedate,surname,
1350                 firstname,
1351                 aqorders.biblionumber,
1352                 aqorders.ordernumber,
1353                 aqorders.quantity,
1354                 aqorders.quantityreceived,
1355                 aqorders.unitprice,
1356                 aqorders.listprice,
1357                 aqorders.rrp,
1358                 aqorders.ecost,
1359                 biblio.title
1360         FROM aqorders
1361         LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
1362         LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
1363         LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1364         WHERE
1365             aqbasket.booksellerid = ?
1366             AND aqorders.booksellerinvoicenumber LIKE ?
1367             AND aqorders.datereceived = ? ";
1368
1369     my @query_params = ( $supplierid, $code, $datereceived );
1370     if ( C4::Context->preference("IndependantBranches") ) {
1371         my $userenv = C4::Context->userenv;
1372         if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
1373             $strsth .= " and (borrowers.branchcode = ?
1374                         or borrowers.branchcode  = '')";
1375             push @query_params, $userenv->{branch};
1376         }
1377     }
1378     $strsth .= " ORDER BY aqbasket.basketno";
1379     # ## parcelinformation : $strsth
1380     my $sth = $dbh->prepare($strsth);
1381     $sth->execute( @query_params );
1382     while ( my $data = $sth->fetchrow_hashref ) {
1383         push( @results, $data );
1384     }
1385     # ## countparcelbiblio: scalar(@results)
1386     $sth->finish;
1387
1388     return @results;
1389 }
1390
1391 #------------------------------------------------------------#
1392
1393 =head3 GetParcels
1394
1395   $results = &GetParcels($bookseller, $order, $code, $datefrom, $dateto);
1396
1397 get a lists of parcels.
1398
1399 * Input arg :
1400
1401 =over
1402
1403 =item $bookseller
1404 is the bookseller this function has to get parcels.
1405
1406 =item $order
1407 To know on what criteria the results list has to be ordered.
1408
1409 =item $code
1410 is the booksellerinvoicenumber.
1411
1412 =item $datefrom & $dateto
1413 to know on what date this function has to filter its search.
1414
1415 =back
1416
1417 * return:
1418 a pointer on a hash list containing parcel informations as such :
1419
1420 =over
1421
1422 =item Creation date
1423
1424 =item Last operation
1425
1426 =item Number of biblio
1427
1428 =item Number of items
1429
1430 =back
1431
1432 =cut
1433
1434 sub GetParcels {
1435     my ($bookseller,$order, $code, $datefrom, $dateto) = @_;
1436     my $dbh    = C4::Context->dbh;
1437     my @query_params = ();
1438     my $strsth ="
1439         SELECT  aqorders.booksellerinvoicenumber,
1440                 datereceived,purchaseordernumber,
1441                 count(DISTINCT biblionumber) AS biblio,
1442                 sum(quantity) AS itemsexpected,
1443                 sum(quantityreceived) AS itemsreceived
1444         FROM   aqorders LEFT JOIN aqbasket ON aqbasket.basketno = aqorders.basketno
1445         WHERE aqbasket.booksellerid = ? and datereceived IS NOT NULL
1446     ";
1447     push @query_params, $bookseller;
1448
1449     if ( defined $code ) {
1450         $strsth .= ' and aqorders.booksellerinvoicenumber like ? ';
1451         # add a % to the end of the code to allow stemming.
1452         push @query_params, "$code%";
1453     }
1454
1455     if ( defined $datefrom ) {
1456         $strsth .= ' and datereceived >= ? ';
1457         push @query_params, $datefrom;
1458     }
1459
1460     if ( defined $dateto ) {
1461         $strsth .=  'and datereceived <= ? ';
1462         push @query_params, $dateto;
1463     }
1464
1465     $strsth .= "group by aqorders.booksellerinvoicenumber,datereceived ";
1466
1467     # can't use a placeholder to place this column name.
1468     # but, we could probably be checking to make sure it is a column that will be fetched.
1469     $strsth .= "order by $order " if ($order);
1470
1471     my $sth = $dbh->prepare($strsth);
1472
1473     $sth->execute( @query_params );
1474     my $results = $sth->fetchall_arrayref({});
1475     $sth->finish;
1476     return @$results;
1477 }
1478
1479 #------------------------------------------------------------#
1480
1481 =head3 GetLateOrders
1482
1483   @results = &GetLateOrders;
1484
1485 Searches for bookseller with late orders.
1486
1487 return:
1488 the table of supplier with late issues. This table is full of hashref.
1489
1490 =cut
1491
1492 sub GetLateOrders {
1493     my $delay      = shift;
1494     my $supplierid = shift;
1495     my $branch     = shift;
1496     my $estimateddeliverydatefrom = shift;
1497     my $estimateddeliverydateto = shift;
1498
1499     my $dbh = C4::Context->dbh;
1500
1501     #BEWARE, order of parenthesis and LEFT JOIN is important for speed
1502     my $dbdriver = C4::Context->config("db_scheme") || "mysql";
1503
1504     my @query_params = ();
1505     my $select = "
1506     SELECT aqbasket.basketno,
1507         aqorders.ordernumber,
1508         DATE(aqbasket.closedate)  AS orderdate,
1509         aqorders.rrp              AS unitpricesupplier,
1510         aqorders.ecost            AS unitpricelib,
1511         aqorders.claims_count     AS claims_count,
1512         aqorders.claimed_date     AS claimed_date,
1513         aqbudgets.budget_name     AS budget,
1514         borrowers.branchcode      AS branch,
1515         aqbooksellers.name        AS supplier,
1516         aqbooksellers.id          AS supplierid,
1517         biblio.author, biblio.title,
1518         biblioitems.publishercode AS publisher,
1519         biblioitems.publicationyear,
1520         ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) AS estimateddeliverydate,
1521     ";
1522     my $from = "
1523     FROM
1524         aqorders LEFT JOIN biblio     ON biblio.biblionumber         = aqorders.biblionumber
1525         LEFT JOIN biblioitems         ON biblioitems.biblionumber    = biblio.biblionumber
1526         LEFT JOIN aqbudgets           ON aqorders.budget_id          = aqbudgets.budget_id,
1527         aqbasket LEFT JOIN borrowers  ON aqbasket.authorisedby       = borrowers.borrowernumber
1528         LEFT JOIN aqbooksellers       ON aqbasket.booksellerid       = aqbooksellers.id
1529         WHERE aqorders.basketno = aqbasket.basketno
1530         AND ( datereceived = ''
1531             OR datereceived IS NULL
1532             OR aqorders.quantityreceived < aqorders.quantity
1533         )
1534         AND aqbasket.closedate IS NOT NULL
1535         AND (aqorders.datecancellationprinted IS NULL OR aqorders.datecancellationprinted='0000-00-00')
1536     ";
1537     my $having = "";
1538     if ($dbdriver eq "mysql") {
1539         $select .= "
1540         aqorders.quantity - IFNULL(aqorders.quantityreceived,0)                 AS quantity,
1541         (aqorders.quantity - IFNULL(aqorders.quantityreceived,0)) * aqorders.rrp AS subtotal,
1542         DATEDIFF(CAST(now() AS date),closedate) AS latesince
1543         ";
1544         if ( defined $delay ) {
1545             $from .= " AND (closedate <= DATE_SUB(CAST(now() AS date),INTERVAL ? DAY)) " ;
1546             push @query_params, $delay;
1547         }
1548         $having = "
1549         HAVING quantity          <> 0
1550             AND unitpricesupplier <> 0
1551             AND unitpricelib      <> 0
1552         ";
1553     } else {
1554         # FIXME: account for IFNULL as above
1555         $select .= "
1556                 aqorders.quantity                AS quantity,
1557                 aqorders.quantity * aqorders.rrp AS subtotal,
1558                 (CAST(now() AS date) - closedate)            AS latesince
1559         ";
1560         if ( defined $delay ) {
1561             $from .= " AND (closedate <= (CAST(now() AS date) -(INTERVAL ? DAY)) ";
1562             push @query_params, $delay;
1563         }
1564     }
1565     if (defined $supplierid) {
1566         $from .= ' AND aqbasket.booksellerid = ? ';
1567         push @query_params, $supplierid;
1568     }
1569     if (defined $branch) {
1570         $from .= ' AND borrowers.branchcode LIKE ? ';
1571         push @query_params, $branch;
1572     }
1573     if ( defined $estimateddeliverydatefrom ) {
1574         $from .= '
1575             AND aqbooksellers.deliverytime IS NOT NULL
1576             AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) >= ?';
1577         push @query_params, $estimateddeliverydatefrom;
1578     }
1579     if ( defined $estimateddeliverydatefrom and defined $estimateddeliverydateto ) {
1580         $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) <= ?';
1581         push @query_params, $estimateddeliverydateto;
1582     } elsif ( defined $estimateddeliverydatefrom ) {
1583         $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) <= CAST(now() AS date)';
1584     }
1585     if (C4::Context->preference("IndependantBranches")
1586             && C4::Context->userenv
1587             && C4::Context->userenv->{flags} != 1 ) {
1588         $from .= ' AND borrowers.branchcode LIKE ? ';
1589         push @query_params, C4::Context->userenv->{branch};
1590     }
1591     my $query = "$select $from $having\nORDER BY latesince, basketno, borrowers.branchcode, supplier";
1592     $debug and print STDERR "GetLateOrders query: $query\nGetLateOrders args: " . join(" ",@query_params);
1593     my $sth = $dbh->prepare($query);
1594     $sth->execute(@query_params);
1595     my @results;
1596     while (my $data = $sth->fetchrow_hashref) {
1597         $data->{orderdate} = format_date($data->{orderdate});
1598         $data->{claimed_date} = format_date($data->{claimed_date});
1599         push @results, $data;
1600     }
1601     return @results;
1602 }
1603
1604 #------------------------------------------------------------#
1605
1606 =head3 GetHistory
1607
1608   (\@order_loop, $total_qty, $total_price, $total_qtyreceived) = GetHistory( %params );
1609
1610 Retreives some acquisition history information
1611
1612 params:
1613   title
1614   author
1615   name
1616   from_placed_on
1617   to_placed_on
1618   basket                  - search both basket name and number
1619   booksellerinvoicenumber
1620
1621 returns:
1622     $order_loop is a list of hashrefs that each look like this:
1623             {
1624                 'author'           => 'Twain, Mark',
1625                 'basketno'         => '1',
1626                 'biblionumber'     => '215',
1627                 'count'            => 1,
1628                 'creationdate'     => 'MM/DD/YYYY',
1629                 'datereceived'     => undef,
1630                 'ecost'            => '1.00',
1631                 'id'               => '1',
1632                 'invoicenumber'    => undef,
1633                 'name'             => '',
1634                 'ordernumber'      => '1',
1635                 'quantity'         => 1,
1636                 'quantityreceived' => undef,
1637                 'title'            => 'The Adventures of Huckleberry Finn'
1638             }
1639     $total_qty is the sum of all of the quantities in $order_loop
1640     $total_price is the cost of each in $order_loop times the quantity
1641     $total_qtyreceived is the sum of all of the quantityreceived entries in $order_loop
1642
1643 =cut
1644
1645 sub GetHistory {
1646 # don't run the query if there are no parameters (list would be too long for sure !)
1647     croak "No search params" unless @_;
1648     my %params = @_;
1649     my $title = $params{title};
1650     my $author = $params{author};
1651     my $isbn   = $params{isbn};
1652     my $name = $params{name};
1653     my $from_placed_on = $params{from_placed_on};
1654     my $to_placed_on = $params{to_placed_on};
1655     my $basket = $params{basket};
1656     my $booksellerinvoicenumber = $params{booksellerinvoicenumber};
1657
1658     my @order_loop;
1659     my $total_qty         = 0;
1660     my $total_qtyreceived = 0;
1661     my $total_price       = 0;
1662
1663     my $dbh   = C4::Context->dbh;
1664     my $query ="
1665         SELECT
1666             biblio.title,
1667             biblio.author,
1668             biblioitems.isbn,
1669             aqorders.basketno,
1670     aqbasket.basketname,
1671     aqbasket.basketgroupid,
1672     aqbasketgroups.name as groupname,
1673             aqbooksellers.name,
1674     aqbasket.creationdate,
1675             aqorders.datereceived,
1676             aqorders.quantity,
1677             aqorders.quantityreceived,
1678             aqorders.ecost,
1679             aqorders.ordernumber,
1680             aqorders.booksellerinvoicenumber as invoicenumber,
1681             aqbooksellers.id as id,
1682             aqorders.biblionumber
1683         FROM aqorders
1684         LEFT JOIN aqbasket ON aqorders.basketno=aqbasket.basketno
1685     LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid=aqbasketgroups.id
1686         LEFT JOIN aqbooksellers ON aqbasket.booksellerid=aqbooksellers.id
1687         LEFT JOIN biblioitems ON biblioitems.biblionumber=aqorders.biblionumber
1688         LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber";
1689
1690     $query .= " LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber"
1691     if ( C4::Context->preference("IndependantBranches") );
1692
1693     $query .= " WHERE (datecancellationprinted is NULL or datecancellationprinted='0000-00-00') ";
1694
1695     my @query_params  = ();
1696
1697     if ( $title ) {
1698         $query .= " AND biblio.title LIKE ? ";
1699         $title =~ s/\s+/%/g;
1700         push @query_params, "%$title%";
1701     }
1702
1703     if ( $author ) {
1704         $query .= " AND biblio.author LIKE ? ";
1705         push @query_params, "%$author%";
1706     }
1707
1708     if ( $isbn ) {
1709         $query .= " AND biblioitems.isbn LIKE ? ";
1710         push @query_params, "%$isbn%";
1711     }
1712
1713     if ( $name ) {
1714         $query .= " AND aqbooksellers.name LIKE ? ";
1715         push @query_params, "%$name%";
1716     }
1717
1718     if ( $from_placed_on ) {
1719         $query .= " AND creationdate >= ? ";
1720         push @query_params, $from_placed_on;
1721     }
1722
1723     if ( $to_placed_on ) {
1724         $query .= " AND creationdate <= ? ";
1725         push @query_params, $to_placed_on;
1726     }
1727
1728     if ($basket) {
1729         if ($basket =~ m/^\d+$/) {
1730             $query .= " AND aqorders.basketno = ? ";
1731             push @query_params, $basket;
1732         } else {
1733             $query .= " AND aqbasket.basketname LIKE ? ";
1734             push @query_params, "%$basket%";
1735         }
1736     }
1737
1738     if ($booksellerinvoicenumber) {
1739         $query .= " AND (aqorders.booksellerinvoicenumber LIKE ? OR aqbasket.booksellerinvoicenumber LIKE ?)";
1740         push @query_params, "%$booksellerinvoicenumber%", "%$booksellerinvoicenumber%";
1741     }
1742
1743     if ( C4::Context->preference("IndependantBranches") ) {
1744         my $userenv = C4::Context->userenv;
1745         if ( $userenv && ($userenv->{flags} || 0) != 1 ) {
1746             $query .= " AND (borrowers.branchcode = ? OR borrowers.branchcode ='' ) ";
1747             push @query_params, $userenv->{branch};
1748         }
1749     }
1750     $query .= " ORDER BY id";
1751     my $sth = $dbh->prepare($query);
1752     $sth->execute( @query_params );
1753     my $cnt = 1;
1754     while ( my $line = $sth->fetchrow_hashref ) {
1755         $line->{count} = $cnt++;
1756         $line->{toggle} = 1 if $cnt % 2;
1757         push @order_loop, $line;
1758         $total_qty         += $line->{'quantity'};
1759         $total_qtyreceived += $line->{'quantityreceived'};
1760         $total_price       += $line->{'quantity'} * $line->{'ecost'};
1761     }
1762     return \@order_loop, $total_qty, $total_price, $total_qtyreceived;
1763 }
1764
1765 =head2 GetRecentAcqui
1766
1767   $results = GetRecentAcqui($days);
1768
1769 C<$results> is a ref to a table which containts hashref
1770
1771 =cut
1772
1773 sub GetRecentAcqui {
1774     my $limit  = shift;
1775     my $dbh    = C4::Context->dbh;
1776     my $query = "
1777         SELECT *
1778         FROM   biblio
1779         ORDER BY timestamp DESC
1780         LIMIT  0,".$limit;
1781
1782     my $sth = $dbh->prepare($query);
1783     $sth->execute;
1784     my $results = $sth->fetchall_arrayref({});
1785     return $results;
1786 }
1787
1788 =head3 GetContracts
1789
1790   $contractlist = &GetContracts($booksellerid, $activeonly);
1791
1792 Looks up the contracts that belong to a bookseller
1793
1794 Returns a list of contracts
1795
1796 =over
1797
1798 =item C<$booksellerid> is the "id" field in the "aqbooksellers" table.
1799
1800 =item C<$activeonly> if exists get only contracts that are still active.
1801
1802 =back
1803
1804 =cut
1805
1806 sub GetContracts {
1807     my ( $booksellerid, $activeonly ) = @_;
1808     my $dbh = C4::Context->dbh;
1809     my $query;
1810     if (! $activeonly) {
1811         $query = "
1812             SELECT *
1813             FROM   aqcontract
1814             WHERE  booksellerid=?
1815         ";
1816     } else {
1817         $query = "SELECT *
1818             FROM aqcontract
1819             WHERE booksellerid=?
1820                 AND contractenddate >= CURDATE( )";
1821     }
1822     my $sth = $dbh->prepare($query);
1823     $sth->execute( $booksellerid );
1824     my @results;
1825     while (my $data = $sth->fetchrow_hashref ) {
1826         push(@results, $data);
1827     }
1828     $sth->finish;
1829     return @results;
1830 }
1831
1832 #------------------------------------------------------------#
1833
1834 =head3 GetContract
1835
1836   $contract = &GetContract($contractID);
1837
1838 Looks up the contract that has PRIMKEY (contractnumber) value $contractID
1839
1840 Returns a contract
1841
1842 =cut
1843
1844 sub GetContract {
1845     my ( $contractno ) = @_;
1846     my $dbh = C4::Context->dbh;
1847     my $query = "
1848         SELECT *
1849         FROM   aqcontract
1850         WHERE  contractnumber=?
1851         ";
1852
1853     my $sth = $dbh->prepare($query);
1854     $sth->execute( $contractno );
1855     my $result = $sth->fetchrow_hashref;
1856     return $result;
1857 }
1858
1859 =head3 AddClaim
1860
1861 =over 4
1862
1863 &AddClaim($ordernumber);
1864
1865 Add a claim for an order
1866
1867 =back
1868
1869 =cut
1870 sub AddClaim {
1871     my ($ordernumber) = @_;
1872     my $dbh          = C4::Context->dbh;
1873     my $query        = "
1874         UPDATE aqorders SET
1875             claims_count = claims_count + 1,
1876             claimed_date = CURDATE()
1877         WHERE ordernumber = ?
1878         ";
1879     my $sth = $dbh->prepare($query);
1880     $sth->execute($ordernumber);
1881
1882 }
1883
1884 1;
1885 __END__
1886
1887 =head1 AUTHOR
1888
1889 Koha Development Team <http://koha-community.org/>
1890
1891 =cut