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