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                 , quantityreceived=?
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         my $newOrder = NewOrder($order);
1240 } else {
1241         $sth=$dbh->prepare("update aqorders
1242                             set quantityreceived=?,datereceived=?,booksellerinvoicenumber=?,
1243                                 unitprice=?,freight=?,rrp=?
1244                             where biblionumber=? and ordernumber=?");
1245         $sth->execute($quantrec,$datereceived,$invoiceno,$cost,$freight,$rrp,$biblionumber,$ordernumber);
1246         $sth->finish;
1247     }
1248     return $datereceived;
1249 }
1250 #------------------------------------------------------------#
1251
1252 =head3 SearchOrder
1253
1254 @results = &SearchOrder($search, $biblionumber, $complete);
1255
1256 Searches for orders.
1257
1258 C<$search> may take one of several forms: if it is an ISBN,
1259 C<&ordersearch> returns orders with that ISBN. If C<$search> is an
1260 order number, C<&ordersearch> returns orders with that order number
1261 and biblionumber C<$biblionumber>. Otherwise, C<$search> is considered
1262 to be a space-separated list of search terms; in this case, all of the
1263 terms must appear in the title (matching the beginning of title
1264 words).
1265
1266 If C<$complete> is C<yes>, the results will include only completed
1267 orders. In any case, C<&ordersearch> ignores cancelled orders.
1268
1269 C<&ordersearch> returns an array.
1270 C<@results> is an array of references-to-hash with the following keys:
1271
1272 =over 4
1273
1274 =item C<author>
1275
1276 =item C<seriestitle>
1277
1278 =item C<branchcode>
1279
1280 =item C<bookfundid>
1281
1282 =back
1283
1284 =cut
1285
1286 sub SearchOrder {
1287 #### -------- SearchOrder-------------------------------
1288     my ($ordernumber, $search, $supplierid, $basket) = @_;
1289
1290     my $dbh = C4::Context->dbh;
1291     my @args = ();
1292     my $query =
1293             "SELECT *
1294             FROM aqorders
1295             LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1296             LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
1297             LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
1298                 WHERE  (datecancellationprinted is NULL)";
1299
1300     if($ordernumber){
1301         $query .= " AND (aqorders.ordernumber=?)";
1302         push @args, $ordernumber;
1303     }
1304     if($search){
1305         $query .= " AND (biblio.title like ? OR biblio.author LIKE ? OR biblioitems.isbn like ?)";
1306         push @args, ("%$search%","%$search%","%$search%");
1307     }
1308     if($supplierid){
1309         $query .= "AND aqbasket.booksellerid = ?";
1310         push @args, $supplierid;
1311     }
1312     if($basket){
1313         $query .= "AND aqorders.basketno = ?";
1314         push @args, $basket;
1315     }
1316
1317     my $sth = $dbh->prepare($query);
1318     $sth->execute(@args);
1319     my $results = $sth->fetchall_arrayref({});
1320     $sth->finish;
1321     return $results;
1322 }
1323
1324 #------------------------------------------------------------#
1325
1326 =head3 DelOrder
1327
1328 =over 4
1329
1330 &DelOrder($biblionumber, $ordernumber);
1331
1332 Cancel the order with the given order and biblio numbers. It does not
1333 delete any entries in the aqorders table, it merely marks them as
1334 cancelled.
1335
1336 =back
1337
1338 =cut
1339
1340 sub DelOrder {
1341     my ( $bibnum, $ordernumber ) = @_;
1342     my $dbh = C4::Context->dbh;
1343     my $query = "
1344         UPDATE aqorders
1345         SET    datecancellationprinted=now()
1346         WHERE  biblionumber=? AND ordernumber=?
1347     ";
1348     my $sth = $dbh->prepare($query);
1349     $sth->execute( $bibnum, $ordernumber );
1350     $sth->finish;
1351 }
1352
1353 =head2 FUNCTIONS ABOUT PARCELS
1354
1355 =cut
1356
1357 #------------------------------------------------------------#
1358
1359 =head3 GetParcel
1360
1361 =over 4
1362
1363 @results = &GetParcel($booksellerid, $code, $date);
1364
1365 Looks up all of the received items from the supplier with the given
1366 bookseller ID at the given date, for the given code (bookseller Invoice number). Ignores cancelled and completed orders.
1367
1368 C<@results> is an array of references-to-hash. The keys of each element are fields from
1369 the aqorders, biblio, and biblioitems tables of the Koha database.
1370
1371 C<@results> is sorted alphabetically by book title.
1372
1373 =back
1374
1375 =cut
1376
1377 sub GetParcel {
1378     #gets all orders from a certain supplier, orders them alphabetically
1379     my ( $supplierid, $code, $datereceived ) = @_;
1380     my $dbh     = C4::Context->dbh;
1381     my @results = ();
1382     $code .= '%'
1383     if $code;  # add % if we search on a given code (otherwise, let him empty)
1384     my $strsth ="
1385         SELECT  authorisedby,
1386                 creationdate,
1387                 aqbasket.basketno,
1388                 closedate,surname,
1389                 firstname,
1390                 aqorders.biblionumber,
1391                 aqorders.ordernumber,
1392                 aqorders.quantity,
1393                 aqorders.quantityreceived,
1394                 aqorders.unitprice,
1395                 aqorders.listprice,
1396                 aqorders.rrp,
1397                 aqorders.ecost,
1398                 biblio.title
1399         FROM aqorders
1400         LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
1401         LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
1402         LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1403         WHERE
1404             aqbasket.booksellerid = ?
1405             AND aqorders.booksellerinvoicenumber LIKE ?
1406             AND aqorders.datereceived = ? ";
1407
1408     my @query_params = ( $supplierid, $code, $datereceived );
1409     if ( C4::Context->preference("IndependantBranches") ) {
1410         my $userenv = C4::Context->userenv;
1411         if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
1412             $strsth .= " and (borrowers.branchcode = ?
1413                         or borrowers.branchcode  = '')";
1414             push @query_params, $userenv->{branch};
1415         }
1416     }
1417     $strsth .= " ORDER BY aqbasket.basketno";
1418     # ## parcelinformation : $strsth
1419     my $sth = $dbh->prepare($strsth);
1420     $sth->execute( @query_params );
1421     while ( my $data = $sth->fetchrow_hashref ) {
1422         push( @results, $data );
1423     }
1424     # ## countparcelbiblio: scalar(@results)
1425     $sth->finish;
1426
1427     return @results;
1428 }
1429
1430 #------------------------------------------------------------#
1431
1432 =head3 GetParcels
1433
1434 =over 4
1435
1436 $results = &GetParcels($bookseller, $order, $code, $datefrom, $dateto);
1437 get a lists of parcels.
1438
1439 =back
1440
1441 * Input arg :
1442
1443 =over 4
1444
1445 =item $bookseller
1446 is the bookseller this function has to get parcels.
1447
1448 =item $order
1449 To know on what criteria the results list has to be ordered.
1450
1451 =item $code
1452 is the booksellerinvoicenumber.
1453
1454 =item $datefrom & $dateto
1455 to know on what date this function has to filter its search.
1456
1457 * return:
1458 a pointer on a hash list containing parcel informations as such :
1459
1460 =item Creation date
1461
1462 =item Last operation
1463
1464 =item Number of biblio
1465
1466 =item Number of items
1467
1468 =back
1469
1470 =cut
1471
1472 sub GetParcels {
1473     my ($bookseller,$order, $code, $datefrom, $dateto) = @_;
1474     my $dbh    = C4::Context->dbh;
1475     my @query_params = ();
1476     my $strsth ="
1477         SELECT  aqorders.booksellerinvoicenumber,
1478                 datereceived,purchaseordernumber,
1479                 count(DISTINCT biblionumber) AS biblio,
1480                 sum(quantity) AS itemsexpected,
1481                 sum(quantityreceived) AS itemsreceived
1482         FROM   aqorders LEFT JOIN aqbasket ON aqbasket.basketno = aqorders.basketno
1483         WHERE aqbasket.booksellerid = $bookseller and datereceived IS NOT NULL
1484     ";
1485
1486     if ( defined $code ) {
1487         $strsth .= ' and aqorders.booksellerinvoicenumber like ? ';
1488         # add a % to the end of the code to allow stemming.
1489         push @query_params, "$code%";
1490     }
1491
1492     if ( defined $datefrom ) {
1493         $strsth .= ' and datereceived >= ? ';
1494         push @query_params, $datefrom;
1495     }
1496
1497     if ( defined $dateto ) {
1498         $strsth .=  'and datereceived <= ? ';
1499         push @query_params, $dateto;
1500     }
1501
1502     $strsth .= "group by aqorders.booksellerinvoicenumber,datereceived ";
1503
1504     # can't use a placeholder to place this column name.
1505     # but, we could probably be checking to make sure it is a column that will be fetched.
1506     $strsth .= "order by $order " if ($order);
1507
1508     my $sth = $dbh->prepare($strsth);
1509
1510     $sth->execute( @query_params );
1511     my $results = $sth->fetchall_arrayref({});
1512     $sth->finish;
1513     return @$results;
1514 }
1515
1516 #------------------------------------------------------------#
1517
1518 =head3 GetLateOrders
1519
1520 =over 4
1521
1522 @results = &GetLateOrders;
1523
1524 Searches for bookseller with late orders.
1525
1526 return:
1527 the table of supplier with late issues. This table is full of hashref.
1528
1529 =back
1530
1531 =cut
1532
1533 sub GetLateOrders {
1534     my $delay      = shift;
1535     my $supplierid = shift;
1536     my $branch     = shift;
1537
1538     my $dbh = C4::Context->dbh;
1539
1540     #BEWARE, order of parenthesis and LEFT JOIN is important for speed
1541     my $dbdriver = C4::Context->config("db_scheme") || "mysql";
1542
1543     my @query_params = ($delay);        # delay is the first argument regardless
1544     my $select = "
1545     SELECT aqbasket.basketno,
1546         aqorders.ordernumber,
1547         DATE(aqbasket.closedate)  AS orderdate,
1548         aqorders.rrp              AS unitpricesupplier,
1549         aqorders.ecost            AS unitpricelib,
1550         aqbudgets.budget_name     AS budget,
1551         borrowers.branchcode      AS branch,
1552         aqbooksellers.name        AS supplier,
1553         biblio.author,
1554         biblioitems.publishercode AS publisher,
1555         biblioitems.publicationyear,
1556     ";
1557     my $from = "
1558     FROM
1559         aqorders LEFT JOIN biblio     ON biblio.biblionumber         = aqorders.biblionumber
1560         LEFT JOIN biblioitems         ON biblioitems.biblionumber    = biblio.biblionumber
1561         LEFT JOIN aqbudgets           ON aqorders.budget_id          = aqbudgets.budget_id,
1562         aqbasket LEFT JOIN borrowers  ON aqbasket.authorisedby       = borrowers.borrowernumber
1563         LEFT JOIN aqbooksellers       ON aqbasket.booksellerid       = aqbooksellers.id
1564         WHERE aqorders.basketno = aqbasket.basketno
1565         AND ( datereceived = ''
1566             OR datereceived IS NULL
1567             OR aqorders.quantityreceived < aqorders.quantity
1568         )
1569     ";
1570     my $having = "";
1571     if ($dbdriver eq "mysql") {
1572         $select .= "
1573         aqorders.quantity - IFNULL(aqorders.quantityreceived,0)                 AS quantity,
1574         (aqorders.quantity - IFNULL(aqorders.quantityreceived,0)) * aqorders.rrp AS subtotal,
1575         DATEDIFF(CURDATE( ),closedate) AS latesince
1576         ";
1577         $from .= " AND (closedate <= DATE_SUB(CURDATE( ),INTERVAL ? DAY)) ";
1578         $having = "
1579         HAVING quantity          <> 0
1580             AND unitpricesupplier <> 0
1581             AND unitpricelib      <> 0
1582         ";
1583     } else {
1584         # FIXME: account for IFNULL as above
1585         $select .= "
1586                 aqorders.quantity                AS quantity,
1587                 aqorders.quantity * aqorders.rrp AS subtotal,
1588                 (CURDATE - closedate)            AS latesince
1589         ";
1590         $from .= " AND (closedate <= (CURDATE -(INTERVAL ? DAY)) ";
1591     }
1592     if (defined $supplierid) {
1593         $from .= ' AND aqbasket.booksellerid = ? ';
1594         push @query_params, $supplierid;
1595     }
1596     if (defined $branch) {
1597         $from .= ' AND borrowers.branchcode LIKE ? ';
1598         push @query_params, $branch;
1599     }
1600     if (C4::Context->preference("IndependantBranches")
1601             && C4::Context->userenv
1602             && C4::Context->userenv->{flags} != 1 ) {
1603         $from .= ' AND borrowers.branchcode LIKE ? ';
1604         push @query_params, C4::Context->userenv->{branch};
1605     }
1606     my $query = "$select $from $having\nORDER BY latesince, basketno, borrowers.branchcode, supplier";
1607     $debug and print STDERR "GetLateOrders query: $query\nGetLateOrders args: " . join(" ",@query_params);
1608     my $sth = $dbh->prepare($query);
1609     $sth->execute(@query_params);
1610     my @results;
1611     while (my $data = $sth->fetchrow_hashref) {
1612         $data->{orderdate} = format_date($data->{orderdate});
1613         push @results, $data;
1614     }
1615     return @results;
1616 }
1617
1618 #------------------------------------------------------------#
1619
1620 =head3 GetHistory
1621
1622 =over 4
1623
1624 (\@order_loop, $total_qty, $total_price, $total_qtyreceived) = GetHistory( $title, $author, $name, $from_placed_on, $to_placed_on );
1625
1626 Retreives some acquisition history information
1627
1628 returns:
1629     $order_loop is a list of hashrefs that each look like this:
1630             {
1631                 'author'           => 'Twain, Mark',
1632                 'basketno'         => '1',
1633                 'biblionumber'     => '215',
1634                 'count'            => 1,
1635                 'creationdate'     => 'MM/DD/YYYY',
1636                 'datereceived'     => undef,
1637                 'ecost'            => '1.00',
1638                 'id'               => '1',
1639                 'invoicenumber'    => undef,
1640                 'name'             => '',
1641                 'ordernumber'      => '1',
1642                 'quantity'         => 1,
1643                 'quantityreceived' => undef,
1644                 'title'            => 'The Adventures of Huckleberry Finn'
1645             }
1646     $total_qty is the sum of all of the quantities in $order_loop
1647     $total_price is the cost of each in $order_loop times the quantity
1648     $total_qtyreceived is the sum of all of the quantityreceived entries in $order_loop
1649
1650 =back
1651
1652 =cut
1653
1654 sub GetHistory {
1655     my ( $title, $author, $name, $from_placed_on, $to_placed_on ) = @_;
1656     my @order_loop;
1657     my $total_qty         = 0;
1658     my $total_qtyreceived = 0;
1659     my $total_price       = 0;
1660
1661 # don't run the query if there are no parameters (list would be too long for sure !)
1662     if ( $title || $author || $name || $from_placed_on || $to_placed_on ) {
1663         my $dbh   = C4::Context->dbh;
1664         my $query ="
1665             SELECT
1666                 biblio.title,
1667                 biblio.author,
1668                 aqorders.basketno,
1669                 name,aqbasket.creationdate,
1670                 aqorders.datereceived,
1671                 aqorders.quantity,
1672                 aqorders.quantityreceived,
1673                 aqorders.ecost,
1674                 aqorders.ordernumber,
1675                 aqorders.booksellerinvoicenumber as invoicenumber,
1676                 aqbooksellers.id as id,
1677                 aqorders.biblionumber
1678             FROM aqorders
1679             LEFT JOIN aqbasket ON aqorders.basketno=aqbasket.basketno
1680             LEFT JOIN aqbooksellers ON aqbasket.booksellerid=aqbooksellers.id
1681             LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber";
1682
1683         $query .= " LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber"
1684         if ( C4::Context->preference("IndependantBranches") );
1685
1686         $query .= " WHERE (datecancellationprinted is NULL or datecancellationprinted='0000-00-00') ";
1687
1688         my @query_params  = ();
1689
1690         if ( defined $title ) {
1691             $query .= " AND biblio.title LIKE ? ";
1692             push @query_params, "%$title%";
1693         }
1694
1695         if ( defined $author ) {
1696             $query .= " AND biblio.author LIKE ? ";
1697             push @query_params, "%$author%";
1698         }
1699
1700         if ( defined $name ) {
1701             $query .= " AND name LIKE ? ";
1702             push @query_params, "%$name%";
1703         }
1704
1705         if ( defined $from_placed_on ) {
1706             $query .= " AND creationdate >= ? ";
1707             push @query_params, $from_placed_on;
1708         }
1709
1710         if ( defined $to_placed_on ) {
1711             $query .= " AND creationdate <= ? ";
1712             push @query_params, $to_placed_on;
1713         }
1714
1715         if ( C4::Context->preference("IndependantBranches") ) {
1716             my $userenv = C4::Context->userenv;
1717             if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
1718                 $query .= " AND (borrowers.branchcode = ? OR borrowers.branchcode ='' ) ";
1719                 push @query_params, $userenv->{branch};
1720             }
1721         }
1722         $query .= " ORDER BY booksellerid";
1723         my $sth = $dbh->prepare($query);
1724         $sth->execute( @query_params );
1725         my $cnt = 1;
1726         while ( my $line = $sth->fetchrow_hashref ) {
1727             $line->{count} = $cnt++;
1728             $line->{toggle} = 1 if $cnt % 2;
1729             push @order_loop, $line;
1730             $line->{creationdate} = format_date( $line->{creationdate} );
1731             $line->{datereceived} = format_date( $line->{datereceived} );
1732             $total_qty         += $line->{'quantity'};
1733             $total_qtyreceived += $line->{'quantityreceived'};
1734             $total_price       += $line->{'quantity'} * $line->{'ecost'};
1735         }
1736     }
1737     return \@order_loop, $total_qty, $total_price, $total_qtyreceived;
1738 }
1739
1740 =head2 GetRecentAcqui
1741
1742 $results = GetRecentAcqui($days);
1743
1744 C<$results> is a ref to a table which containts hashref
1745
1746 =cut
1747
1748 sub GetRecentAcqui {
1749     my $limit  = shift;
1750     my $dbh    = C4::Context->dbh;
1751     my $query = "
1752         SELECT *
1753         FROM   biblio
1754         ORDER BY timestamp DESC
1755         LIMIT  0,".$limit;
1756
1757     my $sth = $dbh->prepare($query);
1758     $sth->execute;
1759     my $results = $sth->fetchall_arrayref({});
1760     return $results;
1761 }
1762
1763 =head3 GetContracts
1764
1765 =over 4
1766
1767 $contractlist = &GetContracts($booksellerid, $activeonly);
1768
1769 Looks up the contracts that belong to a bookseller
1770
1771 Returns a list of contracts
1772
1773 =item C<$booksellerid> is the "id" field in the "aqbooksellers" table.
1774
1775 =item C<$activeonly> if exists get only contracts that are still active.
1776
1777 =back
1778
1779 =cut
1780 sub GetContracts {
1781     my ( $booksellerid, $activeonly ) = @_;
1782     my $dbh = C4::Context->dbh;
1783     my $query;
1784     if (! $activeonly) {
1785         $query = "
1786             SELECT *
1787             FROM   aqcontract
1788             WHERE  booksellerid=?
1789         ";
1790     } else {
1791         $query = "SELECT *
1792             FROM aqcontract
1793             WHERE booksellerid=?
1794                 AND contractenddate >= CURDATE( )";
1795     }
1796     my $sth = $dbh->prepare($query);
1797     $sth->execute( $booksellerid );
1798     my @results;
1799     while (my $data = $sth->fetchrow_hashref ) {
1800         push(@results, $data);
1801     }
1802     $sth->finish;
1803     return @results;
1804 }
1805
1806 #------------------------------------------------------------#
1807
1808 =head3 GetContract
1809
1810 =over 4
1811
1812 $contract = &GetContract($contractID);
1813
1814 Looks up the contract that has PRIMKEY (contractnumber) value $contractID
1815
1816 Returns a contract
1817
1818 =back
1819
1820 =cut
1821 sub GetContract {
1822     my ( $contractno ) = @_;
1823     my $dbh = C4::Context->dbh;
1824     my $query = "
1825         SELECT *
1826         FROM   aqcontract
1827         WHERE  contractnumber=?
1828         ";
1829
1830     my $sth = $dbh->prepare($query);
1831     $sth->execute( $contractno );
1832     my $result = $sth->fetchrow_hashref;
1833     return $result;
1834 }
1835
1836 1;
1837 __END__
1838
1839 =head1 AUTHOR
1840
1841 Koha Developement team <info@koha.org>
1842
1843 =cut