C4/Acquisition.pm

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