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