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