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