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 &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) = @_;
 655     my $dbh = C4::Context->dbh;
 656     my $strsth = "
 657         SELECT    ".($grouped?"count(*),":"")."aqbasket.basketno,
 658                     surname,firstname,aqorders.*,biblio.*,
 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         WHERE booksellerid=?
 665             AND (quantity > quantityreceived OR quantityreceived is NULL)
 666             AND datecancellationprinted IS NULL
 667             AND (to_days(now())-to_days(closedate) < 180 OR closedate IS NULL)
 668     ";
 669     ## FIXME  Why 180 days ???
 670     my @query_params = ( $supplierid );
 671     my $userenv = C4::Context->userenv;
 672     if ( C4::Context->preference("IndependantBranches") ) {
 673         if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
 674             $strsth .= " and (borrowers.branchcode = ?
 675                           or borrowers.branchcode  = '')";
 676             push @query_params, $userenv->{branch};
 677         }
 678     }
 679     if ($owner) {
 680         $strsth .= " AND aqbasket.authorisedby=? ";
 681         push @query_params, $userenv->{'number'};
 682     }
 683     $strsth .= " group by aqbasket.basketno" if $grouped;
 684     $strsth .= " order by aqbasket.basketno";
 685
 686     my $sth = $dbh->prepare($strsth);
 687     $sth->execute( @query_params );
 688     my $results = $sth->fetchall_arrayref({});
 689     $sth->finish;
 690     return $results;
 691 }
 692
 693 #------------------------------------------------------------#
 694
 695 =head3 GetOrders
 696
 697 =over 4
 698
 699 @orders = &GetOrders($basketnumber, $orderby);
 700
 701 Looks up the pending (non-cancelled) orders with the given basket
 702 number. If C<$booksellerID> is non-empty, only orders from that seller
 703 are returned.
 704
 705 return :
 706 C<&basket> returns a two-element array. C<@orders> is an array of
 707 references-to-hash, whose keys are the fields from the aqorders,
 708 biblio, and biblioitems tables in the Koha database.
 709
 710 =back
 711
 712 =cut
 713
 714 sub GetOrders {
 715     my ( $basketno, $orderby ) = @_;
 716     my $dbh   = C4::Context->dbh;
 717     my $query  ="
 718          SELECT biblio.*,biblioitems.*,
 719                 aqorders.*,
 720                 aqbudgets.*,
 721                 biblio.title
 722         FROM    aqorders
 723             LEFT JOIN aqbudgets        ON aqbudgets.budget_id = aqorders.budget_id
 724             LEFT JOIN biblio           ON biblio.biblionumber = aqorders.biblionumber
 725             LEFT JOIN biblioitems      ON biblioitems.biblionumber =biblio.biblionumber
 726         WHERE   basketno=?
 727             AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00')
 728     ";
 729
 730     $orderby = "biblioitems.publishercode,biblio.title" unless $orderby;
 731     $query .= " ORDER BY $orderby";
 732     my $sth = $dbh->prepare($query);
 733     $sth->execute($basketno);
 734     my $results = $sth->fetchall_arrayref({});
 735     $sth->finish;
 736     return @$results;
 737 }
 738
 739 #------------------------------------------------------------#
 740
 741 =head3 GetOrderNumber
 742
 743 =over 4
 744
 745 $ordernumber = &GetOrderNumber($biblioitemnumber, $biblionumber);
 746
 747 =back
 748
 749 Looks up the ordernumber with the given biblionumber and biblioitemnumber.
 750
 751 Returns the number of this order.
 752
 753 =over 4
 754
 755 =item C<$ordernumber> is the order number.
 756
 757 =back
 758
 759 =cut
 760 sub GetOrderNumber {
 761     my ( $biblionumber,$biblioitemnumber ) = @_;
 762     my $dbh = C4::Context->dbh;
 763     my $query = "
 764         SELECT ordernumber
 765         FROM   aqorders
 766         WHERE  biblionumber=?
 767         AND    biblioitemnumber=?
 768     ";
 769     my $sth = $dbh->prepare($query);
 770     $sth->execute( $biblionumber, $biblioitemnumber );
 771
 772     return $sth->fetchrow;
 773 }
 774
 775 #------------------------------------------------------------#
 776
 777 =head3 GetOrder
 778
 779 =over 4
 780
 781 $order = &GetOrder($ordernumber);
 782
 783 Looks up an order by order number.
 784
 785 Returns a reference-to-hash describing the order. The keys of
 786 C<$order> are fields from the biblio, biblioitems, aqorders tables of the Koha database.
 787
 788 =back
 789
 790 =cut
 791
 792 sub GetOrder {
 793     my ($ordnum) = @_;
 794     my $dbh      = C4::Context->dbh;
 795     my $query = "
 796         SELECT biblioitems.*, biblio.*, aqorders.*
 797         FROM   aqorders
 798         LEFT JOIN biblio on           biblio.biblionumber=aqorders.biblionumber
 799         LEFT JOIN biblioitems on       biblioitems.biblionumber=aqorders.biblionumber
 800         WHERE aqorders.ordernumber=?
 801
 802     ";
 803     my $sth= $dbh->prepare($query);
 804     $sth->execute($ordnum);
 805     my $data = $sth->fetchrow_hashref;
 806     $sth->finish;
 807     return $data;
 808 }
 809
 810 #------------------------------------------------------------#
 811
 812 =head3 NewOrder
 813
 814 =over 4
 815
 816 &NewOrder(\%hashref);
 817
 818 Adds a new order to the database. Any argument that isn't described
 819 below is the new value of the field with the same name in the aqorders
 820 table of the Koha database.
 821
 822 =over 4
 823
 824 =item $hashref->{'basketno'} is the basketno foreign key in aqorders, it is mandatory
 825
 826
 827 =item $hashref->{'ordnum'} is a "minimum order number."
 828
 829 =item $hashref->{'budgetdate'} is effectively ignored.
 830   If it's undef (anything false) or the string 'now', the current day is used.
 831   Else, the upcoming July 1st is used.
 832
 833 =item $hashref->{'subscription'} may be either "yes", or anything else for "no".
 834
 835 =item $hashref->{'uncertainprice'} may be 0 for "the price is known" or 1 for "the price is uncertain"
 836
 837 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".
 838
 839 =back
 840
 841 =back
 842
 843 =cut
 844
 845 sub NewOrder {
 846     my $orderinfo = shift;
 847 #### ------------------------------
 848     my $dbh = C4::Context->dbh;
 849     my @params;
 850
 851
 852     # if these parameters are missing, we can't continue
 853     for my $key (qw/basketno quantity biblionumber budget_id/) {
 854         die "Mandatory parameter $key missing" unless $orderinfo->{$key};
 855     }
 856
 857     if ( $orderinfo->{'subscription'} eq 'yes' ) {
 858         $orderinfo->{'subscription'} = 1;
 859     } else {
 860         $orderinfo->{'subscription'} = 0;
 861     }
 862
 863     my $query = "INSERT INTO aqorders (";
 864     foreach my $orderinfokey (keys %{$orderinfo}) {
 865         next if $orderinfokey =~ m/branchcode|entrydate/;   # skip branchcode and entrydate, branchcode isnt a vaild col, entrydate we add manually with NOW()
 866         $query .= "$orderinfokey,";
 867         push(@params, $orderinfo->{$orderinfokey});
 868     }
 869
 870     $query .= "entrydate) VALUES (";
 871     foreach (@params) {
 872         $query .= "?,";
 873     }
 874     $query .= " NOW() )";  #ADDING CURRENT DATE TO  'budgetdate, entrydate, purchaseordernumber'...
 875
 876     my $sth = $dbh->prepare($query);
 877
 878     $sth->execute(@params);
 879     $sth->finish;
 880
 881     #get ordnum MYSQL dependant, but $dbh->last_insert_id returns null
 882     my $ordnum = $dbh->{'mysql_insertid'};
 883
 884     $sth->finish;
 885     return ( $orderinfo->{'basketno'}, $ordnum );
 886 }
 887
 888
 889
 890 #------------------------------------------------------------#
 891
 892 =head3 NewOrderItem
 893
 894 =over 4
 895
 896 &NewOrderItem();
 897
 898
 899 =back
 900
 901 =cut
 902
 903 sub NewOrderItem {
 904     #my ($biblioitemnumber,$ordnum, $biblionumber) = @_;
 905     my ($itemnumber, $ordernumber)  = @_;
 906     my $dbh = C4::Context->dbh;
 907     my $query = qq|
 908             INSERT INTO aqorders_items
 909                 (itemnumber, ordernumber)
 910             VALUES (?,?)    |;
 911
 912     my $sth = $dbh->prepare($query);
 913     $sth->execute( $itemnumber, $ordernumber);
 914 }
 915
 916 #------------------------------------------------------------#
 917
 918 =head3 ModOrder
 919
 920 =over 4
 921
 922 &ModOrder(\%hashref);
 923
 924 =over 2
 925
 926 Modifies an existing order. Updates the order with order number
 927 $hashref->{'ordernumber'} and biblionumber $hashref->{'biblionumber'}. All other keys of the hash
 928 update the fields with the same name in the aqorders table of the Koha database.
 929
 930 =back
 931
 932 =back
 933
 934 =cut
 935
 936 sub ModOrder {
 937     my $orderinfo = shift;
 938
 939     die "Ordernumber is required"     if $orderinfo->{'ordernumber'} eq  '' ;
 940     die "Biblionumber is required"  if  $orderinfo->{'biblionumber'} eq '';
 941
 942     my $dbh = C4::Context->dbh;
 943     my @params;
 944 #    delete($orderinfo->{'branchcode'});
 945     # the hash contains a lot of entries not in aqorders, so get the columns ...
 946     my $sth = $dbh->prepare("SELECT * FROM aqorders LIMIT 1;");
 947     $sth->execute;
 948     my $colnames = $sth->{NAME};
 949     my $query = "UPDATE aqorders SET ";
 950
 951     foreach my $orderinfokey (grep(!/ordernumber/, keys %$orderinfo)){
 952         # ... and skip hash entries that are not in the aqorders table
 953         # FIXME : probably not the best way to do it (would be better to have a correct hash)
 954         next unless grep(/^$orderinfokey$/, @$colnames);
 955             $query .= "$orderinfokey=?, ";
 956             push(@params, $orderinfo->{$orderinfokey});
 957     }
 958
 959     $query .= "timestamp=NOW()  WHERE  ordernumber=?";
 960 #   push(@params, $specorderinfo{'ordernumber'});
 961     push(@params, $orderinfo->{'ordernumber'} );
 962     $sth = $dbh->prepare($query);
 963     $sth->execute(@params);
 964     $sth->finish;
 965 }
 966
 967 #------------------------------------------------------------#
 968
 969 =head3 ModOrderBibliotemNumber
 970
 971 =over 4
 972
 973 &ModOrderBiblioitemNumber($biblioitemnumber,$ordnum, $biblionumber);
 974
 975 Modifies the biblioitemnumber for an existing order.
 976 Updates the order with order number C<$ordernum> and biblionumber C<$biblionumber>.
 977
 978 =back
 979
 980 =cut
 981
 982 #FIXME: is this used at all?
 983 sub ModOrderBiblioitemNumber {
 984     my ($biblioitemnumber,$ordnum, $biblionumber) = @_;
 985     my $dbh = C4::Context->dbh;
 986     my $query = "
 987       UPDATE aqorders
 988       SET    biblioitemnumber = ?
 989       WHERE  ordernumber = ?
 990       AND biblionumber =  ?";
 991     my $sth = $dbh->prepare($query);
 992     $sth->execute( $biblioitemnumber, $ordnum, $biblionumber );
 993 }
 994
 995 #------------------------------------------------------------#
 996
 997 =head3 ModReceiveOrder
 998
 999 =over 4
