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

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