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.07.00.049;
  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 &ModItemOrder
  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, $booksellerid);
 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 =item C<$booksellerid> is the id (foreign) key in the "aqbooksellers" table for the vendor.
 405
 406 =back
 407
 408 =cut
 409
 410 sub ModBasketHeader {
 411     my ($basketno, $basketname, $note, $booksellernote, $contractnumber, $booksellerid) = @_;
 412
 413     my $query = "UPDATE aqbasket SET basketname=?, note=?, booksellernote=?, booksellerid=? WHERE basketno=?";
 414     my $dbh = C4::Context->dbh;
 415     my $sth = $dbh->prepare($query);
 416     $sth->execute($basketname,$note,$booksellernote,$booksellerid,$basketno);
 417
 418     if ( $contractnumber ) {
 419         my $query2 ="UPDATE aqbasket SET contractnumber=? WHERE basketno=?";
 420         my $sth2 = $dbh->prepare($query2);
 421         $sth2->execute($contractnumber,$basketno);
 422         $sth2->finish;
 423     }
 424     $sth->finish;
 425 }
 426
 427 #------------------------------------------------------------#
 428
 429 =head3 GetBasketsByBookseller
 430
 431   @results = &GetBasketsByBookseller($booksellerid, $extra);
 432
 433 Returns a list of hashes of all the baskets that belong to bookseller 'booksellerid'.
 434
 435 =over
 436
 437 =item C<$booksellerid> is the 'id' field of the bookseller in the aqbooksellers table
 438
 439 =item C<$extra> is the extra sql parameters, can be
 440
 441  $extra->{groupby}: group baskets by column
 442     ex. $extra->{groupby} = aqbasket.basketgroupid
 443  $extra->{orderby}: order baskets by column
 444  $extra->{limit}: limit number of results (can be helpful for pagination)
 445
 446 =back
 447
 448 =cut
 449
 450 sub GetBasketsByBookseller {
 451     my ($booksellerid, $extra) = @_;
 452     my $query = "SELECT * FROM aqbasket WHERE booksellerid=?";
 453     if ($extra){
 454         if ($extra->{groupby}) {
 455             $query .= " GROUP by $extra->{groupby}";
 456         }
 457         if ($extra->{orderby}){
 458             $query .= " ORDER by $extra->{orderby}";
 459         }
 460         if ($extra->{limit}){
 461             $query .= " LIMIT $extra->{limit}";
 462         }
 463     }
 464     my $dbh = C4::Context->dbh;
 465     my $sth = $dbh->prepare($query);
 466     $sth->execute($booksellerid);
 467     my $results = $sth->fetchall_arrayref({});
 468     $sth->finish;
 469     return $results
 470 }
 471
 472 =head3 GetBasketsInfosByBookseller
 473
 474     my $baskets = GetBasketsInfosByBookseller($supplierid);
 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) = @_;
 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(IF(aqorders.datereceived IS NULL, aqorders.quantity, 0)) AS expected_items
 494         FROM aqbasket
 495           LEFT JOIN aqorders ON aqorders.basketno = aqbasket.basketno
 496         WHERE booksellerid = ?
 497         GROUP BY aqbasket.basketno
 498     };
 499     my $sth = $dbh->prepare($query);
 500     $sth->execute($supplierid);
 501     return $sth->fetchall_arrayref({});
 502 }
 503
 504
 505 #------------------------------------------------------------#
 506
 507 =head3 GetBasketsByBasketgroup
 508
 509   $baskets = &GetBasketsByBasketgroup($basketgroupid);
 510
 511 Returns a reference to all baskets that belong to basketgroup $basketgroupid.
 512
 513 =cut
 514
 515 sub GetBasketsByBasketgroup {
 516     my $basketgroupid = shift;
 517     my $query = "SELECT * FROM aqbasket
 518                 LEFT JOIN aqcontract USING(contractnumber) WHERE basketgroupid=?";
 519     my $dbh = C4::Context->dbh;
 520     my $sth = $dbh->prepare($query);
 521     $sth->execute($basketgroupid);
 522     my $results = $sth->fetchall_arrayref({});
 523     $sth->finish;
 524     return $results
 525 }
 526
 527 #------------------------------------------------------------#
 528
 529 =head3 NewBasketgroup
 530
 531   $basketgroupid = NewBasketgroup(\%hashref);
 532
 533 Adds a basketgroup to the aqbasketgroups table, and add the initial baskets to it.
 534
 535 $hashref->{'booksellerid'} is the 'id' field of the bookseller in the aqbooksellers table,
 536
 537 $hashref->{'name'} is the 'name' field of the basketgroup in the aqbasketgroups table,
 538
 539 $hashref->{'basketlist'} is a list reference of the 'id's of the baskets that belong to this group,
 540
 541 $hashref->{'deliveryplace'} is the 'deliveryplace' field of the basketgroup in the aqbasketgroups table,
 542
 543 $hashref->{'deliverycomment'} is the 'deliverycomment' field of the basketgroup in the aqbasketgroups table,
 544
 545 $hashref->{'closed'} is the 'closed' field of the aqbasketgroups table, it is false if 0, true otherwise.
 546
 547 =cut
 548
 549 sub NewBasketgroup {
 550     my $basketgroupinfo = shift;
 551     die "booksellerid is required to create a basketgroup" unless $basketgroupinfo->{'booksellerid'};
 552     my $query = "INSERT INTO aqbasketgroups (";
 553     my @params;
 554     foreach my $field ('name', 'deliveryplace', 'deliverycomment', 'closed') {
 555         if ( $basketgroupinfo->{$field} ) {
 556             $query .= "$field, ";
 557             push(@params, $basketgroupinfo->{$field});
 558         }
 559     }
 560     $query .= "booksellerid) VALUES (";
 561     foreach (@params) {
 562         $query .= "?, ";
 563     }
 564     $query .= "?)";
 565     push(@params, $basketgroupinfo->{'booksellerid'});
 566     my $dbh = C4::Context->dbh;
 567     my $sth = $dbh->prepare($query);
 568     $sth->execute(@params);
 569     my $basketgroupid = $dbh->{'mysql_insertid'};
 570     if( $basketgroupinfo->{'basketlist'} ) {
 571         foreach my $basketno (@{$basketgroupinfo->{'basketlist'}}) {
 572             my $query2 = "UPDATE aqbasket SET basketgroupid=? WHERE basketno=?";
 573             my $sth2 = $dbh->prepare($query2);
 574             $sth2->execute($basketgroupid, $basketno);
 575         }
 576     }
 577     return $basketgroupid;
 578 }
 579
 580 #------------------------------------------------------------#
 581
 582 =head3 ModBasketgroup
 583
 584   ModBasketgroup(\%hashref);
 585
 586 Modifies a basketgroup in the aqbasketgroups table, and add the baskets to it.
 587
 588 $hashref->{'id'} is the 'id' field of the basketgroup in the aqbasketgroup table, this parameter is mandatory,
 589
 590 $hashref->{'name'} is the 'name' field of the basketgroup in the aqbasketgroups table,
 591
 592 $hashref->{'basketlist'} is a list reference of the 'id's of the baskets that belong to this group,
 593
 594 $hashref->{'billingplace'} is the 'billingplace' field of the basketgroup in the aqbasketgroups table,
 595
 596 $hashref->{'deliveryplace'} is the 'deliveryplace' field of the basketgroup in the aqbasketgroups table,
 597
 598 $hashref->{'deliverycomment'} is the 'deliverycomment' field of the basketgroup in the aqbasketgroups table,
 599
 600 $hashref->{'closed'} is the 'closed' field of the aqbasketgroups table, it is false if 0, true otherwise.
 601
 602 =cut
 603
 604 sub ModBasketgroup {
 605     my $basketgroupinfo = shift;
 606     die "basketgroup id is required to edit a basketgroup" unless $basketgroupinfo->{'id'};
 607     my $dbh = C4::Context->dbh;
 608     my $query = "UPDATE aqbasketgroups SET ";
 609     my @params;
 610     foreach my $field (qw(name billingplace deliveryplace freedeliveryplace deliverycomment closed)) {
 611         if ( defined $basketgroupinfo->{$field} ) {
 612             $query .= "$field=?, ";
 613             push(@params, $basketgroupinfo->{$field});
 614         }
 615     }
 616     chop($query);
 617     chop($query);
 618     $query .= " WHERE id=?";
 619     push(@params, $basketgroupinfo->{'id'});
 620     my $sth = $dbh->prepare($query);
 621     $sth->execute(@params);
 622
 623     $sth = $dbh->prepare('UPDATE aqbasket SET basketgroupid = NULL WHERE basketgroupid = ?');
 624     $sth->execute($basketgroupinfo->{'id'});
 625
 626     if($basketgroupinfo->{'basketlist'} && @{$basketgroupinfo->{'basketlist'}}){
 627         $sth = $dbh->prepare("UPDATE aqbasket SET basketgroupid=? WHERE basketno=?");
 628         foreach my $basketno (@{$basketgroupinfo->{'basketlist'}}) {
 629             $sth->execute($basketgroupinfo->{'id'}, $basketno);
 630             $sth->finish;
 631         }
 632     }
 633     $sth->finish;
 634 }
 635
 636 #------------------------------------------------------------#
 637
 638 =head3 DelBasketgroup
 639
 640   DelBasketgroup($basketgroupid);
 641
 642 Deletes a basketgroup in the aqbasketgroups table, and removes the reference to it from the baskets,
 643
 644 =over
 645
 646 =item C<$basketgroupid> is the 'id' field of the basket in the aqbasketgroup table
 647
 648 =back
 649
 650 =cut
 651
 652 sub DelBasketgroup {
 653     my $basketgroupid = shift;
 654     die "basketgroup id is required to edit a basketgroup" unless $basketgroupid;
 655     my $query = "DELETE FROM aqbasketgroups WHERE id=?";
 656     my $dbh = C4::Context->dbh;
 657     my $sth = $dbh->prepare($query);
 658     $sth->execute($basketgroupid);
 659     $sth->finish;
 660 }
 661
 662 #------------------------------------------------------------#
 663
 664
 665 =head2 FUNCTIONS ABOUT ORDERS
 666
 667 =head3 GetBasketgroup
 668
 669   $basketgroup = &GetBasketgroup($basketgroupid);
 670
 671 Returns a reference to the hash containing all infermation about the basketgroup.
 672
 673 =cut
 674
 675 sub GetBasketgroup {
 676     my $basketgroupid = shift;
 677     die "basketgroup id is required to edit a basketgroup" unless $basketgroupid;
 678     my $query = "SELECT * FROM aqbasketgroups WHERE id=?";
 679     my $dbh = C4::Context->dbh;
 680     my $sth = $dbh->prepare($query);
 681     $sth->execute($basketgroupid);
 682     my $result = $sth->fetchrow_hashref;
 683     $sth->finish;
 684     return $result
 685 }
 686
 687 #------------------------------------------------------------#
 688
 689 =head3 GetBasketgroups
 690
 691   $basketgroups = &GetBasketgroups($booksellerid);
 692
 693 Returns a reference to the array of all the basketgroups of bookseller $booksellerid.
 694
 695 =cut
 696
 697 sub GetBasketgroups {
 698     my $booksellerid = shift;
 699     die "bookseller id is required to edit a basketgroup" unless $booksellerid;
 700     my $query = "SELECT * FROM aqbasketgroups WHERE booksellerid=? ORDER BY `id` DESC";
 701     my $dbh = C4::Context->dbh;
 702     my $sth = $dbh->prepare($query);
 703     $sth->execute($booksellerid);
 704     my $results = $sth->fetchall_arrayref({});
 705     $sth->finish;
 706     return $results
 707 }
 708
 709 #------------------------------------------------------------#
 710
 711 =head2 FUNCTIONS ABOUT ORDERS
 712
 713 =cut
 714
 715 #------------------------------------------------------------#
 716
 717 =head3 GetPendingOrders
 718
 719   $orders = &GetPendingOrders($booksellerid, $grouped, $owner);
 720
 721 Finds pending orders from the bookseller with the given ID. Ignores
 722 completed and cancelled orders.
 723
 724 C<$booksellerid> contains the bookseller identifier
 725 C<$grouped> contains 0 or 1. 0 means returns the list, 1 means return the total
 726 C<$owner> contains 0 or 1. 0 means any owner. 1 means only the list of orders entered by the user itself.
 727
 728 C<$orders> is a reference-to-array; each element is a
 729 reference-to-hash with the following fields:
 730 C<$grouped> is a boolean that, if set to 1 will group all order lines of the same basket
 731 in a single result line
 732
 733 =over
 734
 735 =item C<authorizedby>
 736
 737 =item C<entrydate>
 738
 739 =item C<basketno>
 740
 741 =back
 742
 743 These give the value of the corresponding field in the aqorders table
 744 of the Koha database.
 745
 746 Results are ordered from most to least recent.
 747
 748 =cut
 749
 750 sub GetPendingOrders {
 751     my ($supplierid,$grouped,$owner,$basketno) = @_;
 752     my $dbh = C4::Context->dbh;
 753     my $strsth = "
 754         SELECT    ".($grouped?"count(*),":"")."aqbasket.basketno,
 755                     surname,firstname,biblio.*,biblioitems.isbn,
 756                     aqbasket.closedate, aqbasket.creationdate, aqbasket.basketname,
 757                     aqorders.*
 758         FROM      aqorders
 759         LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
 760         LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
 761         LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber
 762         LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
 763         WHERE booksellerid=?
 764             AND (quantity > quantityreceived OR quantityreceived is NULL)
 765             AND datecancellationprinted IS NULL";
 766     my @query_params = ( $supplierid );
 767     my $userenv = C4::Context->userenv;
 768     if ( C4::Context->preference("IndependantBranches") ) {
 769         if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
 770             $strsth .= " and (borrowers.branchcode = ?
 771                         or borrowers.branchcode  = '')";
 772             push @query_params, $userenv->{branch};
 773         }
 774     }
 775     if ($owner) {
 776         $strsth .= " AND aqbasket.authorisedby=? ";
 777         push @query_params, $userenv->{'number'};
 778     }
 779     if ($basketno) {
 780         $strsth .= " AND aqbasket.basketno=? ";
 781         push @query_params, $basketno;
 782     }
 783     $strsth .= " group by aqbasket.basketno" if $grouped;
 784     $strsth .= " order by aqbasket.basketno";
 785
 786     my $sth = $dbh->prepare($strsth);
 787     $sth->execute( @query_params );
 788     my $results = $sth->fetchall_arrayref({});
 789     $sth->finish;
 790     return $results;
 791 }
 792
 793 #------------------------------------------------------------#
 794
 795 =head3 GetOrders
 796
 797   @orders = &GetOrders($basketnumber, $orderby);
 798
 799 Looks up the pending (non-cancelled) orders with the given basket
 800 number. If C<$booksellerID> is non-empty, only orders from that seller
 801 are returned.
 802
 803 return :
 804 C<&basket> returns a two-element array. C<@orders> is an array of
 805 references-to-hash, whose keys are the fields from the aqorders,
 806 biblio, and biblioitems tables in the Koha database.
 807
 808 =cut
 809
 810 sub GetOrders {
 811     my ( $basketno, $orderby ) = @_;
 812     my $dbh   = C4::Context->dbh;
 813     my $query  ="
 814         SELECT biblio.*,biblioitems.*,
 815                 aqorders.*,
 816                 aqbudgets.*,
 817                 biblio.title
 818         FROM    aqorders
 819             LEFT JOIN aqbudgets        ON aqbudgets.budget_id = aqorders.budget_id
 820             LEFT JOIN biblio           ON biblio.biblionumber = aqorders.biblionumber
 821             LEFT JOIN biblioitems      ON biblioitems.biblionumber =biblio.biblionumber
 822         WHERE   basketno=?
 823             AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00')
 824     ";
 825
 826     $orderby = "biblioitems.publishercode,biblio.title" unless $orderby;
 827     $query .= " ORDER BY $orderby";
 828     my $sth = $dbh->prepare($query);
 829     $sth->execute($basketno);
 830     my $results = $sth->fetchall_arrayref({});
 831     $sth->finish;
 832     return @$results;
 833 }
 834
 835 #------------------------------------------------------------#
 836
 837 =head3 GetOrderNumber
 838
 839   $ordernumber = &GetOrderNumber($biblioitemnumber, $biblionumber);
 840
 841 Looks up the ordernumber with the given biblionumber and biblioitemnumber.
 842
 843 Returns the number of this order.
 844
 845 =over
 846
 847 =item C<$ordernumber> is the order number.
 848
 849 =back
 850
 851 =cut
 852
 853 sub GetOrderNumber {
 854     my ( $biblionumber,$biblioitemnumber ) = @_;
 855     my $dbh = C4::Context->dbh;
 856     my $query = "
 857         SELECT ordernumber
 858         FROM   aqorders
 859         WHERE  biblionumber=?
 860         AND    biblioitemnumber=?
 861     ";
 862     my $sth = $dbh->prepare($query);
 863     $sth->execute( $biblionumber, $biblioitemnumber );
 864
 865     return $sth->fetchrow;
 866 }
 867
 868 #------------------------------------------------------------#
 869
 870 =head3 GetOrder
 871
 872   $order = &GetOrder($ordernumber);
 873
 874 Looks up an order by order number.
 875
 876 Returns a reference-to-hash describing the order. The keys of
 877 C<$order> are fields from the biblio, biblioitems, aqorders tables of the Koha database.
 878
 879 =cut
 880
 881 sub GetOrder {
 882     my ($ordernumber) = @_;
 883     my $dbh      = C4::Context->dbh;
 884     my $query = "
 885         SELECT biblioitems.*, biblio.*, aqorders.*
 886         FROM   aqorders
 887         LEFT JOIN biblio on           biblio.biblionumber=aqorders.biblionumber
 888         LEFT JOIN biblioitems on       biblioitems.biblionumber=aqorders.biblionumber
 889         WHERE aqorders.ordernumber=?
 890
 891     ";
 892     my $sth= $dbh->prepare($query);
 893     $sth->execute($ordernumber);
 894     my $data = $sth->fetchrow_hashref;
 895     $sth->finish;
 896     return $data;
 897 }
 898
 899 #------------------------------------------------------------#
 900
 901 =head3 NewOrder
 902
 903   &NewOrder(\%hashref);
 904
 905 Adds a new order to the database. Any argument that isn't described
 906 below is the new value of the field with the same name in the aqorders
 907 table of the Koha database.
 908
 909 =over
 910
 911 =item $hashref->{'basketno'} is the basketno foreign key in aqorders, it is mandatory
 912
 913 =item $hashref->{'ordernumber'} is a "minimum order number."
 914
 915 =item $hashref->{'budgetdate'} is effectively ignored.
 916 If it's undef (anything false) or the string 'now', the current day is used.
 917 Else, the upcoming July 1st is used.
 918
 919 =item $hashref->{'subscription'} may be either "yes", or anything else for "no".
 920
 921 =item $hashref->{'uncertainprice'} may be 0 for "the price is known" or 1 for "the price is uncertain"
 922
 923 =item defaults entrydate to Now
 924
 925 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".
 926
 927 =back
 928
 929 =cut
 930
 931 sub NewOrder {
 932     my $orderinfo = shift;
 933 #### ------------------------------
 934     my $dbh = C4::Context->dbh;
 935     my @params;
 936
 937
 938     # if these parameters are missing, we can't continue
 939     for my $key (qw/basketno quantity biblionumber budget_id/) {
 940         croak "Mandatory parameter $key missing" unless $orderinfo->{$key};
 941     }
 942
 943     if ( defined $orderinfo->{subscription} && $orderinfo->{'subscription'} eq 'yes' ) {
 944         $orderinfo->{'subscription'} = 1;
 945     } else {
 946         $orderinfo->{'subscription'} = 0;
 947     }
 948     $orderinfo->{'entrydate'} ||= C4::Dates->new()->output("iso");
 949     if (!$orderinfo->{quantityreceived}) {
 950         $orderinfo->{quantityreceived} = 0;
 951     }
 952
 953     my $ordernumber=InsertInTable("aqorders",$orderinfo);
 954     return ( $orderinfo->{'basketno'}, $ordernumber );
 955 }
 956
 957
 958
 959 #------------------------------------------------------------#
 960
 961 =head3 NewOrderItem
 962
 963   &NewOrderItem();
 964
 965 =cut
 966
 967 sub NewOrderItem {
 968     my ($itemnumber, $ordernumber)  = @_;
 969     my $dbh = C4::Context->dbh;
 970     my $query = qq|
 971             INSERT INTO aqorders_items
 972                 (itemnumber, ordernumber)
 973             VALUES (?,?)    |;
 974
 975     my $sth = $dbh->prepare($query);
 976     $sth->execute( $itemnumber, $ordernumber);
 977 }
 978
 979 #------------------------------------------------------------#
 980
 981 =head3 ModOrder
 982
 983   &ModOrder(\%hashref);
 984
 985 Modifies an existing order. Updates the order with order number
 986 $hashref->{'ordernumber'} and biblionumber $hashref->{'biblionumber'}. All
 987 other keys of the hash update the fields with the same name in the aqorders
 988 table of the Koha database.
 989
 990 =cut
 991
 992 sub ModOrder {
 993     my $orderinfo = shift;
 994
 995     die "Ordernumber is required"     if $orderinfo->{'ordernumber'} eq  '' ;
 996     die "Biblionumber is required"  if  $orderinfo->{'biblionumber'} eq '';
 997
 998     my $dbh = C4::Context->dbh;
 999     my @params;
1000
1001     # update uncertainprice to an integer, just in case (under FF, checked boxes have the value "ON" by default)
1002     $orderinfo->{uncertainprice}=1 if $orderinfo->{uncertainprice};
1003
1004 #    delete($orderinfo->{'branchcode'});
1005     # the hash contains a lot of entries not in aqorders, so get the columns ...
1006     my $sth = $dbh->prepare("SELECT * FROM aqorders LIMIT 1;");
1007     $sth->execute;
1008     my $colnames = $sth->{NAME};
1009     my $query = "UPDATE aqorders SET ";
1010
1011     foreach my $orderinfokey (grep(!/ordernumber/, keys %$orderinfo)){
1012         # ... and skip hash entries that are not in the aqorders table
1013         # FIXME : probably not the best way to do it (would be better to have a correct hash)
1014         next unless grep(/^$orderinfokey$/, @$colnames);
1015             $query .= "$orderinfokey=?, ";
1016             push(@params, $orderinfo->{$orderinfokey});
1017     }
1018
1019     $query .= "timestamp=NOW()  WHERE  ordernumber=?";
1020 #   push(@params, $specorderinfo{'ordernumber'});
1021     push(@params, $orderinfo->{'ordernumber'} );
1022     $sth = $dbh->prepare($query);
1023     $sth->execute(@params);
1024     $sth->finish;
1025 }
1026
1027 #------------------------------------------------------------#
1028
1029 =head3 ModOrderItem
1030
1031   &ModOrderItem(\%hashref);
1032
1033 Modifies the itemnumber in the aqorders_items table. The input hash needs three entities:
1034
1035 =over
1036
1037 =item - itemnumber: the old itemnumber
1038 =item - ordernumber: the order this item is attached to
1039 =item - newitemnumber: the new itemnumber we want to attach the line to
1040
1041 =back
1042
1043 =cut
1044
1045 sub ModOrderItem {
1046     my $orderiteminfo = shift;
1047     if (! $orderiteminfo->{'ordernumber'} || ! $orderiteminfo->{'itemnumber'} || ! $orderiteminfo->{'newitemnumber'}){
1048         die "Ordernumber, itemnumber and newitemnumber is required";
1049     }
1050
1051     my $dbh = C4::Context->dbh;
1052
1053     my $query = "UPDATE aqorders_items set itemnumber=? where itemnumber=? and ordernumber=?";
1054     my @params = ($orderiteminfo->{'newitemnumber'}, $orderiteminfo->{'itemnumber'}, $orderiteminfo->{'ordernumber'});
1055     my $sth = $dbh->prepare($query);
1056     $sth->execute(@params);
1057     return 0;
1058 }
1059
1060 =head3 ModItemOrder
1061
1062     ModItemOrder($itemnumber, $ordernumber);
1063
1064 Modifies the ordernumber of an item in aqorders_items.
1065
1066 =cut
1067
1068 sub ModItemOrder {
1069     my ($itemnumber, $ordernumber) = @_;
1070
1071     return unless ($itemnumber and $ordernumber);
1072
1073     my $dbh = C4::Context->dbh;
1074     my $query = qq{
1075         UPDATE aqorders_items
1076         SET ordernumber = ?
1077         WHERE itemnumber = ?
1078     };
1079     my $sth = $dbh->prepare($query);
1080     return $sth->execute($ordernumber, $itemnumber);
1081 }
1082
1083 #------------------------------------------------------------#
1084
1085
1086 =head3 ModOrderBibliotemNumber
1087
1088   &ModOrderBiblioitemNumber($biblioitemnumber,$ordernumber, $biblionumber);
1089
1090 Modifies the biblioitemnumber for an existing order.
1091 Updates the order with order number C<$ordernum> and biblionumber C<$biblionumber>.
1092
1093 =cut
1094
1095 #FIXME: is this used at all?
1096 sub ModOrderBiblioitemNumber {
1097     my ($biblioitemnumber,$ordernumber, $biblionumber) = @_;
1098     my $dbh = C4::Context->dbh;
1099     my $query = "
1100     UPDATE aqorders
1101     SET    biblioitemnumber = ?
1102     WHERE  ordernumber = ?
1103     AND biblionumber =  ?";
1104     my $sth = $dbh->prepare($query);
1105     $sth->execute( $biblioitemnumber, $ordernumber, $biblionumber );
1106 }
1107
1108 =head3 GetCancelledOrders
1109
1110   my @orders = GetCancelledOrders($basketno, $orderby);
1111
1112 Returns cancelled orders for a basket
1113
1114 =cut
1115
1116 sub GetCancelledOrders {
1117     my ( $basketno, $orderby ) = @_;
1118
1119     return () unless $basketno;
1120
1121     my $dbh   = C4::Context->dbh;
1122     my $query = "
1123         SELECT biblio.*, biblioitems.*, aqorders.*, aqbudgets.*
1124         FROM aqorders
1125           LEFT JOIN aqbudgets   ON aqbudgets.budget_id = aqorders.budget_id
1126           LEFT JOIN biblio      ON biblio.biblionumber = aqorders.biblionumber
1127           LEFT JOIN biblioitems ON biblioitems.biblionumber = biblio.biblionumber
1128         WHERE basketno = ?
1129           AND (datecancellationprinted IS NOT NULL
1130                AND datecancellationprinted <> '0000-00-00')
1131     ";
1132
1133     $orderby = "aqorders.datecancellationprinted desc, aqorders.timestamp desc"
1134         unless $orderby;
1135     $query .= " ORDER BY $orderby";
1136     my $sth = $dbh->prepare($query);
1137     $sth->execute($basketno);
1138     my $results = $sth->fetchall_arrayref( {} );
1139
1140     return @$results;
1141 }
1142
1143
1144 #------------------------------------------------------------#
1145
1146 =head3 ModReceiveOrder
1147
1148   &ModReceiveOrder($biblionumber, $ordernumber, $quantityreceived, $user,
1149     $unitprice, $booksellerinvoicenumber, $biblioitemnumber,
1150     $freight, $bookfund, $rrp);
1151
1152 Updates an order, to reflect the fact that it was received, at least
1153 in part. All arguments not mentioned below update the fields with the
1154 same name in the aqorders table of the Koha database.
1155
1156 If a partial order is received, splits the order into two.  The received
1157 portion must have a booksellerinvoicenumber.
1158
1159 Updates the order with bibilionumber C<$biblionumber> and ordernumber
1160 C<$ordernumber>.
1161
1162 =cut
1163
1164
1165 sub ModReceiveOrder {
1166     my (
1167         $biblionumber,    $ordernumber,  $quantrec, $user, $cost,
1168         $invoiceno, $freight, $rrp, $budget_id, $datereceived, $received_items
1169     )
1170     = @_;
1171     my $dbh = C4::Context->dbh;
1172     $datereceived = C4::Dates->output('iso') unless $datereceived;
1173     my $suggestionid = GetSuggestionFromBiblionumber( $biblionumber );
1174     if ($suggestionid) {
1175         ModSuggestion( {suggestionid=>$suggestionid,
1176                         STATUS=>'AVAILABLE',
1177                         biblionumber=> $biblionumber}
1178                         );
1179     }
1180
1181     my $sth=$dbh->prepare("
1182         SELECT * FROM   aqorders
1183         WHERE           biblionumber=? AND aqorders.ordernumber=?");
1184
1185     $sth->execute($biblionumber,$ordernumber);
1186     my $order = $sth->fetchrow_hashref();
1187     $sth->finish();
1188
1189     if ( $order->{quantity} > $quantrec ) {
1190         $sth=$dbh->prepare("
1191             UPDATE aqorders
1192             SET quantityreceived=?
1193                 , datereceived=?
1194                 , booksellerinvoicenumber=?
1195                 , unitprice=?
1196                 , freight=?
1197                 , rrp=?
1198                 , quantity=?
1199             WHERE biblionumber=? AND ordernumber=?");
1200
1201         $sth->execute($quantrec,$datereceived,$invoiceno,$cost,$freight,$rrp,$quantrec,$biblionumber,$ordernumber);
1202         $sth->finish;
1203
1204         # create a new order for the remaining items, and set its bookfund.
1205         foreach my $orderkey ( "linenumber", "allocation" ) {
1206             delete($order->{'$orderkey'});
1207         }
1208         $order->{'quantity'} -= $quantrec;
1209         $order->{'quantityreceived'} = 0;
1210         my $newOrder = NewOrder($order);
1211         # Change ordernumber in aqorders_items for items not received
1212         my @orderitems = GetItemnumbersFromOrder( $order->{'ordernumber'} );
1213         my $count = scalar @orderitems;
1214
1215         for (my $i=0; $i<$count; $i++){
1216             foreach (@$received_items){
1217                 splice (@orderitems, $i, 1) if ($orderitems[$i] == $_);
1218             }
1219         }
1220         foreach (@orderitems) {
1221             ModItemOrder($_, $newOrder);
1222         }
1223     } else {
1224         $sth=$dbh->prepare("update aqorders
1225                             set quantityreceived=?,datereceived=?,booksellerinvoicenumber=?,
1226                                 unitprice=?,freight=?,rrp=?
1227                             where biblionumber=? and ordernumber=?");
1228         $sth->execute($quantrec,$datereceived,$invoiceno,$cost,$freight,$rrp,$biblionumber,$ordernumber);
1229         $sth->finish;
1230     }
1231     return $datereceived;
1232 }
1233 #------------------------------------------------------------#
1234
1235 =head3 SearchOrder
1236
1237 @results = &SearchOrder($search, $biblionumber, $complete);
1238
1239 Searches for orders.
1240
1241 C<$search> may take one of several forms: if it is an ISBN,
1242 C<&ordersearch> returns orders with that ISBN. If C<$search> is an
1243 order number, C<&ordersearch> returns orders with that order number
1244 and biblionumber C<$biblionumber>. Otherwise, C<$search> is considered
1245 to be a space-separated list of search terms; in this case, all of the
1246 terms must appear in the title (matching the beginning of title
1247 words).
1248
1249 If C<$complete> is C<yes>, the results will include only completed
1250 orders. In any case, C<&ordersearch> ignores cancelled orders.
1251
1252 C<&ordersearch> returns an array.
1253 C<@results> is an array of references-to-hash with the following keys:
1254
1255 =over 4
1256
1257 =item C<author>
1258
1259 =item C<seriestitle>
1260
1261 =item C<branchcode>
1262
1263 =item C<bookfundid>
1264
1265 =back
1266
1267 =cut
1268
1269 sub SearchOrder {
1270 #### -------- SearchOrder-------------------------------
1271     my ( $ordernumber, $search, $ean, $supplierid, $basket ) = @_;
1272
1273     my $dbh = C4::Context->dbh;
1274     my @args = ();
1275     my $query =
1276             "SELECT *
1277             FROM aqorders
1278             LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1279             LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
1280             LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
1281                 WHERE  (datecancellationprinted is NULL)";
1282
1283     if($ordernumber){
1284         $query .= " AND (aqorders.ordernumber=?)";
1285         push @args, $ordernumber;
1286     }
1287     if($search){
1288         $query .= " AND (biblio.title like ? OR biblio.author LIKE ? OR biblioitems.isbn like ?)";
1289         push @args, ("%$search%","%$search%","%$search%");
1290     }
1291     if ($ean) {
1292         $query .= " AND biblioitems.ean = ?";
1293         push @args, $ean;
1294     }
1295     if ($supplierid) {
1296         $query .= "AND aqbasket.booksellerid = ?";
1297         push @args, $supplierid;
1298     }
1299     if($basket){
1300         $query .= "AND aqorders.basketno = ?";
1301         push @args, $basket;
1302     }
1303
1304     my $sth = $dbh->prepare($query);
1305     $sth->execute(@args);
1306     my $results = $sth->fetchall_arrayref({});
1307     $sth->finish;
1308     return $results;
1309 }
1310
1311 #------------------------------------------------------------#
1312
1313 =head3 DelOrder
1314
1315   &DelOrder($biblionumber, $ordernumber);
1316
1317 Cancel the order with the given order and biblio numbers. It does not
1318 delete any entries in the aqorders table, it merely marks them as
1319 cancelled.
1320
1321 =cut
1322
1323 sub DelOrder {
1324     my ( $bibnum, $ordernumber ) = @_;
1325     my $dbh = C4::Context->dbh;
1326     my $query = "
1327         UPDATE aqorders
1328         SET    datecancellationprinted=now()
1329         WHERE  biblionumber=? AND ordernumber=?
1330     ";
1331     my $sth = $dbh->prepare($query);
1332     $sth->execute( $bibnum, $ordernumber );
1333     $sth->finish;
1334     my @itemnumbers = GetItemnumbersFromOrder( $ordernumber );
1335     foreach my $itemnumber (@itemnumbers){
1336         C4::Items::DelItem( $dbh, $bibnum, $itemnumber );
1337     }
1338
1339 }
1340
1341 =head2 FUNCTIONS ABOUT PARCELS
1342
1343 =cut
1344
1345 #------------------------------------------------------------#
1346
1347 =head3 GetParcel
1348
1349   @results = &GetParcel($booksellerid, $code, $date);
1350
1351 Looks up all of the received items from the supplier with the given
1352 bookseller ID at the given date, for the given code (bookseller Invoice number). Ignores cancelled and completed orders.
1353
1354 C<@results> is an array of references-to-hash. The keys of each element are fields from
1355 the aqorders, biblio, and biblioitems tables of the Koha database.
1356
1357 C<@results> is sorted alphabetically by book title.
1358
1359 =cut
1360
1361 sub GetParcel {
1362     #gets all orders from a certain supplier, orders them alphabetically
1363     my ( $supplierid, $code, $datereceived ) = @_;
1364     my $dbh     = C4::Context->dbh;
1365     my @results = ();
1366     $code .= '%'
1367     if $code;  # add % if we search on a given code (otherwise, let him empty)
1368     my $strsth ="
1369         SELECT  authorisedby,
1370                 creationdate,
1371                 aqbasket.basketno,
1372                 closedate,surname,
1373                 firstname,
1374                 aqorders.biblionumber,
1375                 aqorders.ordernumber,
1376                 aqorders.quantity,
1377                 aqorders.quantityreceived,
1378                 aqorders.unitprice,
1379                 aqorders.listprice,
1380                 aqorders.rrp,
1381                 aqorders.ecost,
1382                 biblio.title
1383         FROM aqorders
1384         LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
1385         LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
1386         LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1387         WHERE
1388             aqbasket.booksellerid = ?
1389             AND aqorders.booksellerinvoicenumber LIKE ?
1390             AND aqorders.datereceived = ? ";
1391
1392     my @query_params = ( $supplierid, $code, $datereceived );
1393     if ( C4::Context->preference("IndependantBranches") ) {
1394         my $userenv = C4::Context->userenv;
1395         if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
1396             $strsth .= " and (borrowers.branchcode = ?
1397                         or borrowers.branchcode  = '')";
1398             push @query_params, $userenv->{branch};
1399         }
1400     }
1401     $strsth .= " ORDER BY aqbasket.basketno";
1402     # ## parcelinformation : $strsth
1403     my $sth = $dbh->prepare($strsth);
1404     $sth->execute( @query_params );
1405     while ( my $data = $sth->fetchrow_hashref ) {
1406         push( @results, $data );
1407     }
1408     # ## countparcelbiblio: scalar(@results)
1409     $sth->finish;
1410
1411     return @results;
1412 }
1413
1414 #------------------------------------------------------------#
1415
1416 =head3 GetParcels
1417
1418   $results = &GetParcels($bookseller, $order, $code, $datefrom, $dateto);
1419
1420 get a lists of parcels.
1421
1422 * Input arg :
1423
1424 =over
1425
1426 =item $bookseller
1427 is the bookseller this function has to get parcels.
1428
1429 =item $order
1430 To know on what criteria the results list has to be ordered.
1431
1432 =item $code
1433 is the booksellerinvoicenumber.
1434
1435 =item $datefrom & $dateto
1436 to know on what date this function has to filter its search.
1437
1438 =back
1439
1440 * return:
1441 a pointer on a hash list containing parcel informations as such :
1442
1443 =over
1444
1445 =item Creation date
1446
1447 =item Last operation
1448
1449 =item Number of biblio
1450
1451 =item Number of items
1452
1453 =back
1454
1455 =cut
1456
1457 sub GetParcels {
1458     my ($bookseller,$order, $code, $datefrom, $dateto) = @_;
1459     my $dbh    = C4::Context->dbh;
1460     my @query_params = ();
1461     my $strsth ="
1462         SELECT  aqorders.booksellerinvoicenumber,
1463                 datereceived,purchaseordernumber,
1464                 count(DISTINCT biblionumber) AS biblio,
1465                 sum(quantity) AS itemsexpected,
1466                 sum(quantityreceived) AS itemsreceived
1467         FROM   aqorders LEFT JOIN aqbasket ON aqbasket.basketno = aqorders.basketno
1468         WHERE aqbasket.booksellerid = ? and datereceived IS NOT NULL
1469     ";
1470     push @query_params, $bookseller;
1471
1472     if ( defined $code ) {
1473         $strsth .= ' and aqorders.booksellerinvoicenumber like ? ';
1474         # add a % to the end of the code to allow stemming.
1475         push @query_params, "$code%";
1476     }
1477
1478     if ( defined $datefrom ) {
1479         $strsth .= ' and datereceived >= ? ';
1480         push @query_params, $datefrom;
1481     }
1482
1483     if ( defined $dateto ) {
1484         $strsth .=  'and datereceived <= ? ';
1485         push @query_params, $dateto;
1486     }
1487
1488     $strsth .= "group by aqorders.booksellerinvoicenumber,datereceived ";
1489
1490     # can't use a placeholder to place this column name.
1491     # but, we could probably be checking to make sure it is a column that will be fetched.
1492     $strsth .= "order by $order " if ($order);
1493
1494     my $sth = $dbh->prepare($strsth);
1495
1496     $sth->execute( @query_params );
1497     my $results = $sth->fetchall_arrayref({});
1498     $sth->finish;
1499     return @$results;
1500 }
1501
1502 #------------------------------------------------------------#
1503
1504 =head3 GetLateOrders
1505
1506   @results = &GetLateOrders;
1507
1508 Searches for bookseller with late orders.
1509
1510 return:
1511 the table of supplier with late issues. This table is full of hashref.
1512
1513 =cut
1514
1515 sub GetLateOrders {
1516     my $delay      = shift;
1517     my $supplierid = shift;
1518     my $branch     = shift;
1519     my $estimateddeliverydatefrom = shift;
1520     my $estimateddeliverydateto = shift;
1521
1522     my $dbh = C4::Context->dbh;
1523
1524     #BEWARE, order of parenthesis and LEFT JOIN is important for speed
1525     my $dbdriver = C4::Context->config("db_scheme") || "mysql";
1526
1527     my @query_params = ();
1528     my $select = "
1529     SELECT aqbasket.basketno,
1530         aqorders.ordernumber,
1531         DATE(aqbasket.closedate)  AS orderdate,
1532         aqorders.rrp              AS unitpricesupplier,
1533         aqorders.ecost            AS unitpricelib,
1534         aqorders.claims_count     AS claims_count,
1535         aqorders.claimed_date     AS claimed_date,
1536         aqbudgets.budget_name     AS budget,
1537         borrowers.branchcode      AS branch,
1538         aqbooksellers.name        AS supplier,
1539         aqbooksellers.id          AS supplierid,
1540         biblio.author, biblio.title,
1541         biblioitems.publishercode AS publisher,
1542         biblioitems.publicationyear,
1543         ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) AS estimateddeliverydate,
1544     ";
1545     my $from = "
1546     FROM
1547         aqorders LEFT JOIN biblio     ON biblio.biblionumber         = aqorders.biblionumber
1548         LEFT JOIN biblioitems         ON biblioitems.biblionumber    = biblio.biblionumber
1549         LEFT JOIN aqbudgets           ON aqorders.budget_id          = aqbudgets.budget_id,
1550         aqbasket LEFT JOIN borrowers  ON aqbasket.authorisedby       = borrowers.borrowernumber
1551         LEFT JOIN aqbooksellers       ON aqbasket.booksellerid       = aqbooksellers.id
1552         WHERE aqorders.basketno = aqbasket.basketno
1553         AND ( datereceived = ''
1554             OR datereceived IS NULL
1555             OR aqorders.quantityreceived < aqorders.quantity
1556         )
1557         AND aqbasket.closedate IS NOT NULL
1558         AND (aqorders.datecancellationprinted IS NULL OR aqorders.datecancellationprinted='0000-00-00')
1559     ";
1560     my $having = "";
1561     if ($dbdriver eq "mysql") {
1562         $select .= "
1563         aqorders.quantity - IFNULL(aqorders.quantityreceived,0)                 AS quantity,
1564         (aqorders.quantity - IFNULL(aqorders.quantityreceived,0)) * aqorders.rrp AS subtotal,
1565         DATEDIFF(CAST(now() AS date),closedate) AS latesince
1566         ";
1567         if ( defined $delay ) {
1568             $from .= " AND (closedate <= DATE_SUB(CAST(now() AS date),INTERVAL ? DAY)) " ;
1569             push @query_params, $delay;
1570         }
1571         $having = "
1572         HAVING quantity          <> 0
1573             AND unitpricesupplier <> 0
1574             AND unitpricelib      <> 0
1575         ";
1576     } else {
1577         # FIXME: account for IFNULL as above
1578         $select .= "
1579                 aqorders.quantity                AS quantity,
1580                 aqorders.quantity * aqorders.rrp AS subtotal,
1581                 (CAST(now() AS date) - closedate)            AS latesince
1582         ";
1583         if ( defined $delay ) {
1584             $from .= " AND (closedate <= (CAST(now() AS date) -(INTERVAL ? DAY)) ";
1585             push @query_params, $delay;
1586         }
1587     }
1588     if (defined $supplierid) {
1589         $from .= ' AND aqbasket.booksellerid = ? ';
1590         push @query_params, $supplierid;
1591     }
1592     if (defined $branch) {
1593         $from .= ' AND borrowers.branchcode LIKE ? ';
1594         push @query_params, $branch;
1595     }
1596     if ( defined $estimateddeliverydatefrom ) {
1597         $from .= '
1598             AND aqbooksellers.deliverytime IS NOT NULL
1599             AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) >= ?';
1600         push @query_params, $estimateddeliverydatefrom;
1601     }
1602     if ( defined $estimateddeliverydatefrom and defined $estimateddeliverydateto ) {
1603         $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) <= ?';
1604         push @query_params, $estimateddeliverydateto;
1605     } elsif ( defined $estimateddeliverydatefrom ) {
1606         $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) <= CAST(now() AS date)';
1607     }
1608     if (C4::Context->preference("IndependantBranches")
1609             && C4::Context->userenv
1610             && C4::Context->userenv->{flags} != 1 ) {
1611         $from .= ' AND borrowers.branchcode LIKE ? ';
1612         push @query_params, C4::Context->userenv->{branch};
1613     }
1614     my $query = "$select $from $having\nORDER BY latesince, basketno, borrowers.branchcode, supplier";
1615     $debug and print STDERR "GetLateOrders query: $query\nGetLateOrders args: " . join(" ",@query_params);
1616     my $sth = $dbh->prepare($query);
1617     $sth->execute(@query_params);
1618     my @results;
1619     while (my $data = $sth->fetchrow_hashref) {
1620         $data->{orderdate} = format_date($data->{orderdate});
1621         $data->{claimed_date} = format_date($data->{claimed_date});
1622         push @results, $data;
1623     }
1624     return @results;
1625 }
1626
1627 #------------------------------------------------------------#
1628
1629 =head3 GetHistory
1630
1631   (\@order_loop, $total_qty, $total_price, $total_qtyreceived) = GetHistory( %params );
1632
1633 Retreives some acquisition history information
1634
1635 params:
1636   title
1637   author
1638   name
1639   from_placed_on
1640   to_placed_on
1641   basket                  - search both basket name and number
1642   booksellerinvoicenumber
1643
1644 returns:
1645     $order_loop is a list of hashrefs that each look like this:
1646             {
1647                 'author'           => 'Twain, Mark',
1648                 'basketno'         => '1',
1649                 'biblionumber'     => '215',
1650                 'count'            => 1,
1651                 'creationdate'     => 'MM/DD/YYYY',
1652                 'datereceived'     => undef,
1653                 'ecost'            => '1.00',
1654                 'id'               => '1',
1655                 'invoicenumber'    => undef,
1656                 'name'             => '',
1657                 'ordernumber'      => '1',
1658                 'quantity'         => 1,
1659                 'quantityreceived' => undef,
1660                 'title'            => 'The Adventures of Huckleberry Finn'
1661             }
1662     $total_qty is the sum of all of the quantities in $order_loop
1663     $total_price is the cost of each in $order_loop times the quantity
1664     $total_qtyreceived is the sum of all of the quantityreceived entries in $order_loop
1665
1666 =cut
1667
1668 sub GetHistory {
1669 # don't run the query if there are no parameters (list would be too long for sure !)
1670     croak "No search params" unless @_;
1671     my %params = @_;
1672     my $title = $params{title};
1673     my $author = $params{author};
1674     my $isbn   = $params{isbn};
1675     my $ean    = $params{ean};
1676     my $name = $params{name};
1677     my $from_placed_on = $params{from_placed_on};
1678     my $to_placed_on = $params{to_placed_on};
1679     my $basket = $params{basket};
1680     my $booksellerinvoicenumber = $params{booksellerinvoicenumber};
1681     my @order_loop;
1682     my $total_qty         = 0;
1683     my $total_qtyreceived = 0;
1684     my $total_price       = 0;
1685
1686     my $dbh   = C4::Context->dbh;
1687     my $query ="
1688         SELECT
1689             biblio.title,
1690             biblio.author,
1691             biblioitems.isbn,
1692         biblioitems.ean,
1693             aqorders.basketno,
1694             aqbasket.basketname,
1695             aqbasket.basketgroupid,
1696             aqbasketgroups.name as groupname,
1697             aqbooksellers.name,
1698             aqbasket.creationdate,
1699             aqorders.datereceived,
1700             aqorders.quantity,
1701             aqorders.quantityreceived,
1702             aqorders.ecost,
1703             aqorders.ordernumber,
1704             aqorders.booksellerinvoicenumber as invoicenumber,
1705             aqbooksellers.id as id,
1706             aqorders.biblionumber
1707         FROM aqorders
1708         LEFT JOIN aqbasket ON aqorders.basketno=aqbasket.basketno
1709         LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid=aqbasketgroups.id
1710         LEFT JOIN aqbooksellers ON aqbasket.booksellerid=aqbooksellers.id
1711         LEFT JOIN biblioitems ON biblioitems.biblionumber=aqorders.biblionumber
1712         LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber";
1713
1714     $query .= " LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber"
1715     if ( C4::Context->preference("IndependantBranches") );
1716
1717     $query .= " WHERE (datecancellationprinted is NULL or datecancellationprinted='0000-00-00') ";
1718
1719     my @query_params  = ();
1720
1721     if ( $title ) {
1722         $query .= " AND biblio.title LIKE ? ";
1723         $title =~ s/\s+/%/g;
1724         push @query_params, "%$title%";
1725     }
1726
1727     if ( $author ) {
1728         $query .= " AND biblio.author LIKE ? ";
1729         push @query_params, "%$author%";
1730     }
1731
1732     if ( $isbn ) {
1733         $query .= " AND biblioitems.isbn LIKE ? ";
1734         push @query_params, "%$isbn%";
1735     }
1736     if ( defined $ean and $ean ) {
1737         $query .= " AND biblioitems.ean = ? ";
1738         push @query_params, "$ean";
1739     }
1740     if ( $name ) {
1741         $query .= " AND aqbooksellers.name LIKE ? ";
1742         push @query_params, "%$name%";
1743     }
1744
1745     if ( $from_placed_on ) {
1746         $query .= " AND creationdate >= ? ";
1747         push @query_params, $from_placed_on;
1748     }
1749
1750     if ( $to_placed_on ) {
1751         $query .= " AND creationdate <= ? ";
1752         push @query_params, $to_placed_on;
1753     }
1754
1755     if ($basket) {
1756         if ($basket =~ m/^\d+$/) {
1757             $query .= " AND aqorders.basketno = ? ";
1758             push @query_params, $basket;
1759         } else {
1760             $query .= " AND aqbasket.basketname LIKE ? ";
1761             push @query_params, "%$basket%";
1762         }
1763     }
1764
1765     if ($booksellerinvoicenumber) {
1766         $query .= " AND (aqorders.booksellerinvoicenumber LIKE ? OR aqbasket.booksellerinvoicenumber LIKE ?)";
1767         push @query_params, "%$booksellerinvoicenumber%", "%$booksellerinvoicenumber%";
1768     }
1769
1770     if ( C4::Context->preference("IndependantBranches") ) {
1771         my $userenv = C4::Context->userenv;
1772         if ( $userenv && ($userenv->{flags} || 0) != 1 ) {
1773             $query .= " AND (borrowers.branchcode = ? OR borrowers.branchcode ='' ) ";
1774             push @query_params, $userenv->{branch};
1775         }
1776     }
1777     $query .= " ORDER BY id";
1778     my $sth = $dbh->prepare($query);
1779     $sth->execute( @query_params );
1780     my $cnt = 1;
1781     while ( my $line = $sth->fetchrow_hashref ) {
1782         $line->{count} = $cnt++;
1783         $line->{toggle} = 1 if $cnt % 2;
1784         push @order_loop, $line;
1785         $total_qty         += $line->{'quantity'};
1786         $total_qtyreceived += $line->{'quantityreceived'};
1787         $total_price       += $line->{'quantity'} * $line->{'ecost'};
1788     }
1789     return \@order_loop, $total_qty, $total_price, $total_qtyreceived;
1790 }
1791
1792 =head2 GetRecentAcqui
1793
1794   $results = GetRecentAcqui($days);
1795
1796 C<$results> is a ref to a table which containts hashref
1797
1798 =cut
1799
1800 sub GetRecentAcqui {
1801     my $limit  = shift;
1802     my $dbh    = C4::Context->dbh;
1803     my $query = "
1804         SELECT *
1805         FROM   biblio
1806         ORDER BY timestamp DESC
1807         LIMIT  0,".$limit;
1808
1809     my $sth = $dbh->prepare($query);
1810     $sth->execute;
1811     my $results = $sth->fetchall_arrayref({});
1812     return $results;
1813 }
1814
1815 =head3 GetContracts
1816
1817   $contractlist = &GetContracts($booksellerid, $activeonly);
1818
1819 Looks up the contracts that belong to a bookseller
1820
1821 Returns a list of contracts
1822
1823 =over
1824
1825 =item C<$booksellerid> is the "id" field in the "aqbooksellers" table.
1826
1827 =item C<$activeonly> if exists get only contracts that are still active.
1828
1829 =back
1830
1831 =cut
1832
1833 sub GetContracts {
1834     my ( $booksellerid, $activeonly ) = @_;
1835     my $dbh = C4::Context->dbh;
1836     my $query;
1837     if (! $activeonly) {
1838         $query = "
1839             SELECT *
1840             FROM   aqcontract
1841             WHERE  booksellerid=?
1842         ";
1843     } else {
1844         $query = "SELECT *
1845             FROM aqcontract
1846             WHERE booksellerid=?
1847                 AND contractenddate >= CURDATE( )";
1848     }
1849     my $sth = $dbh->prepare($query);
1850     $sth->execute( $booksellerid );
1851     my @results;
1852     while (my $data = $sth->fetchrow_hashref ) {
1853         push(@results, $data);
1854     }
1855     $sth->finish;
1856     return @results;
1857 }
1858
1859 #------------------------------------------------------------#
1860
1861 =head3 GetContract
1862
1863   $contract = &GetContract($contractID);
1864
1865 Looks up the contract that has PRIMKEY (contractnumber) value $contractID
1866
1867 Returns a contract
1868
1869 =cut
1870
1871 sub GetContract {
1872     my ( $contractno ) = @_;
1873     my $dbh = C4::Context->dbh;
1874     my $query = "
1875         SELECT *
1876         FROM   aqcontract
1877         WHERE  contractnumber=?
1878         ";
1879
1880     my $sth = $dbh->prepare($query);
1881     $sth->execute( $contractno );
1882     my $result = $sth->fetchrow_hashref;
1883     return $result;
1884 }
1885
1886 =head3 AddClaim
1887
1888 =over 4
1889
1890 &AddClaim($ordernumber);
1891
1892 Add a claim for an order
1893
1894 =back
1895
1896 =cut
1897 sub AddClaim {
1898     my ($ordernumber) = @_;
1899     my $dbh          = C4::Context->dbh;
1900     my $query        = "
1901         UPDATE aqorders SET
1902             claims_count = claims_count + 1,
1903             claimed_date = CURDATE()
1904         WHERE ordernumber = ?
1905         ";
1906     my $sth = $dbh->prepare($query);
1907     $sth->execute($ordernumber);
1908
1909 }
1910
1911 1;
1912 __END__
1913
1914 =head1 AUTHOR
1915
1916 Koha Development Team <http://koha-community.org/>
1917
1918 =cut