1000
1001 &ModReceiveOrder($biblionumber, $ordernumber, $quantityreceived, $user,
1002     $unitprice, $booksellerinvoicenumber, $biblioitemnumber,
1003     $freight, $bookfund, $rrp);
1004
1005 Updates an order, to reflect the fact that it was received, at least
1006 in part. All arguments not mentioned below update the fields with the
1007 same name in the aqorders table of the Koha database.
1008
1009 If a partial order is received, splits the order into two.  The received
1010 portion must have a booksellerinvoicenumber.
1011
1012 Updates the order with bibilionumber C<$biblionumber> and ordernumber
1013 C<$ordernumber>.
1014
1015 =back
1016
1017 =cut
1018
1019
1020 sub ModReceiveOrder {
1021     my (
1022         $biblionumber,    $ordnum,  $quantrec, $user, $cost,
1023         $invoiceno, $freight, $rrp, $budget_id, $datereceived
1024       )
1025       = @_;
1026     my $dbh = C4::Context->dbh;
1027 #     warn "DATE BEFORE : $daterecieved";
1028 #    $daterecieved=POSIX::strftime("%Y-%m-%d",CORE::localtime) unless $daterecieved;
1029 #     warn "DATE REC : $daterecieved";
1030         $datereceived = C4::Dates->output('iso') unless $datereceived;
1031     my $suggestionid = GetSuggestionFromBiblionumber( $dbh, $biblionumber );
1032     if ($suggestionid) {
1033         ModStatus( $suggestionid, 'AVAILABLE', '', $biblionumber );
1034     }
1035
1036         my $sth=$dbh->prepare("
1037         SELECT * FROM   aqorders
1038             WHERE           biblionumber=? AND aqorders.ordernumber=?");
1039
1040     $sth->execute($biblionumber,$ordnum);
1041     my $order = $sth->fetchrow_hashref();
1042     $sth->finish();
1043
1044         if ( $order->{quantity} > $quantrec ) {
1045         $sth=$dbh->prepare("
1046             UPDATE aqorders
1047             SET quantityreceived=?
1048                 , datereceived=?
1049                 , booksellerinvoicenumber=?
1050                 , unitprice=?
1051                 , freight=?
1052                 , rrp=?
1053                 , quantityreceived=?
1054             WHERE biblionumber=? AND ordernumber=?");
1055
1056         $sth->execute($quantrec,$datereceived,$invoiceno,$cost,$freight,$rrp,$quantrec,$biblionumber,$ordnum);
1057         $sth->finish;
1058
1059         # create a new order for the remaining items, and set its bookfund.
1060         foreach my $orderkey ( "linenumber", "allocation" ) {
1061             delete($order->{'$orderkey'});
1062         }
1063         my $newOrder = NewOrder($order);
1064   } else {
1065         $sth=$dbh->prepare("update aqorders
1066                                                         set quantityreceived=?,datereceived=?,booksellerinvoicenumber=?,
1067                                                                 unitprice=?,freight=?,rrp=?
1068                             where biblionumber=? and ordernumber=?");
1069         $sth->execute($quantrec,$datereceived,$invoiceno,$cost,$freight,$rrp,$biblionumber,$ordnum);
1070         $sth->finish;
1071     }
1072     return $datereceived;
1073 }
1074 #------------------------------------------------------------#
1075
1076 =head3 SearchOrder
1077
1078 @results = &SearchOrder($search, $biblionumber, $complete);
1079
1080 Searches for orders.
1081
1082 C<$search> may take one of several forms: if it is an ISBN,
1083 C<&ordersearch> returns orders with that ISBN. If C<$search> is an
1084 order number, C<&ordersearch> returns orders with that order number
1085 and biblionumber C<$biblionumber>. Otherwise, C<$search> is considered
1086 to be a space-separated list of search terms; in this case, all of the
1087 terms must appear in the title (matching the beginning of title
1088 words).
1089
1090 If C<$complete> is C<yes>, the results will include only completed
1091 orders. In any case, C<&ordersearch> ignores cancelled orders.
1092
1093 C<&ordersearch> returns an array.
1094 C<@results> is an array of references-to-hash with the following keys:
1095
1096 =over 4
1097
1098 =item C<author>
1099
1100 =item C<seriestitle>
1101
1102 =item C<branchcode>
1103
1104 =item C<bookfundid>
1105
1106 =back
1107
1108 =cut
1109
1110 sub SearchOrder {
1111 #### -------- SearchOrder-------------------------------
1112     my ($ordernumber, $search) = @_;
1113
1114     if ($ordernumber) {
1115         my $dbh = C4::Context->dbh;
1116         my $query =
1117             "SELECT *
1118             FROM aqorders
1119             LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1120             LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
1121             LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
1122                 WHERE  ((datecancellationprinted is NULL)
1123                 AND (aqorders.ordernumber=?))";
1124         my $sth = $dbh->prepare($query);
1125         $sth->execute($ordernumber);
1126         my $results = $sth->fetchall_arrayref({});
1127         $sth->finish;
1128         return $results;
1129     } else {
1130         my $dbh = C4::Context->dbh;
1131         my $query =
1132             "SELECT *
1133             FROM aqorders
1134             LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1135             LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
1136             LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
1137                 WHERE  ((datecancellationprinted is NULL)
1138                 AND (biblio.title like ? OR biblioitems.isbn like ?))";
1139         my $sth = $dbh->prepare($query);
1140         $sth->execute("%$search%","%$search%");
1141         my $results = $sth->fetchall_arrayref({});
1142         $sth->finish;
1143         return $results;
1144     }
1145 }
1146
1147 #------------------------------------------------------------#
1148
1149 =head3 DelOrder
1150
1151 =over 4
1152
1153 &DelOrder($biblionumber, $ordernumber);
1154
1155 Cancel the order with the given order and biblio numbers. It does not
1156 delete any entries in the aqorders table, it merely marks them as
1157 cancelled.
1158
1159 =back
1160
1161 =cut
1162
1163 sub DelOrder {
1164     my ( $bibnum, $ordnum ) = @_;
1165     my $dbh = C4::Context->dbh;
1166     my $query = "
1167         UPDATE aqorders
1168         SET    datecancellationprinted=now()
1169         WHERE  biblionumber=? AND ordernumber=?
1170     ";
1171     my $sth = $dbh->prepare($query);
1172     $sth->execute( $bibnum, $ordnum );
1173     $sth->finish;
1174 }
1175
1176 =head2 FUNCTIONS ABOUT PARCELS
1177
1178 =cut
1179
1180 #------------------------------------------------------------#
1181
1182 =head3 GetParcel
1183
1184 =over 4
1185
1186 @results = &GetParcel($booksellerid, $code, $date);
1187
1188 Looks up all of the received items from the supplier with the given
1189 bookseller ID at the given date, for the given code (bookseller Invoice number). Ignores cancelled and completed orders.
1190
1191 C<@results> is an array of references-to-hash. The keys of each element are fields from
1192 the aqorders, biblio, and biblioitems tables of the Koha database.
1193
1194 C<@results> is sorted alphabetically by book title.
1195
1196 =back
1197
1198 =cut
1199
1200 sub GetParcel {
1201     #gets all orders from a certain supplier, orders them alphabetically
1202     my ( $supplierid, $code, $datereceived ) = @_;
1203     my $dbh     = C4::Context->dbh;
1204     my @results = ();
1205     $code .= '%'
1206       if $code;  # add % if we search on a given code (otherwise, let him empty)
1207     my $strsth ="
1208         SELECT  authorisedby,
1209                 creationdate,
1210                 aqbasket.basketno,
1211                 closedate,surname,
1212                 firstname,
1213                 aqorders.biblionumber,
1214                 aqorders.ordernumber,
1215                 aqorders.quantity,
1216                 aqorders.quantityreceived,
1217                 aqorders.unitprice,
1218                 aqorders.listprice,
1219                 aqorders.rrp,
1220                 aqorders.ecost,
1221                 biblio.title
1222         FROM aqorders
1223         LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
1224         LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
1225         LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1226         WHERE
1227             aqbasket.booksellerid = ?
1228             AND aqorders.booksellerinvoicenumber LIKE ?
1229             AND aqorders.datereceived = ? ";
1230
1231     my @query_params = ( $supplierid, $code, $datereceived );
1232     if ( C4::Context->preference("IndependantBranches") ) {
1233         my $userenv = C4::Context->userenv;
1234         if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
1235             $strsth .= " and (borrowers.branchcode = ?
1236                           or borrowers.branchcode  = '')";
1237             push @query_params, $userenv->{branch};
1238         }
1239     }
1240     $strsth .= " ORDER BY aqbasket.basketno";
1241     # ## parcelinformation : $strsth
1242     my $sth = $dbh->prepare($strsth);
1243     $sth->execute( @query_params );
1244     while ( my $data = $sth->fetchrow_hashref ) {
1245         push( @results, $data );
1246     }
1247     # ## countparcelbiblio: scalar(@results)
1248     $sth->finish;
1249
1250     return @results;
1251 }
1252
1253 #------------------------------------------------------------#
1254
1255 =head3 GetParcels
1256
1257 =over 4
1258
1259 $results = &GetParcels($bookseller, $order, $code, $datefrom, $dateto);
1260 get a lists of parcels.
1261
1262 =back
1263
1264 * Input arg :
1265
1266 =over 4
1267
1268 =item $bookseller
1269 is the bookseller this function has to get parcels.
1270
1271 =item $order
1272 To know on what criteria the results list has to be ordered.
1273
1274 =item $code
1275 is the booksellerinvoicenumber.
1276
1277 =item $datefrom & $dateto
1278 to know on what date this function has to filter its search.
1279
1280 * return:
1281 a pointer on a hash list containing parcel informations as such :
1282
1283 =item Creation date
1284
1285 =item Last operation
1286
1287 =item Number of biblio
1288
1289 =item Number of items
1290
1291 =back
1292
1293 =cut
1294
1295 sub GetParcels {
1296     my ($bookseller,$order, $code, $datefrom, $dateto) = @_;
1297     my $dbh    = C4::Context->dbh;
1298     my @query_params = ();
1299     my $strsth ="
1300         SELECT  aqorders.booksellerinvoicenumber,
1301                 datereceived,purchaseordernumber,
1302                 count(DISTINCT biblionumber) AS biblio,
1303                 sum(quantity) AS itemsexpected,
1304                 sum(quantityreceived) AS itemsreceived
1305         FROM   aqorders LEFT JOIN aqbasket ON aqbasket.basketno = aqorders.basketno
1306         WHERE aqbasket.booksellerid = $bookseller and datereceived IS NOT NULL
1307     ";
1308
1309     if ( defined $code ) {
1310         $strsth .= ' and aqorders.booksellerinvoicenumber like ? ';
1311         # add a % to the end of the code to allow stemming.
1312         push @query_params, "$code%";
1313     }
1314
1315     if ( defined $datefrom ) {
1316         $strsth .= ' and datereceived >= ? ';
1317         push @query_params, $datefrom;
1318     }
1319
1320     if ( defined $dateto ) {
1321         $strsth .=  'and datereceived <= ? ';
1322         push @query_params, $dateto;
1323     }
1324
1325     $strsth .= "group by aqorders.booksellerinvoicenumber,datereceived ";
1326
1327     # can't use a placeholder to place this column name.
1328     # but, we could probably be checking to make sure it is a column that will be fetched.
1329     $strsth .= "order by $order " if ($order);
1330
1331     my $sth = $dbh->prepare($strsth);
1332
1333     $sth->execute( @query_params );
1334     my $results = $sth->fetchall_arrayref({});
1335     $sth->finish;
1336     return @$results;
1337 }
1338
1339 #------------------------------------------------------------#
1340
1341 =head3 GetLateOrders
1342
1343 =over 4
1344
1345 @results = &GetLateOrders;
1346
1347 Searches for bookseller with late orders.
1348
1349 return:
1350 the table of supplier with late issues. This table is full of hashref.
1351
1352 =back
1353
1354 =cut
1355
1356 sub GetLateOrders {
1357     my $delay      = shift;
1358     my $supplierid = shift;
1359     my $branch     = shift;
1360
1361     my $dbh = C4::Context->dbh;
1362
1363     #BEWARE, order of parenthesis and LEFT JOIN is important for speed
1364     my $dbdriver = C4::Context->config("db_scheme") || "mysql";
1365
1366     my @query_params = ($delay);        # delay is the first argument regardless
1367         my $select = "
1368       SELECT aqbasket.basketno,
1369           aqorders.ordernumber,
1370           DATE(aqbasket.closedate)  AS orderdate,
1371           aqorders.rrp              AS unitpricesupplier,
1372           aqorders.ecost            AS unitpricelib,
1373           aqbudgets.budget_name     AS budget,
1374           borrowers.branchcode      AS branch,
1375           aqbooksellers.name        AS supplier,
1376           biblio.author,
1377           biblioitems.publishercode AS publisher,
1378           biblioitems.publicationyear,
1379         ";
1380         my $from = "
1381       FROM (((
1382           (aqorders LEFT JOIN biblio     ON biblio.biblionumber         = aqorders.biblionumber)
1383           LEFT JOIN biblioitems          ON biblioitems.biblionumber    = biblio.biblionumber)
1384           LEFT JOIN aqbudgets            ON aqorders.budget_id          = aqbudgets.budget_id),
1385           (aqbasket LEFT JOIN borrowers  ON aqbasket.authorisedby       = borrowers.borrowernumber)
1386           LEFT JOIN aqbooksellers        ON aqbasket.booksellerid       = aqbooksellers.id
1387           WHERE aqorders.basketno = aqbasket.basketno
1388           AND ( (datereceived = '' OR datereceived IS NULL)
1389               OR (aqorders.quantityreceived < aqorders.quantity)
1390           )
1391     ";
1392         my $having = "";
1393     if ($dbdriver eq "mysql") {
1394                 $select .= "
1395            aqorders.quantity - IFNULL(aqorders.quantityreceived,0)                 AS quantity,
1396           (aqorders.quantity - IFNULL(aqorders.quantityreceived,0)) * aqorders.rrp AS subtotal,
1397           DATEDIFF(CURDATE( ),closedate) AS latesince
1398                 ";
1399         $from .= " AND (closedate <= DATE_SUB(CURDATE( ),INTERVAL ? DAY)) ";
1400                 $having = "
1401          HAVING quantity          <> 0
1402             AND unitpricesupplier <> 0
1403             AND unitpricelib      <> 0
1404                 ";
1405     } else {
1406                 # FIXME: account for IFNULL as above
1407         $select .= "
1408                 aqorders.quantity                AS quantity,
1409                 aqorders.quantity * aqorders.rrp AS subtotal,
1410                 (CURDATE - closedate)            AS latesince
1411                 ";
1412         $from .= " AND (closedate <= (CURDATE -(INTERVAL ? DAY)) ";
1413     }
1414     if (defined $supplierid) {
1415                 $from .= ' AND aqbasket.booksellerid = ? ';
1416         push @query_params, $supplierid;
1417     }
1418     if (defined $branch) {
1419         $from .= ' AND borrowers.branchcode LIKE ? ';
1420         push @query_params, $branch;
1421     }
1422     if (C4::Context->preference("IndependantBranches")
1423              && C4::Context->userenv
1424              && C4::Context->userenv->{flags} != 1 ) {
1425         $from .= ' AND borrowers.branchcode LIKE ? ';
1426         push @query_params, C4::Context->userenv->{branch};
1427     }
1428         my $query = "$select $from $having\nORDER BY latesince, basketno, borrowers.branchcode, supplier";
1429         $debug and print STDERR "GetLateOrders query: $query\nGetLateOrders args: " . join(" ",@query_params);
1430     my $sth = $dbh->prepare($query);
1431     $sth->execute(@query_params);
1432     my @results;
1433     while (my $data = $sth->fetchrow_hashref) {
1434         $data->{orderdate} = format_date($data->{orderdate});
1435         push @results, $data;
1436     }
1437     return @results;
1438 }
1439
1440 #------------------------------------------------------------#
1441
1442 =head3 GetHistory
1443
1444 =over 4
1445
1446 (\@order_loop, $total_qty, $total_price, $total_qtyreceived) = GetHistory( $title, $author, $name, $from_placed_on, $to_placed_on );
1447
1448   Retreives some acquisition history information
1449
1450   returns:
1451     $order_loop is a list of hashrefs that each look like this:
1452               {
1453                 'author'           => 'Twain, Mark',
1454                 'basketno'         => '1',
1455                 'biblionumber'     => '215',
1456                 'count'            => 1,
1457                 'creationdate'     => 'MM/DD/YYYY',
1458                 'datereceived'     => undef,
1459                 'ecost'            => '1.00',
1460                 'id'               => '1',
1461                 'invoicenumber'    => undef,
1462                 'name'             => '',
1463                 'ordernumber'      => '1',
1464                 'quantity'         => 1,
1465                 'quantityreceived' => undef,
1466                 'title'            => 'The Adventures of Huckleberry Finn'
1467               }
1468     $total_qty is the sum of all of the quantities in $order_loop
1469     $total_price is the cost of each in $order_loop times the quantity
1470     $total_qtyreceived is the sum of all of the quantityreceived entries in $order_loop
1471
1472 =back
1473
1474 =cut
1475
1476 sub GetHistory {
1477     my ( $title, $author, $name, $from_placed_on, $to_placed_on ) = @_;
1478     my @order_loop;
1479     my $total_qty         = 0;
1480     my $total_qtyreceived = 0;
1481     my $total_price       = 0;
1482
1483 # don't run the query if there are no parameters (list would be too long for sure !)
1484     if ( $title || $author || $name || $from_placed_on || $to_placed_on ) {
1485         my $dbh   = C4::Context->dbh;
1486         my $query ="
1487             SELECT
1488                 biblio.title,
1489                 biblio.author,
1490                 aqorders.basketno,
1491                 name,aqbasket.creationdate,
1492                 aqorders.datereceived,
1493                 aqorders.quantity,
1494                 aqorders.quantityreceived,
1495                 aqorders.ecost,
1496                 aqorders.ordernumber,
1497                 aqorders.booksellerinvoicenumber as invoicenumber,
1498                 aqbooksellers.id as id,
1499                 aqorders.biblionumber
1500             FROM aqorders
1501             LEFT JOIN aqbasket ON aqorders.basketno=aqbasket.basketno
1502             LEFT JOIN aqbooksellers ON aqbasket.booksellerid=aqbooksellers.id
1503             LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber";
1504
1505         $query .= " LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber"
1506           if ( C4::Context->preference("IndependantBranches") );
1507
1508         $query .= " WHERE (datecancellationprinted is NULL or datecancellationprinted='0000-00-00') ";
1509
1510         my @query_params  = ();
1511
1512         if ( defined $title ) {
1513             $query .= " AND biblio.title LIKE ? ";
1514             push @query_params, "%$title%";
1515         }
1516
1517         if ( defined $author ) {
1518             $query .= " AND biblio.author LIKE ? ";
1519             push @query_params, "%$author%";
1520         }
1521
1522         if ( defined $name ) {
1523             $query .= " AND name LIKE ? ";
1524             push @query_params, "%$name%";
1525         }
1526
1527         if ( defined $from_placed_on ) {
1528             $query .= " AND creationdate >= ? ";
1529             push @query_params, $from_placed_on;
1530         }
1531
1532         if ( defined $to_placed_on ) {
1533             $query .= " AND creationdate <= ? ";
1534             push @query_params, $to_placed_on;
1535         }
1536
1537         if ( C4::Context->preference("IndependantBranches") ) {
1538             my $userenv = C4::Context->userenv;
1539             if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
1540                 $query .= " AND (borrowers.branchcode = ? OR borrowers.branchcode ='' ) ";
1541                 push @query_params, $userenv->{branch};
1542             }
1543         }
1544         $query .= " ORDER BY booksellerid";
1545         my $sth = $dbh->prepare($query);
1546         $sth->execute( @query_params );
1547         my $cnt = 1;
1548         while ( my $line = $sth->fetchrow_hashref ) {
1549             $line->{count} = $cnt++;
1550             $line->{toggle} = 1 if $cnt % 2;
1551             push @order_loop, $line;
1552             $line->{creationdate} = format_date( $line->{creationdate} );
1553             $line->{datereceived} = format_date( $line->{datereceived} );
1554             $total_qty         += $line->{'quantity'};
1555             $total_qtyreceived += $line->{'quantityreceived'};
1556             $total_price       += $line->{'quantity'} * $line->{'ecost'};
1557         }
1558     }
1559     return \@order_loop, $total_qty, $total_price, $total_qtyreceived;
1560 }
1561
1562 =head2 GetRecentAcqui
1563
1564    $results = GetRecentAcqui($days);
1565
1566    C<$results> is a ref to a table which containts hashref
1567
1568 =cut
1569
1570 sub GetRecentAcqui {
1571     my $limit  = shift;
1572     my $dbh    = C4::Context->dbh;
1573     my $query = "
1574         SELECT *
1575         FROM   biblio
1576         ORDER BY timestamp DESC
1577         LIMIT  0,".$limit;
1578
1579     my $sth = $dbh->prepare($query);
1580     $sth->execute;
1581     my $results = $sth->fetchall_arrayref({});
1582     return $results;
1583 }
1584
1585 =head3 GetContracts
1586
1587 =over 4
1588
1589 $contractlist = &GetContracts($booksellerid, $activeonly);
1590
1591 Looks up the contracts that belong to a bookseller
1592
1593 Returns a list of contracts
1594
1595 =item C<$booksellerid> is the "id" field in the "aqbooksellers" table.
1596
1597 =item C<$activeonly> if exists get only contracts that are still active.
1598
1599 =back
1600
1601 =cut
1602 sub GetContracts {
1603     my ( $booksellerid, $activeonly ) = @_;
1604     my $dbh = C4::Context->dbh;
1605     my $query;
1606     if (! $activeonly) {
1607         $query = "
1608             SELECT *
1609             FROM   aqcontract
1610             WHERE  booksellerid=?
1611         ";
1612     } else {
1613         $query = "SELECT *
1614             FROM aqcontract
1615             WHERE booksellerid=?
1616                 AND contractenddate >= CURDATE( )";
1617     }
1618     my $sth = $dbh->prepare($query);
1619     $sth->execute( $booksellerid );
1620     my @results;
1621     while (my $data = $sth->fetchrow_hashref ) {
1622         push(@results, $data);
1623     }
1624     $sth->finish;
1625     return @results;
1626 }
1627
1628 #------------------------------------------------------------#
1629
1630 =head3 GetContract
1631
1632 =over 4
1633
1634 $contract = &GetContract($contractID);
1635
1636 Looks up the contract that has PRIMKEY (contractnumber) value $contractID
1637
1638 Returns a contract
1639
1640 =back
1641
1642 =cut
1643 sub GetContract {
1644     my ( $contractno ) = @_;
1645     my $dbh = C4::Context->dbh;
1646     my $query = "
1647         SELECT *
1648         FROM   aqcontract
1649         WHERE  contractnumber=?
1650         ";
1651
1652     my $sth = $dbh->prepare($query);
1653     $sth->execute( $contractno );
1654     my $result = $sth->fetchrow_hashref;
1655     return $result;
1656 }
1657
1658 1;
1659 __END__
1660
1661 =head1 AUTHOR
1662
1663 Koha Developement team <info@koha.org>
1664
1665 =cut