C4/Acquisition.pm

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