C4/Acquisition.pm

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