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