koha-dev.rot13.org Git - koha_fer/blob - C4/Acquisition.pm

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