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