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