C4/Acquisition.pm

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