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 UpdateInTable);
  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 &ReopenBasket &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 &GetOrder &GetOrders &GetOrdersByBiblionumber
  57         &GetLateOrders &GetOrderFromItemnumber
  58         &SearchOrders &GetHistory &GetRecentAcqui
  59         &ModReceiveOrder &CancelReceipt
  60         &GetCancelledOrders &TransferOrder
  61         &GetLastOrderNotReceivedFromSubscriptionid &GetLastOrderReceivedFromSubscriptionid
  62         &NewOrderItem &ModItemOrder
  63
  64         &GetParcels &GetParcel
  65         &GetContracts &GetContract
  66
  67         &GetInvoices
  68         &GetInvoice
  69         &GetInvoiceDetails
  70         &AddInvoice
  71         &ModInvoice
  72         &CloseInvoice
  73         &ReopenInvoice
  74         &DelInvoice
  75         &MergeInvoices
  76
  77         &GetItemnumbersFromOrder
  78
  79         &AddClaim
  80         &GetBiblioCountByBasketno
  81     );
  82 }
  83
  84
  85
  86
  87
  88 sub GetOrderFromItemnumber {
  89     my ($itemnumber) = @_;
  90     my $dbh          = C4::Context->dbh;
  91     my $query        = qq|
  92
  93     SELECT  * from aqorders    LEFT JOIN aqorders_items
  94     ON (     aqorders.ordernumber = aqorders_items.ordernumber   )
  95     WHERE itemnumber = ?  |;
  96
  97     my $sth = $dbh->prepare($query);
  98
  99 #    $sth->trace(3);
 100
 101     $sth->execute($itemnumber);
 102
 103     my $order = $sth->fetchrow_hashref;
 104     return ( $order  );
 105
 106 }
 107
 108 # Returns the itemnumber(s) associated with the ordernumber given in parameter
 109 sub GetItemnumbersFromOrder {
 110     my ($ordernumber) = @_;
 111     my $dbh          = C4::Context->dbh;
 112     my $query        = "SELECT itemnumber FROM aqorders_items WHERE ordernumber=?";
 113     my $sth = $dbh->prepare($query);
 114     $sth->execute($ordernumber);
 115     my @tab;
 116
 117     while (my $order = $sth->fetchrow_hashref) {
 118     push @tab, $order->{'itemnumber'};
 119     }
 120
 121     return @tab;
 122
 123 }
 124
 125
 126
 127
 128
 129
 130 =head1 NAME
 131
 132 C4::Acquisition - Koha functions for dealing with orders and acquisitions
 133
 134 =head1 SYNOPSIS
 135
 136 use C4::Acquisition;
 137
 138 =head1 DESCRIPTION
 139
 140 The functions in this module deal with acquisitions, managing book
 141 orders, basket and parcels.
 142
 143 =head1 FUNCTIONS
 144
 145 =head2 FUNCTIONS ABOUT BASKETS
 146
 147 =head3 GetBasket
 148
 149   $aqbasket = &GetBasket($basketnumber);
 150
 151 get all basket informations in aqbasket for a given basket
 152
 153 B<returns:> informations for a given basket returned as a hashref.
 154
 155 =cut
 156
 157 sub GetBasket {
 158     my ($basketno) = @_;
 159     my $dbh        = C4::Context->dbh;
 160     my $query = "
 161         SELECT  aqbasket.*,
 162                 concat( b.firstname,' ',b.surname) AS authorisedbyname,
 163                 b.branchcode AS branch
 164         FROM    aqbasket
 165         LEFT JOIN borrowers b ON aqbasket.authorisedby=b.borrowernumber
 166         WHERE basketno=?
 167     ";
 168     my $sth=$dbh->prepare($query);
 169     $sth->execute($basketno);
 170     my $basket = $sth->fetchrow_hashref;
 171     return ( $basket );
 172 }
 173
 174 #------------------------------------------------------------#
 175
 176 =head3 NewBasket
 177
 178   $basket = &NewBasket( $booksellerid, $authorizedby, $basketname,
 179       $basketnote, $basketbooksellernote, $basketcontractnumber, $deliveryplace, $billingplace );
 180
 181 Create a new basket in aqbasket table
 182
 183 =over
 184
 185 =item C<$booksellerid> is a foreign key in the aqbasket table
 186
 187 =item C<$authorizedby> is the username of who created the basket
 188
 189 =back
 190
 191 The other parameters are optional, see ModBasketHeader for more info on them.
 192
 193 =cut
 194
 195 sub NewBasket {
 196     my ( $booksellerid, $authorisedby, $basketname, $basketnote,
 197         $basketbooksellernote, $basketcontractnumber, $deliveryplace,
 198         $billingplace ) = @_;
 199     my $dbh = C4::Context->dbh;
 200     my $query =
 201         'INSERT INTO aqbasket (creationdate,booksellerid,authorisedby) '
 202       . 'VALUES  (now(),?,?)';
 203     $dbh->do( $query, {}, $booksellerid, $authorisedby );
 204
 205     my $basket = $dbh->{mysql_insertid};
 206     $basketname           ||= q{}; # default to empty strings
 207     $basketnote           ||= q{};
 208     $basketbooksellernote ||= q{};
 209     ModBasketHeader( $basket, $basketname, $basketnote, $basketbooksellernote,
 210         $basketcontractnumber, $booksellerid, $deliveryplace, $billingplace );
 211     return $basket;
 212 }
 213
 214 #------------------------------------------------------------#
 215
 216 =head3 CloseBasket
 217
 218   &CloseBasket($basketno);
 219
 220 close a basket (becomes unmodifiable, except for receives)
 221
 222 =cut
 223
 224 sub CloseBasket {
 225     my ($basketno) = @_;
 226     my $dbh        = C4::Context->dbh;
 227     my $query = "
 228         UPDATE aqbasket
 229         SET    closedate=now()
 230         WHERE  basketno=?
 231     ";
 232     my $sth = $dbh->prepare($query);
 233     $sth->execute($basketno);
 234
 235     my @orders = GetOrders($basketno);
 236     foreach my $order (@orders) {
 237         $query = qq{
 238             UPDATE aqorders
 239             SET orderstatus = 'ordered'
 240             WHERE ordernumber = ?;
 241         };
 242         $sth = $dbh->prepare($query);
 243         $sth->execute($order->{'ordernumber'});
 244     }
 245 }
 246
 247 =head3 ReopenBasket
 248
 249   &ReopenBasket($basketno);
 250
 251 reopen a basket
 252
 253 =cut
 254
 255 sub ReopenBasket {
 256     my ($basketno) = @_;
 257     my $dbh        = C4::Context->dbh;
 258     my $query = "
 259         UPDATE aqbasket
 260         SET    closedate=NULL
 261         WHERE  basketno=?
 262     ";
 263     my $sth = $dbh->prepare($query);
 264     $sth->execute($basketno);
 265
 266     my @orders = GetOrders($basketno);
 267     foreach my $order (@orders) {
 268         $query = qq{
 269             UPDATE aqorders
 270             SET orderstatus = 'new'
 271             WHERE ordernumber = ?;
 272         };
 273         $sth = $dbh->prepare($query);
 274         $sth->execute($order->{'ordernumber'});
 275     }
 276 }
 277
 278 #------------------------------------------------------------#
 279
 280 =head3 GetBasketAsCSV
 281
 282   &GetBasketAsCSV($basketno);
 283
 284 Export a basket as CSV
 285
 286 $cgi parameter is needed for column name translation
 287
 288 =cut
 289
 290 sub GetBasketAsCSV {
 291     my ($basketno, $cgi) = @_;
 292     my $basket = GetBasket($basketno);
 293     my @orders = GetOrders($basketno);
 294     my $contract = GetContract($basket->{'contractnumber'});
 295
 296     my $template = C4::Templates::gettemplate("acqui/csv/basket.tmpl", "intranet", $cgi);
 297
 298     my @rows;
 299     foreach my $order (@orders) {
 300         my $bd = GetBiblioData( $order->{'biblionumber'} );
 301         my $row = {
 302             contractname => $contract->{'contractname'},
 303             ordernumber => $order->{'ordernumber'},
 304             entrydate => $order->{'entrydate'},
 305             isbn => $order->{'isbn'},
 306             author => $bd->{'author'},
 307             title => $bd->{'title'},
 308             publicationyear => $bd->{'publicationyear'},
 309             publishercode => $bd->{'publishercode'},
 310             collectiontitle => $bd->{'collectiontitle'},
 311             notes => $order->{'notes'},
 312             quantity => $order->{'quantity'},
 313             rrp => $order->{'rrp'},
 314             deliveryplace => C4::Branch::GetBranchName( $basket->{'deliveryplace'} ),
 315             billingplace => C4::Branch::GetBranchName( $basket->{'billingplace'} ),
 316         };
 317         foreach(qw(
 318             contractname author title publishercode collectiontitle notes
 319             deliveryplace billingplace
 320         ) ) {
 321             # Double the quotes to not be interpreted as a field end
 322             $row->{$_} =~ s/"/""/g if $row->{$_};
 323         }
 324         push @rows, $row;
 325     }
 326
 327     @rows = sort {
 328         if(defined $a->{publishercode} and defined $b->{publishercode}) {
 329             $a->{publishercode} cmp $b->{publishercode};
 330         }
 331     } @rows;
 332
 333     $template->param(rows => \@rows);
 334
 335     return $template->output;
 336 }
 337
 338
 339 =head3 GetBasketGroupAsCSV
 340
 341 =over 4
 342
 343 &GetBasketGroupAsCSV($basketgroupid);
 344
 345 Export a basket group as CSV
 346
 347 $cgi parameter is needed for column name translation
 348
 349 =back
 350
 351 =cut
 352
 353 sub GetBasketGroupAsCSV {
 354     my ($basketgroupid, $cgi) = @_;
 355     my $baskets = GetBasketsByBasketgroup($basketgroupid);
 356
 357     my $template = C4::Templates::gettemplate('acqui/csv/basketgroup.tmpl', 'intranet', $cgi);
 358
 359     my @rows;
 360     for my $basket (@$baskets) {
 361         my @orders     = GetOrders( $$basket{basketno} );
 362         my $contract   = GetContract( $$basket{contractnumber} );
 363         my $bookseller = GetBookSellerFromId( $$basket{booksellerid} );
 364         my $basketgroup = GetBasketgroup( $$basket{basketgroupid} );
 365
 366         foreach my $order (@orders) {
 367             my $bd = GetBiblioData( $order->{'biblionumber'} );
 368             my $row = {
 369                 clientnumber => $bookseller->{accountnumber},
 370                 basketname => $basket->{basketname},
 371                 ordernumber => $order->{ordernumber},
 372                 author => $bd->{author},
 373                 title => $bd->{title},
 374                 publishercode => $bd->{publishercode},
 375                 publicationyear => $bd->{publicationyear},
 376                 collectiontitle => $bd->{collectiontitle},
 377                 isbn => $order->{isbn},
 378                 quantity => $order->{quantity},
 379                 rrp => $order->{rrp},
 380                 discount => $bookseller->{discount},
 381                 ecost => $order->{ecost},
 382                 notes => $order->{notes},
 383                 entrydate => $order->{entrydate},
 384                 booksellername => $bookseller->{name},
 385                 bookselleraddress => $bookseller->{address1},
 386                 booksellerpostal => $bookseller->{postal},
 387                 contractnumber => $contract->{contractnumber},
 388                 contractname => $contract->{contractname},
 389                 basketgroupdeliveryplace => C4::Branch::GetBranchName( $basketgroup->{deliveryplace} ),
 390                 basketgroupbillingplace => C4::Branch::GetBranchName( $basketgroup->{billingplace} ),
 391                 basketdeliveryplace => C4::Branch::GetBranchName( $basket->{deliveryplace} ),
 392                 basketbillingplace => C4::Branch::GetBranchName( $basket->{billingplace} ),
 393             };
 394             foreach(qw(
 395                 basketname author title publishercode collectiontitle notes
 396                 booksellername bookselleraddress booksellerpostal contractname
 397                 basketgroupdeliveryplace basketgroupbillingplace
 398                 basketdeliveryplace basketbillingplace
 399             ) ) {
 400                 # Double the quotes to not be interpreted as a field end
 401                 $row->{$_} =~ s/"/""/g if $row->{$_};
 402             }
 403             push @rows, $row;
 404          }
 405      }
 406     $template->param(rows => \@rows);
 407
 408     return $template->output;
 409
 410 }
 411
 412 =head3 CloseBasketgroup
 413
 414   &CloseBasketgroup($basketgroupno);
 415
 416 close a basketgroup
 417
 418 =cut
 419
 420 sub CloseBasketgroup {
 421     my ($basketgroupno) = @_;
 422     my $dbh        = C4::Context->dbh;
 423     my $sth = $dbh->prepare("
 424         UPDATE aqbasketgroups
 425         SET    closed=1
 426         WHERE  id=?
 427     ");
 428     $sth->execute($basketgroupno);
 429 }
 430
 431 #------------------------------------------------------------#
 432
 433 =head3 ReOpenBaskergroup($basketgroupno)
 434
 435   &ReOpenBaskergroup($basketgroupno);
 436
 437 reopen a basketgroup
 438
 439 =cut
 440
 441 sub ReOpenBasketgroup {
 442     my ($basketgroupno) = @_;
 443     my $dbh        = C4::Context->dbh;
 444     my $sth = $dbh->prepare("
 445         UPDATE aqbasketgroups
 446         SET    closed=0
 447         WHERE  id=?
 448     ");
 449     $sth->execute($basketgroupno);
 450 }
 451
 452 #------------------------------------------------------------#
 453
 454
 455 =head3 DelBasket
 456
 457   &DelBasket($basketno);
 458
 459 Deletes the basket that has basketno field $basketno in the aqbasket table.
 460
 461 =over
 462
 463 =item C<$basketno> is the primary key of the basket in the aqbasket table.
 464
 465 =back
 466
 467 =cut
 468
 469 sub DelBasket {
 470     my ( $basketno ) = @_;
 471     my $query = "DELETE FROM aqbasket WHERE basketno=?";
 472     my $dbh = C4::Context->dbh;
 473     my $sth = $dbh->prepare($query);
 474     $sth->execute($basketno);
 475     $sth->finish;
 476 }
 477
 478 #------------------------------------------------------------#
 479
 480 =head3 ModBasket
 481
 482   &ModBasket($basketinfo);
 483
 484 Modifies a basket, using a hashref $basketinfo for the relevant information, only $basketinfo->{'basketno'} is required.
 485
 486 =over
 487
 488 =item C<$basketno> is the primary key of the basket in the aqbasket table.
 489
 490 =back
 491
 492 =cut
 493
 494 sub ModBasket {
 495     my $basketinfo = shift;
 496     my $query = "UPDATE aqbasket SET ";
 497     my @params;
 498     foreach my $key (keys %$basketinfo){
 499         if ($key ne 'basketno'){
 500             $query .= "$key=?, ";
 501             push(@params, $basketinfo->{$key} || undef );
 502         }
 503     }
 504 # get rid of the "," at the end of $query
 505     if (substr($query, length($query)-2) eq ', '){
 506         chop($query);
 507         chop($query);
 508         $query .= ' ';
 509     }
 510     $query .= "WHERE basketno=?";
 511     push(@params, $basketinfo->{'basketno'});
 512     my $dbh = C4::Context->dbh;
 513     my $sth = $dbh->prepare($query);
 514     $sth->execute(@params);
 515
 516     $sth->finish;
 517 }
 518
 519 #------------------------------------------------------------#
 520
 521 =head3 ModBasketHeader
 522
 523   &ModBasketHeader($basketno, $basketname, $note, $booksellernote, $contractnumber, $booksellerid);
 524
 525 Modifies a basket's header.
 526
 527 =over
 528
 529 =item C<$basketno> is the "basketno" field in the "aqbasket" table;
 530
 531 =item C<$basketname> is the "basketname" field in the "aqbasket" table;
 532
 533 =item C<$note> is the "note" field in the "aqbasket" table;
 534
 535 =item C<$booksellernote> is the "booksellernote" field in the "aqbasket" table;
 536
 537 =item C<$contractnumber> is the "contractnumber" (foreign) key in the "aqbasket" table.
 538
 539 =item C<$booksellerid> is the id (foreign) key in the "aqbooksellers" table for the vendor.
 540
 541 =item C<$deliveryplace> is the "deliveryplace" field in the aqbasket table.
 542
 543 =item C<$billingplace> is the "billingplace" field in the aqbasket table.
 544
 545 =back
 546
 547 =cut
 548
 549 sub ModBasketHeader {
 550     my ($basketno, $basketname, $note, $booksellernote, $contractnumber, $booksellerid, $deliveryplace, $billingplace) = @_;
 551     my $query = qq{
 552         UPDATE aqbasket
 553         SET basketname=?, note=?, booksellernote=?, booksellerid=?, deliveryplace=?, billingplace=?
 554         WHERE basketno=?
 555     };
 556
 557     my $dbh = C4::Context->dbh;
 558     my $sth = $dbh->prepare($query);
 559     $sth->execute($basketname, $note, $booksellernote, $booksellerid, $deliveryplace, $billingplace, $basketno);
 560
 561     if ( $contractnumber ) {
 562         my $query2 ="UPDATE aqbasket SET contractnumber=? WHERE basketno=?";
 563         my $sth2 = $dbh->prepare($query2);
 564         $sth2->execute($contractnumber,$basketno);
 565         $sth2->finish;
 566     }
 567     $sth->finish;
 568 }
 569
 570 #------------------------------------------------------------#
 571
 572 =head3 GetBasketsByBookseller
 573
 574   @results = &GetBasketsByBookseller($booksellerid, $extra);
 575
 576 Returns a list of hashes of all the baskets that belong to bookseller 'booksellerid'.
 577
 578 =over
 579
 580 =item C<$booksellerid> is the 'id' field of the bookseller in the aqbooksellers table
 581
 582 =item C<$extra> is the extra sql parameters, can be
 583
 584  $extra->{groupby}: group baskets by column
 585     ex. $extra->{groupby} = aqbasket.basketgroupid
 586  $extra->{orderby}: order baskets by column
 587  $extra->{limit}: limit number of results (can be helpful for pagination)
 588
 589 =back
 590
 591 =cut
 592
 593 sub GetBasketsByBookseller {
 594     my ($booksellerid, $extra) = @_;
 595     my $query = "SELECT * FROM aqbasket WHERE booksellerid=?";
 596     if ($extra){
 597         if ($extra->{groupby}) {
 598             $query .= " GROUP by $extra->{groupby}";
 599         }
 600         if ($extra->{orderby}){
 601             $query .= " ORDER by $extra->{orderby}";
 602         }
 603         if ($extra->{limit}){
 604             $query .= " LIMIT $extra->{limit}";
 605         }
 606     }
 607     my $dbh = C4::Context->dbh;
 608     my $sth = $dbh->prepare($query);
 609     $sth->execute($booksellerid);
 610     my $results = $sth->fetchall_arrayref({});
 611     $sth->finish;
 612     return $results
 613 }
 614
 615 =head3 GetBasketsInfosByBookseller
 616
 617     my $baskets = GetBasketsInfosByBookseller($supplierid, $allbaskets);
 618
 619 The optional second parameter allbaskets is a boolean allowing you to
 620 select all baskets from the supplier; by default only active baskets (open or
 621 closed but still something to receive) are returned.
 622
 623 Returns in a arrayref of hashref all about booksellers baskets, plus:
 624     total_biblios: Number of distinct biblios in basket
 625     total_items: Number of items in basket
 626     expected_items: Number of non-received items in basket
 627
 628 =cut
 629
 630 sub GetBasketsInfosByBookseller {
 631     my ($supplierid, $allbaskets) = @_;
 632
 633     return unless $supplierid;
 634
 635     my $dbh = C4::Context->dbh;
 636     my $query = qq{
 637         SELECT aqbasket.*,
 638           SUM(aqorders.quantity) AS total_items,
 639           COUNT(DISTINCT aqorders.biblionumber) AS total_biblios,
 640           SUM(
 641             IF(aqorders.datereceived IS NULL
 642               AND aqorders.datecancellationprinted IS NULL
 643             , aqorders.quantity
 644             , 0)
 645           ) AS expected_items
 646         FROM aqbasket
 647           LEFT JOIN aqorders ON aqorders.basketno = aqbasket.basketno
 648         WHERE booksellerid = ?};
 649     if(!$allbaskets) {
 650         $query.=" AND (closedate IS NULL OR (aqorders.quantity > aqorders.quantityreceived AND datecancellationprinted IS NULL))";
 651     }
 652     $query.=" GROUP BY aqbasket.basketno";
 653
 654     my $sth = $dbh->prepare($query);
 655     $sth->execute($supplierid);
 656     return $sth->fetchall_arrayref({});
 657 }
 658
 659
 660 #------------------------------------------------------------#
 661
 662 =head3 GetBasketsByBasketgroup
 663
 664   $baskets = &GetBasketsByBasketgroup($basketgroupid);
 665
 666 Returns a reference to all baskets that belong to basketgroup $basketgroupid.
 667
 668 =cut
 669
 670 sub GetBasketsByBasketgroup {
 671     my $basketgroupid = shift;
 672     my $query = qq{
 673         SELECT *, aqbasket.booksellerid as booksellerid
 674         FROM aqbasket
 675         LEFT JOIN aqcontract USING(contractnumber) WHERE basketgroupid=?
 676     };
 677     my $dbh = C4::Context->dbh;
 678     my $sth = $dbh->prepare($query);
 679     $sth->execute($basketgroupid);
 680     my $results = $sth->fetchall_arrayref({});
 681     $sth->finish;
 682     return $results
 683 }
 684
 685 #------------------------------------------------------------#
 686
 687 =head3 NewBasketgroup
 688
 689   $basketgroupid = NewBasketgroup(\%hashref);
 690
 691 Adds a basketgroup to the aqbasketgroups table, and add the initial baskets to it.
 692
 693 $hashref->{'booksellerid'} is the 'id' field of the bookseller in the aqbooksellers table,
 694
 695 $hashref->{'name'} is the 'name' field of the basketgroup in the aqbasketgroups table,
 696
 697 $hashref->{'basketlist'} is a list reference of the 'id's of the baskets that belong to this group,
 698
 699 $hashref->{'billingplace'} is the 'billingplace' field of the basketgroup in the aqbasketgroups table,
 700
 701 $hashref->{'deliveryplace'} is the 'deliveryplace' field of the basketgroup in the aqbasketgroups table,
 702
 703 $hashref->{'freedeliveryplace'} is the 'freedeliveryplace' field of the basketgroup in the aqbasketgroups table,
 704
 705 $hashref->{'deliverycomment'} is the 'deliverycomment' field of the basketgroup in the aqbasketgroups table,
 706
 707 $hashref->{'closed'} is the 'closed' field of the aqbasketgroups table, it is false if 0, true otherwise.
 708
 709 =cut
 710
 711 sub NewBasketgroup {
 712     my $basketgroupinfo = shift;
 713     die "booksellerid is required to create a basketgroup" unless $basketgroupinfo->{'booksellerid'};
 714     my $query = "INSERT INTO aqbasketgroups (";
 715     my @params;
 716     foreach my $field (qw(name billingplace deliveryplace freedeliveryplace deliverycomment closed)) {
 717         if ( defined $basketgroupinfo->{$field} ) {
 718             $query .= "$field, ";
 719             push(@params, $basketgroupinfo->{$field});
 720         }
 721     }
 722     $query .= "booksellerid) VALUES (";
 723     foreach (@params) {
 724         $query .= "?, ";
 725     }
 726     $query .= "?)";
 727     push(@params, $basketgroupinfo->{'booksellerid'});
 728     my $dbh = C4::Context->dbh;
 729     my $sth = $dbh->prepare($query);
 730     $sth->execute(@params);
 731     my $basketgroupid = $dbh->{'mysql_insertid'};
 732     if( $basketgroupinfo->{'basketlist'} ) {
 733         foreach my $basketno (@{$basketgroupinfo->{'basketlist'}}) {
 734             my $query2 = "UPDATE aqbasket SET basketgroupid=? WHERE basketno=?";
 735             my $sth2 = $dbh->prepare($query2);
 736             $sth2->execute($basketgroupid, $basketno);
 737         }
 738     }
 739     return $basketgroupid;
 740 }
 741
 742 #------------------------------------------------------------#
 743
 744 =head3 ModBasketgroup
 745
 746   ModBasketgroup(\%hashref);
 747
 748 Modifies a basketgroup in the aqbasketgroups table, and add the baskets to it.
 749
 750 $hashref->{'id'} is the 'id' field of the basketgroup in the aqbasketgroup table, this parameter is mandatory,
 751
 752 $hashref->{'name'} is the 'name' field of the basketgroup in the aqbasketgroups table,
 753
 754 $hashref->{'basketlist'} is a list reference of the 'id's of the baskets that belong to this group,
 755
 756 $hashref->{'billingplace'} is the 'billingplace' field of the basketgroup in the aqbasketgroups table,
 757
 758 $hashref->{'deliveryplace'} is the 'deliveryplace' field of the basketgroup in the aqbasketgroups table,
 759
 760 $hashref->{'freedeliveryplace'} is the 'freedeliveryplace' field of the basketgroup in the aqbasketgroups table,
 761
 762 $hashref->{'deliverycomment'} is the 'deliverycomment' field of the basketgroup in the aqbasketgroups table,
 763
 764 $hashref->{'closed'} is the 'closed' field of the aqbasketgroups table, it is false if 0, true otherwise.
 765
 766 =cut
 767
 768 sub ModBasketgroup {
 769     my $basketgroupinfo = shift;
 770     die "basketgroup id is required to edit a basketgroup" unless $basketgroupinfo->{'id'};
 771     my $dbh = C4::Context->dbh;
 772     my $query = "UPDATE aqbasketgroups SET ";
 773     my @params;
 774     foreach my $field (qw(name billingplace deliveryplace freedeliveryplace deliverycomment closed)) {
 775         if ( defined $basketgroupinfo->{$field} ) {
 776             $query .= "$field=?, ";
 777             push(@params, $basketgroupinfo->{$field});
 778         }
 779     }
 780     chop($query);
 781     chop($query);
 782     $query .= " WHERE id=?";
 783     push(@params, $basketgroupinfo->{'id'});
 784     my $sth = $dbh->prepare($query);
 785     $sth->execute(@params);
 786
 787     $sth = $dbh->prepare('UPDATE aqbasket SET basketgroupid = NULL WHERE basketgroupid = ?');
 788     $sth->execute($basketgroupinfo->{'id'});
 789
 790     if($basketgroupinfo->{'basketlist'} && @{$basketgroupinfo->{'basketlist'}}){
 791         $sth = $dbh->prepare("UPDATE aqbasket SET basketgroupid=? WHERE basketno=?");
 792         foreach my $basketno (@{$basketgroupinfo->{'basketlist'}}) {
 793             $sth->execute($basketgroupinfo->{'id'}, $basketno);
 794             $sth->finish;
 795         }
 796     }
 797     $sth->finish;
 798 }
 799
 800 #------------------------------------------------------------#
 801
 802 =head3 DelBasketgroup
 803
 804   DelBasketgroup($basketgroupid);
 805
 806 Deletes a basketgroup in the aqbasketgroups table, and removes the reference to it from the baskets,
 807
 808 =over
 809
 810 =item C<$basketgroupid> is the 'id' field of the basket in the aqbasketgroup table
 811
 812 =back
 813
 814 =cut
 815
 816 sub DelBasketgroup {
 817     my $basketgroupid = shift;
 818     die "basketgroup id is required to edit a basketgroup" unless $basketgroupid;
 819     my $query = "DELETE FROM aqbasketgroups WHERE id=?";
 820     my $dbh = C4::Context->dbh;
 821     my $sth = $dbh->prepare($query);
 822     $sth->execute($basketgroupid);
 823     $sth->finish;
 824 }
 825
 826 #------------------------------------------------------------#
 827
 828
 829 =head2 FUNCTIONS ABOUT ORDERS
 830
 831 =head3 GetBasketgroup
 832
 833   $basketgroup = &GetBasketgroup($basketgroupid);
 834
 835 Returns a reference to the hash containing all infermation about the basketgroup.
 836
 837 =cut
 838
 839 sub GetBasketgroup {
 840     my $basketgroupid = shift;
 841     die "basketgroup id is required to edit a basketgroup" unless $basketgroupid;
 842     my $query = "SELECT * FROM aqbasketgroups WHERE id=?";
 843     my $dbh = C4::Context->dbh;
 844     my $sth = $dbh->prepare($query);
 845     $sth->execute($basketgroupid);
 846     my $result = $sth->fetchrow_hashref;
 847     $sth->finish;
 848     return $result
 849 }
 850
 851 #------------------------------------------------------------#
 852
 853 =head3 GetBasketgroups
 854
 855   $basketgroups = &GetBasketgroups($booksellerid);
 856
 857 Returns a reference to the array of all the basketgroups of bookseller $booksellerid.
 858
 859 =cut
 860
 861 sub GetBasketgroups {
 862     my $booksellerid = shift;
 863     die 'bookseller id is required to edit a basketgroup' unless $booksellerid;
 864     my $query = 'SELECT * FROM aqbasketgroups WHERE booksellerid=? ORDER BY id DESC';
 865     my $dbh = C4::Context->dbh;
 866     my $sth = $dbh->prepare($query);
 867     $sth->execute($booksellerid);
 868     return $sth->fetchall_arrayref({});
 869 }
 870
 871 #------------------------------------------------------------#
 872
 873 =head2 FUNCTIONS ABOUT ORDERS
 874
 875 =head3 GetOrders
 876
 877   @orders = &GetOrders($basketnumber, $orderby);
 878
 879 Looks up the pending (non-cancelled) orders with the given basket
 880 number. If C<$booksellerID> is non-empty, only orders from that seller
 881 are returned.
 882
 883 return :
 884 C<&basket> returns a two-element array. C<@orders> is an array of
 885 references-to-hash, whose keys are the fields from the aqorders,
 886 biblio, and biblioitems tables in the Koha database.
 887
 888 =cut
 889
 890 sub GetOrders {
 891     my ( $basketno, $orderby ) = @_;
 892     my $dbh   = C4::Context->dbh;
 893     my $query  ="
 894         SELECT biblio.*,biblioitems.*,
 895                 aqorders.*,
 896                 aqbudgets.*,
 897                 biblio.title,
 898                 aqorders_transfers.ordernumber_from AS transferred_from,
 899                 aqorders_transfers.timestamp AS transferred_from_timestamp
 900         FROM    aqorders
 901             LEFT JOIN aqbudgets        ON aqbudgets.budget_id = aqorders.budget_id
 902             LEFT JOIN biblio           ON biblio.biblionumber = aqorders.biblionumber
 903             LEFT JOIN biblioitems      ON biblioitems.biblionumber =biblio.biblionumber
 904             LEFT JOIN aqorders_transfers ON aqorders_transfers.ordernumber_to = aqorders.ordernumber
 905         WHERE   basketno=?
 906             AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00')
 907     ";
 908
 909     $orderby = "biblioitems.publishercode,biblio.title" unless $orderby;
 910     $query .= " ORDER BY $orderby";
 911     my $sth = $dbh->prepare($query);
 912     $sth->execute($basketno);
 913     my $results = $sth->fetchall_arrayref({});
 914     $sth->finish;
 915     return @$results;
 916 }
 917
 918 #------------------------------------------------------------#
 919 =head3 GetOrdersByBiblionumber
 920
 921   @orders = &GetOrdersByBiblionumber($biblionumber);
 922
 923 Looks up the orders with linked to a specific $biblionumber, including
 924 cancelled orders and received orders.
 925
 926 return :
 927 C<@orders> is an array of references-to-hash, whose keys are the
 928 fields from the aqorders, biblio, and biblioitems tables in the Koha database.
 929
 930 =cut
 931
 932 sub GetOrdersByBiblionumber {
 933     my $biblionumber = shift;
 934     return unless $biblionumber;
 935     my $dbh   = C4::Context->dbh;
 936     my $query  ="
 937         SELECT biblio.*,biblioitems.*,
 938                 aqorders.*,
 939                 aqbudgets.*
 940         FROM    aqorders
 941             LEFT JOIN aqbudgets        ON aqbudgets.budget_id = aqorders.budget_id
 942             LEFT JOIN biblio           ON biblio.biblionumber = aqorders.biblionumber
 943             LEFT JOIN biblioitems      ON biblioitems.biblionumber =biblio.biblionumber
 944         WHERE   aqorders.biblionumber=?
 945     ";
 946     my $sth = $dbh->prepare($query);
 947     $sth->execute($biblionumber);
 948     my $results = $sth->fetchall_arrayref({});
 949     $sth->finish;
 950     return @$results;
 951 }
 952
 953 #------------------------------------------------------------#
 954
 955 =head3 GetOrder
 956
 957   $order = &GetOrder($ordernumber);
 958
 959 Looks up an order by order number.
 960
 961 Returns a reference-to-hash describing the order. The keys of
 962 C<$order> are fields from the biblio, biblioitems, aqorders tables of the Koha database.
 963
 964 =cut
 965
 966 sub GetOrder {
 967     my ($ordernumber) = @_;
 968     my $dbh      = C4::Context->dbh;
 969     my $query = "
 970         SELECT biblioitems.*, biblio.*, aqorders.*
 971         FROM   aqorders
 972         LEFT JOIN biblio on           biblio.biblionumber=aqorders.biblionumber
 973         LEFT JOIN biblioitems on       biblioitems.biblionumber=aqorders.biblionumber
 974         WHERE aqorders.ordernumber=?
 975
 976     ";
 977     my $sth= $dbh->prepare($query);
 978     $sth->execute($ordernumber);
 979     my $data = $sth->fetchrow_hashref;
 980     $sth->finish;
 981     return $data;
 982 }
 983
 984 =head3 GetLastOrderNotReceivedFromSubscriptionid
 985
 986   $order = &GetLastOrderNotReceivedFromSubscriptionid($subscriptionid);
 987
 988 Returns a reference-to-hash describing the last order not received for a subscription.
 989
 990 =cut
 991
 992 sub GetLastOrderNotReceivedFromSubscriptionid {
 993     my ( $subscriptionid ) = @_;
 994     my $dbh                = C4::Context->dbh;
 995     my $query              = qq|
 996         SELECT * FROM aqorders
 997         LEFT JOIN subscription
 998             ON ( aqorders.subscriptionid = subscription.subscriptionid )
 999         WHERE aqorders.subscriptionid = ?
1000             AND aqorders.datereceived IS NULL
1001         LIMIT 1
1002     |;
1003     my $sth = $dbh->prepare( $query );
1004     $sth->execute( $subscriptionid );
1005     my $order = $sth->fetchrow_hashref;
1006     return $order;
1007 }
1008
1009 =head3 GetLastOrderReceivedFromSubscriptionid
1010
1011   $order = &GetLastOrderReceivedFromSubscriptionid($subscriptionid);
1012
1013 Returns a reference-to-hash describing the last order received for a subscription.
1014
1015 =cut
1016
1017 sub GetLastOrderReceivedFromSubscriptionid {
1018     my ( $subscriptionid ) = @_;
1019     my $dbh                = C4::Context->dbh;
1020     my $query              = qq|
1021         SELECT * FROM aqorders
1022         LEFT JOIN subscription
1023             ON ( aqorders.subscriptionid = subscription.subscriptionid )
1024         WHERE aqorders.subscriptionid = ?
1025             AND aqorders.datereceived =
1026                 (
1027                     SELECT MAX( aqorders.datereceived )
1028                     FROM aqorders
1029                     LEFT JOIN subscription
1030                         ON ( aqorders.subscriptionid = subscription.subscriptionid )
1031                         WHERE aqorders.subscriptionid = ?
1032                             AND aqorders.datereceived IS NOT NULL
1033                 )
1034         ORDER BY ordernumber DESC
1035         LIMIT 1
1036     |;
1037     my $sth = $dbh->prepare( $query );
1038     $sth->execute( $subscriptionid, $subscriptionid );
1039     my $order = $sth->fetchrow_hashref;
1040     return $order;
1041
1042 }
1043
1044
1045 #------------------------------------------------------------#
1046
1047 =head3 NewOrder
1048
1049   &NewOrder(\%hashref);
1050
1051 Adds a new order to the database. Any argument that isn't described
1052 below is the new value of the field with the same name in the aqorders
1053 table of the Koha database.
1054
1055 =over
1056
1057 =item $hashref->{'basketno'} is the basketno foreign key in aqorders, it is mandatory
1058
1059 =item $hashref->{'ordernumber'} is a "minimum order number."
1060
1061 =item $hashref->{'budgetdate'} is effectively ignored.
1062 If it's undef (anything false) or the string 'now', the current day is used.
1063 Else, the upcoming July 1st is used.
1064
1065 =item $hashref->{'subscription'} may be either "yes", or anything else for "no".
1066
1067 =item $hashref->{'uncertainprice'} may be 0 for "the price is known" or 1 for "the price is uncertain"
1068
1069 =item defaults entrydate to Now
1070
1071 The following keys are used: "biblionumber", "title", "basketno", "quantity", "notes", "rrp", "ecost", "gstrate", "unitprice", "subscription", "sort1", "sort2", "booksellerinvoicenumber", "listprice", "budgetdate", "purchaseordernumber", "branchcode", "booksellerinvoicenumber", "budget_id".
1072
1073 =back
1074
1075 =cut
1076
1077 sub NewOrder {
1078     my $orderinfo = shift;
1079
1080     my $dbh = C4::Context->dbh;
1081     my @params;
1082
1083
1084     # if these parameters are missing, we can't continue
1085     for my $key (qw/basketno quantity biblionumber budget_id/) {
1086         croak "Mandatory parameter $key missing" unless $orderinfo->{$key};
1087     }
1088
1089     if ( defined $orderinfo->{subscription} && $orderinfo->{'subscription'} eq 'yes' ) {
1090         $orderinfo->{'subscription'} = 1;
1091     } else {
1092         $orderinfo->{'subscription'} = 0;
1093     }
1094     $orderinfo->{'entrydate'} ||= C4::Dates->new()->output("iso");
1095     if (!$orderinfo->{quantityreceived}) {
1096         $orderinfo->{quantityreceived} = 0;
1097     }
1098
1099     my $ordernumber=InsertInTable("aqorders",$orderinfo);
1100     if (not $orderinfo->{parent_ordernumber}) {
1101         my $sth = $dbh->prepare("
1102             UPDATE aqorders
1103             SET parent_ordernumber = ordernumber
1104             WHERE ordernumber = ?
1105         ");
1106         $sth->execute($ordernumber);
1107     }
1108     return ( $orderinfo->{'basketno'}, $ordernumber );
1109 }
1110
1111
1112
1113 #------------------------------------------------------------#
1114
1115 =head3 NewOrderItem
1116
1117   &NewOrderItem();
1118
1119 =cut
1120
1121 sub NewOrderItem {
1122     my ($itemnumber, $ordernumber)  = @_;
1123     my $dbh = C4::Context->dbh;
1124     my $query = qq|
1125             INSERT INTO aqorders_items
1126                 (itemnumber, ordernumber)
1127             VALUES (?,?)    |;
1128
1129     my $sth = $dbh->prepare($query);
1130     $sth->execute( $itemnumber, $ordernumber);
1131 }
1132
1133 #------------------------------------------------------------#
1134
1135 =head3 ModOrder
1136
1137   &ModOrder(\%hashref);
1138
1139 Modifies an existing order. Updates the order with order number
1140 $hashref->{'ordernumber'} and biblionumber $hashref->{'biblionumber'}. All
1141 other keys of the hash update the fields with the same name in the aqorders
1142 table of the Koha database.
1143
1144 =cut
1145
1146 sub ModOrder {
1147     my $orderinfo = shift;
1148
1149     die "Ordernumber is required"     if $orderinfo->{'ordernumber'} eq  '' ;
1150     die "Biblionumber is required"  if  $orderinfo->{'biblionumber'} eq '';
1151
1152     my $dbh = C4::Context->dbh;
1153     my @params;
1154
1155     # update uncertainprice to an integer, just in case (under FF, checked boxes have the value "ON" by default)
1156     $orderinfo->{uncertainprice}=1 if $orderinfo->{uncertainprice};
1157
1158 #    delete($orderinfo->{'branchcode'});
1159     # the hash contains a lot of entries not in aqorders, so get the columns ...
1160     my $sth = $dbh->prepare("SELECT * FROM aqorders LIMIT 1;");
1161     $sth->execute;
1162     my $colnames = $sth->{NAME};
1163         #FIXME Be careful. If aqorders would have columns with diacritics,
1164         #you should need to decode what you get back from NAME.
1165         #See report 10110 and guided_reports.pl
1166     my $query = "UPDATE aqorders SET ";
1167
1168     foreach my $orderinfokey (grep(!/ordernumber/, keys %$orderinfo)){
1169         # ... and skip hash entries that are not in the aqorders table
1170         # FIXME : probably not the best way to do it (would be better to have a correct hash)
1171         next unless grep(/^$orderinfokey$/, @$colnames);
1172             $query .= "$orderinfokey=?, ";
1173             push(@params, $orderinfo->{$orderinfokey});
1174     }
1175
1176     $query .= "timestamp=NOW()  WHERE  ordernumber=?";
1177 #   push(@params, $specorderinfo{'ordernumber'});
1178     push(@params, $orderinfo->{'ordernumber'} );
1179     $sth = $dbh->prepare($query);
1180     $sth->execute(@params);
1181     $sth->finish;
1182 }
1183
1184 #------------------------------------------------------------#
1185
1186 =head3 ModItemOrder
1187
1188     ModItemOrder($itemnumber, $ordernumber);
1189
1190 Modifies the ordernumber of an item in aqorders_items.
1191
1192 =cut
1193
1194 sub ModItemOrder {
1195     my ($itemnumber, $ordernumber) = @_;
1196
1197     return unless ($itemnumber and $ordernumber);
1198
1199     my $dbh = C4::Context->dbh;
1200     my $query = qq{
1201         UPDATE aqorders_items
1202         SET ordernumber = ?
1203         WHERE itemnumber = ?
1204     };
1205     my $sth = $dbh->prepare($query);
1206     return $sth->execute($ordernumber, $itemnumber);
1207 }
1208
1209 #------------------------------------------------------------#
1210
1211 =head3 GetCancelledOrders
1212
1213   my @orders = GetCancelledOrders($basketno, $orderby);
1214
1215 Returns cancelled orders for a basket
1216
1217 =cut
1218
1219 sub GetCancelledOrders {
1220     my ( $basketno, $orderby ) = @_;
1221
1222     return () unless $basketno;
1223
1224     my $dbh   = C4::Context->dbh;
1225     my $query = "
1226         SELECT
1227             biblio.*,
1228             biblioitems.*,
1229             aqorders.*,
1230             aqbudgets.*,
1231             aqorders_transfers.ordernumber_to AS transferred_to,
1232             aqorders_transfers.timestamp AS transferred_to_timestamp
1233         FROM aqorders
1234           LEFT JOIN aqbudgets   ON aqbudgets.budget_id = aqorders.budget_id
1235           LEFT JOIN biblio      ON biblio.biblionumber = aqorders.biblionumber
1236           LEFT JOIN biblioitems ON biblioitems.biblionumber = biblio.biblionumber
1237           LEFT JOIN aqorders_transfers ON aqorders_transfers.ordernumber_from = aqorders.ordernumber
1238         WHERE basketno = ?
1239           AND (datecancellationprinted IS NOT NULL
1240                AND datecancellationprinted <> '0000-00-00')
1241     ";
1242
1243     $orderby = "aqorders.datecancellationprinted desc, aqorders.timestamp desc"
1244         unless $orderby;
1245     $query .= " ORDER BY $orderby";
1246     my $sth = $dbh->prepare($query);
1247     $sth->execute($basketno);
1248     my $results = $sth->fetchall_arrayref( {} );
1249
1250     return @$results;
1251 }
1252
1253
1254 #------------------------------------------------------------#
1255
1256 =head3 ModReceiveOrder
1257
1258   &ModReceiveOrder($biblionumber, $ordernumber, $quantityreceived, $user,
1259     $cost, $ecost, $invoiceid, rrp, budget_id, datereceived, \@received_itemnumbers);
1260
1261 Updates an order, to reflect the fact that it was received, at least
1262 in part. All arguments not mentioned below update the fields with the
1263 same name in the aqorders table of the Koha database.
1264
1265 If a partial order is received, splits the order into two.
1266
1267 Updates the order with bibilionumber C<$biblionumber> and ordernumber
1268 C<$ordernumber>.
1269
1270 =cut
1271
1272
1273 sub ModReceiveOrder {
1274     my (
1275         $biblionumber,    $ordernumber,  $quantrec, $user, $cost, $ecost,
1276         $invoiceid, $rrp, $budget_id, $datereceived, $received_items
1277     )
1278     = @_;
1279
1280     my $dbh = C4::Context->dbh;
1281     $datereceived = C4::Dates->output('iso') unless $datereceived;
1282     my $suggestionid = GetSuggestionFromBiblionumber( $biblionumber );
1283     if ($suggestionid) {
1284         ModSuggestion( {suggestionid=>$suggestionid,
1285                         STATUS=>'AVAILABLE',
1286                         biblionumber=> $biblionumber}
1287                         );
1288     }
1289
1290     my $sth=$dbh->prepare("
1291         SELECT * FROM   aqorders
1292         WHERE           biblionumber=? AND aqorders.ordernumber=?");
1293
1294     $sth->execute($biblionumber,$ordernumber);
1295     my $order = $sth->fetchrow_hashref();
1296     $sth->finish();
1297
1298     my $new_ordernumber = $ordernumber;
1299     if ( $order->{quantity} > $quantrec ) {
1300         # Split order line in two parts: the first is the original order line
1301         # without received items (the quantity is decreased),
1302         # the second part is a new order line with quantity=quantityrec
1303         # (entirely received)
1304         $sth=$dbh->prepare("
1305             UPDATE aqorders
1306             SET quantity = ?,
1307                 orderstatus = 'partial'
1308             WHERE ordernumber = ?
1309         ");
1310
1311         $sth->execute($order->{quantity} - $quantrec, $ordernumber);
1312
1313         $sth->finish;
1314
1315         delete $order->{'ordernumber'};
1316         $order->{'budget_id'} = ( $budget_id || $order->{'budget_id'} );
1317         $order->{'quantity'} = $quantrec;
1318         $order->{'quantityreceived'} = $quantrec;
1319         $order->{'datereceived'} = $datereceived;
1320         $order->{'invoiceid'} = $invoiceid;
1321         $order->{'unitprice'} = $cost;
1322         $order->{'rrp'} = $rrp;
1323         $order->{ecost} = $ecost;
1324         $order->{'orderstatus'} = 'complete';
1325         my $basketno;
1326         ( $basketno, $new_ordernumber ) = NewOrder($order);
1327
1328         if ($received_items) {
1329             foreach my $itemnumber (@$received_items) {
1330                 ModItemOrder($itemnumber, $new_ordernumber);
1331             }
1332         }
1333     } else {
1334         $sth=$dbh->prepare("update aqorders
1335                             set quantityreceived=?,datereceived=?,invoiceid=?,
1336                                 unitprice=?,rrp=?,ecost=?,budget_id=?,orderstatus='complete'
1337                             where biblionumber=? and ordernumber=?");
1338         $sth->execute($quantrec,$datereceived,$invoiceid,$cost,$rrp,$ecost,$budget_id,$biblionumber,$ordernumber);
1339         $sth->finish;
1340     }
1341     return ($datereceived, $new_ordernumber);
1342 }
1343
1344 =head3 CancelReceipt
1345
1346     my $parent_ordernumber = CancelReceipt($ordernumber);
1347
1348     Cancel an order line receipt and update the parent order line, as if no
1349     receipt was made.
1350     If items are created at receipt (AcqCreateItem = receiving) then delete
1351     these items.
1352
1353 =cut
1354
1355 sub CancelReceipt {
1356     my $ordernumber = shift;
1357
1358     return unless $ordernumber;
1359
1360     my $dbh = C4::Context->dbh;
1361     my $query = qq{
1362         SELECT datereceived, parent_ordernumber, quantity
1363         FROM aqorders
1364         WHERE ordernumber = ?
1365     };
1366     my $sth = $dbh->prepare($query);
1367     $sth->execute($ordernumber);
1368     my $order = $sth->fetchrow_hashref;
1369     unless($order) {
1370         warn "CancelReceipt: order $ordernumber does not exist";
1371         return;
1372     }
1373     unless($order->{'datereceived'}) {
1374         warn "CancelReceipt: order $ordernumber is not received";
1375         return;
1376     }
1377
1378     my $parent_ordernumber = $order->{'parent_ordernumber'};
1379
1380     if($parent_ordernumber == $ordernumber || not $parent_ordernumber) {
1381         # The order line has no parent, just mark it as not received
1382         $query = qq{
1383             UPDATE aqorders
1384             SET quantityreceived = ?,
1385                 datereceived = ?,
1386                 invoiceid = ?,
1387                 orderstatus = 'ordered'
1388             WHERE ordernumber = ?
1389         };
1390         $sth = $dbh->prepare($query);
1391         $sth->execute(0, undef, undef, $ordernumber);
1392     } else {
1393         # The order line has a parent, increase parent quantity and delete
1394         # the order line.
1395         $query = qq{
1396             SELECT quantity, datereceived
1397             FROM aqorders
1398             WHERE ordernumber = ?
1399         };
1400         $sth = $dbh->prepare($query);
1401         $sth->execute($parent_ordernumber);
1402         my $parent_order = $sth->fetchrow_hashref;
1403         unless($parent_order) {
1404             warn "Parent order $parent_ordernumber does not exist.";
1405             return;
1406         }
1407         if($parent_order->{'datereceived'}) {
1408             warn "CancelReceipt: parent order is received.".
1409                 " Can't cancel receipt.";
1410             return;
1411         }
1412         $query = qq{
1413             UPDATE aqorders
1414             SET quantity = ?,
1415                 orderstatus = 'ordered'
1416             WHERE ordernumber = ?
1417         };
1418         $sth = $dbh->prepare($query);
1419         my $rv = $sth->execute(
1420             $order->{'quantity'} + $parent_order->{'quantity'},
1421             $parent_ordernumber
1422         );
1423         unless($rv) {
1424             warn "Cannot update parent order line, so do not cancel".
1425                 " receipt";
1426             return;
1427         }
1428         if(C4::Context->preference('AcqCreateItem') eq 'receiving') {
1429             # Remove items that were created at receipt
1430             $query = qq{
1431                 DELETE FROM items, aqorders_items
1432                 USING items, aqorders_items
1433                 WHERE items.itemnumber = ? AND aqorders_items.itemnumber = ?
1434             };
1435             $sth = $dbh->prepare($query);
1436             my @itemnumbers = GetItemnumbersFromOrder($ordernumber);
1437             foreach my $itemnumber (@itemnumbers) {
1438                 $sth->execute($itemnumber, $itemnumber);
1439             }
1440         } else {
1441             # Update items
1442             my @itemnumbers = GetItemnumbersFromOrder($ordernumber);
1443             foreach my $itemnumber (@itemnumbers) {
1444                 ModItemOrder($itemnumber, $parent_ordernumber);
1445             }
1446         }
1447         # Delete order line
1448         $query = qq{
1449             DELETE FROM aqorders
1450             WHERE ordernumber = ?
1451         };
1452         $sth = $dbh->prepare($query);
1453         $sth->execute($ordernumber);
1454
1455     }
1456
1457     return $parent_ordernumber;
1458 }
1459
1460 #------------------------------------------------------------#
1461
1462 =head3 SearchOrders
1463
1464 @results = &SearchOrders({
1465     ordernumber => $ordernumber,
1466     search => $search,
1467     biblionumber => $biblionumber,
1468     ean => $ean,
1469     booksellerid => $booksellerid,
1470     basketno => $basketno,
1471     owner => $owner,
1472     pending => $pending
1473 });
1474
1475 Searches for orders.
1476
1477 C<$owner> Finds order for the logged in user.
1478 C<$pending> Finds pending orders. Ignores completed and cancelled orders.
1479
1480
1481 C<@results> is an array of references-to-hash with the keys are fields
1482 from aqorders, biblio, biblioitems and aqbasket tables.
1483
1484 =cut
1485
1486 sub SearchOrders {
1487     my ( $params ) = @_;
1488     my $ordernumber = $params->{ordernumber};
1489     my $search = $params->{search};
1490     my $ean = $params->{ean};
1491     my $booksellerid = $params->{booksellerid};
1492     my $basketno = $params->{basketno};
1493     my $basketname = $params->{basketname};
1494     my $basketgroupname = $params->{basketgroupname};
1495     my $owner = $params->{owner};
1496     my $pending = $params->{pending};
1497
1498     my $dbh = C4::Context->dbh;
1499     my @args = ();
1500     my $query = q{
1501         SELECT aqbasket.basketno,
1502                borrowers.surname,
1503                borrowers.firstname,
1504                biblio.*,
1505                biblioitems.isbn,
1506                biblioitems.biblioitemnumber,
1507                aqbasket.closedate,
1508                aqbasket.creationdate,
1509                aqbasket.basketname,
1510                aqorders.*
1511         FROM aqorders
1512             LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
1513             LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid = aqbasketgroups.id
1514             LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
1515             LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1516             LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
1517         WHERE (datecancellationprinted is NULL)
1518     };
1519
1520     $query .= q{
1521         AND (quantity > quantityreceived OR quantityreceived is NULL)
1522     } if $pending;
1523
1524     my $userenv = C4::Context->userenv;
1525     if ( C4::Context->preference("IndependentBranches") ) {
1526         if ( ( $userenv ) and ( $userenv->{flags} != 1 ) ) {
1527             $query .= q{
1528                 AND (
1529                     borrowers.branchcode = ?
1530                     OR borrowers.branchcode  = ''
1531                 )
1532             };
1533             push @args, $userenv->{branch};
1534         }
1535     }
1536
1537     if ( $ordernumber ) {
1538         $query .= ' AND (aqorders.ordernumber=?)';
1539         push @args, $ordernumber;
1540     }
1541     if( $search ) {
1542         $query .= ' AND (biblio.title LIKE ? OR biblio.author LIKE ? OR biblioitems.isbn LIKE ?)';
1543         push @args, ("%$search%","%$search%","%$search%");
1544     }
1545     if ( $ean ) {
1546         $query .= ' AND biblioitems.ean = ?';
1547         push @args, $ean;
1548     }
1549     if ( $booksellerid ) {
1550         $query .= 'AND aqbasket.booksellerid = ?';
1551         push @args, $booksellerid;
1552     }
1553     if( $basketno ) {
1554         $query .= 'AND aqbasket.basketno = ?';
1555         push @args, $basketno;
1556     }
1557     if( $basketname ) {
1558         $query .= 'AND aqbasket.basketname LIKE ?';
1559         push @args, "%$basketname%";
1560     }
1561     if( $basketgroupname ) {
1562         $query .= ' AND aqbasketgroups.name LIKE ?';
1563         push @args, "%$basketgroupname%";
1564     }
1565
1566     if ( $owner ) {
1567         $query .= ' AND aqbasket.authorisedby=? ';
1568         push @args, $userenv->{'number'};
1569     }
1570
1571     $query .= ' ORDER BY aqbasket.basketno';
1572
1573     my $sth = $dbh->prepare($query);
1574     $sth->execute(@args);
1575     return $sth->fetchall_arrayref({});
1576 }
1577
1578 #------------------------------------------------------------#
1579
1580 =head3 DelOrder
1581
1582   &DelOrder($biblionumber, $ordernumber);
1583
1584 Cancel the order with the given order and biblio numbers. It does not
1585 delete any entries in the aqorders table, it merely marks them as
1586 cancelled.
1587
1588 =cut
1589
1590 sub DelOrder {
1591     my ( $bibnum, $ordernumber ) = @_;
1592     my $dbh = C4::Context->dbh;
1593     my $query = "
1594         UPDATE aqorders
1595         SET    datecancellationprinted=now(), orderstatus='cancelled'
1596         WHERE  biblionumber=? AND ordernumber=?
1597     ";
1598     my $sth = $dbh->prepare($query);
1599     $sth->execute( $bibnum, $ordernumber );
1600     $sth->finish;
1601     my @itemnumbers = GetItemnumbersFromOrder( $ordernumber );
1602     foreach my $itemnumber (@itemnumbers){
1603         C4::Items::DelItem( $dbh, $bibnum, $itemnumber );
1604     }
1605
1606 }
1607
1608 =head3 TransferOrder
1609
1610     my $newordernumber = TransferOrder($ordernumber, $basketno);
1611
1612 Transfer an order line to a basket.
1613 Mark $ordernumber as cancelled with an internal note 'Cancelled and transfered
1614 to BOOKSELLER on DATE' and create new order with internal note
1615 'Transfered from BOOKSELLER on DATE'.
1616 Move all attached items to the new order.
1617 Received orders cannot be transfered.
1618 Return the ordernumber of created order.
1619
1620 =cut
1621
1622 sub TransferOrder {
1623     my ($ordernumber, $basketno) = @_;
1624
1625     return unless ($ordernumber and $basketno);
1626
1627     my $order = GetOrder( $ordernumber );
1628     return if $order->{datereceived};
1629     my $basket = GetBasket($basketno);
1630     return unless $basket;
1631
1632     my $dbh = C4::Context->dbh;
1633     my ($query, $sth, $rv);
1634
1635     $query = qq{
1636         UPDATE aqorders
1637         SET datecancellationprinted = CAST(NOW() AS date)
1638         WHERE ordernumber = ?
1639     };
1640     $sth = $dbh->prepare($query);
1641     $rv = $sth->execute($ordernumber);
1642
1643     delete $order->{'ordernumber'};
1644     $order->{'basketno'} = $basketno;
1645     my $newordernumber;
1646     (undef, $newordernumber) = NewOrder($order);
1647
1648     $query = qq{
1649         UPDATE aqorders_items
1650         SET ordernumber = ?
1651         WHERE ordernumber = ?
1652     };
1653     $sth = $dbh->prepare($query);
1654     $sth->execute($newordernumber, $ordernumber);
1655
1656     $query = q{
1657         INSERT INTO aqorders_transfers (ordernumber_from, ordernumber_to)
1658         VALUES (?, ?)
1659     };
1660     $sth = $dbh->prepare($query);
1661     $sth->execute($ordernumber, $newordernumber);
1662
1663     return $newordernumber;
1664 }
1665
1666 =head2 FUNCTIONS ABOUT PARCELS
1667
1668 =cut
1669
1670 #------------------------------------------------------------#
1671
1672 =head3 GetParcel
1673
1674   @results = &GetParcel($booksellerid, $code, $date);
1675
1676 Looks up all of the received items from the supplier with the given
1677 bookseller ID at the given date, for the given code (bookseller Invoice number). Ignores cancelled and completed orders.
1678
1679 C<@results> is an array of references-to-hash. The keys of each element are fields from
1680 the aqorders, biblio, and biblioitems tables of the Koha database.
1681
1682 C<@results> is sorted alphabetically by book title.
1683
1684 =cut
1685
1686 sub GetParcel {
1687     #gets all orders from a certain supplier, orders them alphabetically
1688     my ( $supplierid, $code, $datereceived ) = @_;
1689     my $dbh     = C4::Context->dbh;
1690     my @results = ();
1691     $code .= '%'
1692     if $code;  # add % if we search on a given code (otherwise, let him empty)
1693     my $strsth ="
1694         SELECT  authorisedby,
1695                 creationdate,
1696                 aqbasket.basketno,
1697                 closedate,surname,
1698                 firstname,
1699                 aqorders.biblionumber,
1700                 aqorders.ordernumber,
1701                 aqorders.parent_ordernumber,
1702                 aqorders.quantity,
1703                 aqorders.quantityreceived,
1704                 aqorders.unitprice,
1705                 aqorders.listprice,
1706                 aqorders.rrp,
1707                 aqorders.ecost,
1708                 aqorders.gstrate,
1709                 biblio.title
1710         FROM aqorders
1711         LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
1712         LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
1713         LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1714         LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid
1715         WHERE
1716             aqbasket.booksellerid = ?
1717             AND aqinvoices.invoicenumber LIKE ?
1718             AND aqorders.datereceived = ? ";
1719
1720     my @query_params = ( $supplierid, $code, $datereceived );
1721     if ( C4::Context->preference("IndependentBranches") ) {
1722         my $userenv = C4::Context->userenv;
1723         if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
1724             $strsth .= " and (borrowers.branchcode = ?
1725                         or borrowers.branchcode  = '')";
1726             push @query_params, $userenv->{branch};
1727         }
1728     }
1729     $strsth .= " ORDER BY aqbasket.basketno";
1730     # ## parcelinformation : $strsth
1731     my $sth = $dbh->prepare($strsth);
1732     $sth->execute( @query_params );
1733     while ( my $data = $sth->fetchrow_hashref ) {
1734         push( @results, $data );
1735     }
1736     # ## countparcelbiblio: scalar(@results)
1737     $sth->finish;
1738
1739     return @results;
1740 }
1741
1742 #------------------------------------------------------------#
1743
1744 =head3 GetParcels
1745
1746   $results = &GetParcels($bookseller, $order, $code, $datefrom, $dateto);
1747
1748 get a lists of parcels.
1749
1750 * Input arg :
1751
1752 =over
1753
1754 =item $bookseller
1755 is the bookseller this function has to get parcels.
1756
1757 =item $order
1758 To know on what criteria the results list has to be ordered.
1759
1760 =item $code
1761 is the booksellerinvoicenumber.
1762
1763 =item $datefrom & $dateto
1764 to know on what date this function has to filter its search.
1765
1766 =back
1767
1768 * return:
1769 a pointer on a hash list containing parcel informations as such :
1770
1771 =over
1772
1773 =item Creation date
1774
1775 =item Last operation
1776
1777 =item Number of biblio
1778
1779 =item Number of items
1780
1781 =back
1782
1783 =cut
1784
1785 sub GetParcels {
1786     my ($bookseller,$order, $code, $datefrom, $dateto) = @_;
1787     my $dbh    = C4::Context->dbh;
1788     my @query_params = ();
1789     my $strsth ="
1790         SELECT  aqinvoices.invoicenumber,
1791                 datereceived,purchaseordernumber,
1792                 count(DISTINCT biblionumber) AS biblio,
1793                 sum(quantity) AS itemsexpected,
1794                 sum(quantityreceived) AS itemsreceived
1795         FROM   aqorders LEFT JOIN aqbasket ON aqbasket.basketno = aqorders.basketno
1796         LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid
1797         WHERE aqbasket.booksellerid = ? and datereceived IS NOT NULL
1798     ";
1799     push @query_params, $bookseller;
1800
1801     if ( defined $code ) {
1802         $strsth .= ' and aqinvoices.invoicenumber like ? ';
1803         # add a % to the end of the code to allow stemming.
1804         push @query_params, "$code%";
1805     }
1806
1807     if ( defined $datefrom ) {
1808         $strsth .= ' and datereceived >= ? ';
1809         push @query_params, $datefrom;
1810     }
1811
1812     if ( defined $dateto ) {
1813         $strsth .=  'and datereceived <= ? ';
1814         push @query_params, $dateto;
1815     }
1816
1817     $strsth .= "group by aqinvoices.invoicenumber,datereceived ";
1818
1819     # can't use a placeholder to place this column name.
1820     # but, we could probably be checking to make sure it is a column that will be fetched.
1821     $strsth .= "order by $order " if ($order);
1822
1823     my $sth = $dbh->prepare($strsth);
1824
1825     $sth->execute( @query_params );
1826     my $results = $sth->fetchall_arrayref({});
1827     $sth->finish;
1828     return @$results;
1829 }
1830
1831 #------------------------------------------------------------#
1832
1833 =head3 GetLateOrders
1834
1835   @results = &GetLateOrders;
1836
1837 Searches for bookseller with late orders.
1838
1839 return:
1840 the table of supplier with late issues. This table is full of hashref.
1841
1842 =cut
1843
1844 sub GetLateOrders {
1845     my $delay      = shift;
1846     my $supplierid = shift;
1847     my $branch     = shift;
1848     my $estimateddeliverydatefrom = shift;
1849     my $estimateddeliverydateto = shift;
1850
1851     my $dbh = C4::Context->dbh;
1852
1853     #BEWARE, order of parenthesis and LEFT JOIN is important for speed
1854     my $dbdriver = C4::Context->config("db_scheme") || "mysql";
1855
1856     my @query_params = ();
1857     my $select = "
1858     SELECT aqbasket.basketno,
1859         aqorders.ordernumber,
1860         DATE(aqbasket.closedate)  AS orderdate,
1861         aqorders.rrp              AS unitpricesupplier,
1862         aqorders.ecost            AS unitpricelib,
1863         aqorders.claims_count     AS claims_count,
1864         aqorders.claimed_date     AS claimed_date,
1865         aqbudgets.budget_name     AS budget,
1866         borrowers.branchcode      AS branch,
1867         aqbooksellers.name        AS supplier,
1868         aqbooksellers.id          AS supplierid,
1869         biblio.author, biblio.title,
1870         biblioitems.publishercode AS publisher,
1871         biblioitems.publicationyear,
1872         ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) AS estimateddeliverydate,
1873     ";
1874     my $from = "
1875     FROM
1876         aqorders LEFT JOIN biblio     ON biblio.biblionumber         = aqorders.biblionumber
1877         LEFT JOIN biblioitems         ON biblioitems.biblionumber    = biblio.biblionumber
1878         LEFT JOIN aqbudgets           ON aqorders.budget_id          = aqbudgets.budget_id,
1879         aqbasket LEFT JOIN borrowers  ON aqbasket.authorisedby       = borrowers.borrowernumber
1880         LEFT JOIN aqbooksellers       ON aqbasket.booksellerid       = aqbooksellers.id
1881         WHERE aqorders.basketno = aqbasket.basketno
1882         AND ( datereceived = ''
1883             OR datereceived IS NULL
1884             OR aqorders.quantityreceived < aqorders.quantity
1885         )
1886         AND aqbasket.closedate IS NOT NULL
1887         AND (aqorders.datecancellationprinted IS NULL OR aqorders.datecancellationprinted='0000-00-00')
1888     ";
1889     my $having = "";
1890     if ($dbdriver eq "mysql") {
1891         $select .= "
1892         aqorders.quantity - COALESCE(aqorders.quantityreceived,0)                 AS quantity,
1893         (aqorders.quantity - COALESCE(aqorders.quantityreceived,0)) * aqorders.rrp AS subtotal,
1894         DATEDIFF(CAST(now() AS date),closedate) AS latesince
1895         ";
1896         if ( defined $delay ) {
1897             $from .= " AND (closedate <= DATE_SUB(CAST(now() AS date),INTERVAL ? DAY)) " ;
1898             push @query_params, $delay;
1899         }
1900         $having = "
1901         HAVING quantity          <> 0
1902             AND unitpricesupplier <> 0
1903             AND unitpricelib      <> 0
1904         ";
1905     } else {
1906         # FIXME: account for IFNULL as above
1907         $select .= "
1908                 aqorders.quantity                AS quantity,
1909                 aqorders.quantity * aqorders.rrp AS subtotal,
1910                 (CAST(now() AS date) - closedate)            AS latesince
1911         ";
1912         if ( defined $delay ) {
1913             $from .= " AND (closedate <= (CAST(now() AS date) -(INTERVAL ? DAY)) ";
1914             push @query_params, $delay;
1915         }
1916     }
1917     if (defined $supplierid) {
1918         $from .= ' AND aqbasket.booksellerid = ? ';
1919         push @query_params, $supplierid;
1920     }
1921     if (defined $branch) {
1922         $from .= ' AND borrowers.branchcode LIKE ? ';
1923         push @query_params, $branch;
1924     }
1925
1926     if ( defined $estimateddeliverydatefrom or defined $estimateddeliverydateto ) {
1927         $from .= ' AND aqbooksellers.deliverytime IS NOT NULL ';
1928     }
1929     if ( defined $estimateddeliverydatefrom ) {
1930         $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) >= ?';
1931         push @query_params, $estimateddeliverydatefrom;
1932     }
1933     if ( defined $estimateddeliverydateto ) {
1934         $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) <= ?';
1935         push @query_params, $estimateddeliverydateto;
1936     }
1937     if ( defined $estimateddeliverydatefrom and not defined $estimateddeliverydateto ) {
1938         $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) <= CAST(now() AS date)';
1939     }
1940     if (C4::Context->preference("IndependentBranches")
1941             && C4::Context->userenv
1942             && C4::Context->userenv->{flags} != 1 ) {
1943         $from .= ' AND borrowers.branchcode LIKE ? ';
1944         push @query_params, C4::Context->userenv->{branch};
1945     }
1946     $from .= " AND orderstatus <> 'cancelled' ";
1947     my $query = "$select $from $having\nORDER BY latesince, basketno, borrowers.branchcode, supplier";
1948     $debug and print STDERR "GetLateOrders query: $query\nGetLateOrders args: " . join(" ",@query_params);
1949     my $sth = $dbh->prepare($query);
1950     $sth->execute(@query_params);
1951     my @results;
1952     while (my $data = $sth->fetchrow_hashref) {
1953         $data->{orderdate} = format_date($data->{orderdate});
1954         $data->{claimed_date} = format_date($data->{claimed_date});
1955         push @results, $data;
1956     }
1957     return @results;
1958 }
1959
1960 #------------------------------------------------------------#
1961
1962 =head3 GetHistory
1963
1964   (\@order_loop, $total_qty, $total_price, $total_qtyreceived) = GetHistory( %params );
1965
1966 Retreives some acquisition history information
1967
1968 params:
1969   title
1970   author
1971   name
1972   from_placed_on
1973   to_placed_on
1974   basket                  - search both basket name and number
1975   booksellerinvoicenumber
1976
1977 returns:
1978     $order_loop is a list of hashrefs that each look like this:
1979             {
1980                 'author'           => 'Twain, Mark',
1981                 'basketno'         => '1',
1982                 'biblionumber'     => '215',
1983                 'count'            => 1,
1984                 'creationdate'     => 'MM/DD/YYYY',
1985                 'datereceived'     => undef,
1986                 'ecost'            => '1.00',
1987                 'id'               => '1',
1988                 'invoicenumber'    => undef,
1989                 'name'             => '',
1990                 'ordernumber'      => '1',
1991                 'quantity'         => 1,
1992                 'quantityreceived' => undef,
1993                 'title'            => 'The Adventures of Huckleberry Finn'
1994             }
1995     $total_qty is the sum of all of the quantities in $order_loop
1996     $total_price is the cost of each in $order_loop times the quantity
1997     $total_qtyreceived is the sum of all of the quantityreceived entries in $order_loop
1998
1999 =cut
2000
2001 sub GetHistory {
2002 # don't run the query if there are no parameters (list would be too long for sure !)
2003     croak "No search params" unless @_;
2004     my %params = @_;
2005     my $title = $params{title};
2006     my $author = $params{author};
2007     my $isbn   = $params{isbn};
2008     my $ean    = $params{ean};
2009     my $name = $params{name};
2010     my $from_placed_on = $params{from_placed_on};
2011     my $to_placed_on = $params{to_placed_on};
2012     my $basket = $params{basket};
2013     my $booksellerinvoicenumber = $params{booksellerinvoicenumber};
2014     my $basketgroupname = $params{basketgroupname};
2015     my $budget = $params{budget};
2016     my $orderstatus = $params{orderstatus};
2017
2018     my @order_loop;
2019     my $total_qty         = 0;
2020     my $total_qtyreceived = 0;
2021     my $total_price       = 0;
2022
2023     my $dbh   = C4::Context->dbh;
2024     my $query ="
2025         SELECT
2026             COALESCE(biblio.title,     deletedbiblio.title)     AS title,
2027             COALESCE(biblio.author,    deletedbiblio.author)    AS author,
2028             COALESCE(biblioitems.isbn, deletedbiblioitems.isbn) AS isbn,
2029             COALESCE(biblioitems.ean,  deletedbiblioitems.ean)  AS ean,
2030             aqorders.basketno,
2031             aqbasket.basketname,
2032             aqbasket.basketgroupid,
2033             aqbasketgroups.name as groupname,
2034             aqbooksellers.name,
2035             aqbasket.creationdate,
2036             aqorders.datereceived,
2037             aqorders.quantity,
2038             aqorders.quantityreceived,
2039             aqorders.ecost,
2040             aqorders.ordernumber,
2041             aqorders.invoiceid,
2042             aqinvoices.invoicenumber,
2043             aqbooksellers.id as id,
2044             aqorders.biblionumber,
2045             aqorders.orderstatus,
2046             aqorders.parent_ordernumber,
2047             aqbudgets.budget_name
2048             ";
2049     $query .= ", aqbudgets.budget_id AS budget" if defined $budget;
2050     $query .= "
2051         FROM aqorders
2052         LEFT JOIN aqbasket ON aqorders.basketno=aqbasket.basketno
2053         LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid=aqbasketgroups.id
2054         LEFT JOIN aqbooksellers ON aqbasket.booksellerid=aqbooksellers.id
2055         LEFT JOIN biblioitems ON biblioitems.biblionumber=aqorders.biblionumber
2056         LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber
2057         LEFT JOIN aqbudgets ON aqorders.budget_id=aqbudgets.budget_id
2058         LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid
2059         LEFT JOIN deletedbiblio ON deletedbiblio.biblionumber=aqorders.biblionumber
2060         LEFT JOIN deletedbiblioitems ON deletedbiblioitems.biblionumber=aqorders.biblionumber
2061         ";
2062
2063     if ( C4::Context->preference("IndependentBranches") ) {
2064         $query .= " LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber";
2065     }
2066
2067     $query .= " WHERE 1 ";
2068
2069     $query .= " AND (datecancellationprinted is NULL or datecancellationprinted='0000-00-00') " if $orderstatus ne 'cancelled';
2070
2071     my @query_params  = ();
2072
2073     if ( $title ) {
2074         $query .= " AND biblio.title LIKE ? ";
2075         $title =~ s/\s+/%/g;
2076         push @query_params, "%$title%";
2077     }
2078
2079     if ( $author ) {
2080         $query .= " AND biblio.author LIKE ? ";
2081         push @query_params, "%$author%";
2082     }
2083
2084     if ( $isbn ) {
2085         $query .= " AND biblioitems.isbn LIKE ? ";
2086         push @query_params, "%$isbn%";
2087     }
2088     if ( $ean ) {
2089         $query .= " AND biblioitems.ean = ? ";
2090         push @query_params, "$ean";
2091     }
2092     if ( $name ) {
2093         $query .= " AND aqbooksellers.name LIKE ? ";
2094         push @query_params, "%$name%";
2095     }
2096
2097     if ( $budget ) {
2098         $query .= " AND aqbudgets.budget_id = ? ";
2099         push @query_params, "$budget";
2100     }
2101
2102     if ( $from_placed_on ) {
2103         $query .= " AND creationdate >= ? ";
2104         push @query_params, $from_placed_on;
2105     }
2106
2107     if ( $to_placed_on ) {
2108         $query .= " AND creationdate <= ? ";
2109         push @query_params, $to_placed_on;
2110     }
2111
2112     if ( defined $orderstatus and $orderstatus ne '') {
2113         $query .= " AND aqorders.orderstatus = ? ";
2114         push @query_params, "$orderstatus";
2115     }
2116
2117     if ($basket) {
2118         if ($basket =~ m/^\d+$/) {
2119             $query .= " AND aqorders.basketno = ? ";
2120             push @query_params, $basket;
2121         } else {
2122             $query .= " AND aqbasket.basketname LIKE ? ";
2123             push @query_params, "%$basket%";
2124         }
2125     }
2126
2127     if ($booksellerinvoicenumber) {
2128         $query .= " AND aqinvoices.invoicenumber LIKE ? ";
2129         push @query_params, "%$booksellerinvoicenumber%";
2130     }
2131
2132     if ($basketgroupname) {
2133         $query .= " AND aqbasketgroups.name LIKE ? ";
2134         push @query_params, "%$basketgroupname%";
2135     }
2136
2137     if ( C4::Context->preference("IndependentBranches") ) {
2138         my $userenv = C4::Context->userenv;
2139         if ( $userenv && ($userenv->{flags} || 0) != 1 ) {
2140             $query .= " AND (borrowers.branchcode = ? OR borrowers.branchcode ='' ) ";
2141             push @query_params, $userenv->{branch};
2142         }
2143     }
2144     $query .= " ORDER BY id";
2145     my $sth = $dbh->prepare($query);
2146     $sth->execute( @query_params );
2147     my $cnt = 1;
2148     while ( my $line = $sth->fetchrow_hashref ) {
2149         $line->{count} = $cnt++;
2150         $line->{toggle} = 1 if $cnt % 2;
2151         push @order_loop, $line;
2152         $total_qty         += ( $line->{quantity} ) ? $line->{quantity} : 0;
2153         $total_qtyreceived += ( $line->{quantityreceived} ) ? $line->{quantityreceived} : 0;
2154         $total_price       += ( $line->{quantity} and $line->{ecost} ) ? $line->{quantity} * $line->{ecost} : 0;
2155     }
2156     return \@order_loop, $total_qty, $total_price, $total_qtyreceived;
2157 }
2158
2159 =head2 GetRecentAcqui
2160
2161   $results = GetRecentAcqui($days);
2162
2163 C<$results> is a ref to a table which containts hashref
2164
2165 =cut
2166
2167 sub GetRecentAcqui {
2168     my $limit  = shift;
2169     my $dbh    = C4::Context->dbh;
2170     my $query = "
2171         SELECT *
2172         FROM   biblio
2173         ORDER BY timestamp DESC
2174         LIMIT  0,".$limit;
2175
2176     my $sth = $dbh->prepare($query);
2177     $sth->execute;
2178     my $results = $sth->fetchall_arrayref({});
2179     return $results;
2180 }
2181
2182 =head3 GetContracts
2183
2184   $contractlist = &GetContracts($booksellerid, $activeonly);
2185
2186 Looks up the contracts that belong to a bookseller
2187
2188 Returns a list of contracts
2189
2190 =over
2191
2192 =item C<$booksellerid> is the "id" field in the "aqbooksellers" table.
2193
2194 =item C<$activeonly> if exists get only contracts that are still active.
2195
2196 =back
2197
2198 =cut
2199
2200 sub GetContracts {
2201     my ( $booksellerid, $activeonly ) = @_;
2202     my $dbh = C4::Context->dbh;
2203     my $query;
2204     if (! $activeonly) {
2205         $query = "
2206             SELECT *
2207             FROM   aqcontract
2208             WHERE  booksellerid=?
2209         ";
2210     } else {
2211         $query = "SELECT *
2212             FROM aqcontract
2213             WHERE booksellerid=?
2214                 AND contractenddate >= CURDATE( )";
2215     }
2216     my $sth = $dbh->prepare($query);
2217     $sth->execute( $booksellerid );
2218     my @results;
2219     while (my $data = $sth->fetchrow_hashref ) {
2220         push(@results, $data);
2221     }
2222     $sth->finish;
2223     return @results;
2224 }
2225
2226 #------------------------------------------------------------#
2227
2228 =head3 GetContract
2229
2230   $contract = &GetContract($contractID);
2231
2232 Looks up the contract that has PRIMKEY (contractnumber) value $contractID
2233
2234 Returns a contract
2235
2236 =cut
2237
2238 sub GetContract {
2239     my ( $contractno ) = @_;
2240     my $dbh = C4::Context->dbh;
2241     my $query = "
2242         SELECT *
2243         FROM   aqcontract
2244         WHERE  contractnumber=?
2245         ";
2246
2247     my $sth = $dbh->prepare($query);
2248     $sth->execute( $contractno );
2249     my $result = $sth->fetchrow_hashref;
2250     return $result;
2251 }
2252
2253 =head3 AddClaim
2254
2255 =over 4
2256
2257 &AddClaim($ordernumber);
2258
2259 Add a claim for an order
2260
2261 =back
2262
2263 =cut
2264 sub AddClaim {
2265     my ($ordernumber) = @_;
2266     my $dbh          = C4::Context->dbh;
2267     my $query        = "
2268         UPDATE aqorders SET
2269             claims_count = claims_count + 1,
2270             claimed_date = CURDATE()
2271         WHERE ordernumber = ?
2272         ";
2273     my $sth = $dbh->prepare($query);
2274     $sth->execute($ordernumber);
2275 }
2276
2277 =head3 GetInvoices
2278
2279     my @invoices = GetInvoices(
2280         invoicenumber => $invoicenumber,
2281         suppliername => $suppliername,
2282         shipmentdatefrom => $shipmentdatefrom, # ISO format
2283         shipmentdateto => $shipmentdateto, # ISO format
2284         billingdatefrom => $billingdatefrom, # ISO format
2285         billingdateto => $billingdateto, # ISO format
2286         isbneanissn => $isbn_or_ean_or_issn,
2287         title => $title,
2288         author => $author,
2289         publisher => $publisher,
2290         publicationyear => $publicationyear,
2291         branchcode => $branchcode,
2292         order_by => $order_by
2293     );
2294
2295 Return a list of invoices that match all given criteria.
2296
2297 $order_by is "column_name (asc|desc)", where column_name is any of
2298 'invoicenumber', 'booksellerid', 'shipmentdate', 'billingdate', 'closedate',
2299 'shipmentcost', 'shipmentcost_budgetid'.
2300
2301 asc is the default if omitted
2302
2303 =cut
2304
2305 sub GetInvoices {
2306     my %args = @_;
2307
2308     my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2309         closedate shipmentcost shipmentcost_budgetid);
2310
2311     my $dbh = C4::Context->dbh;
2312     my $query = qq{
2313         SELECT aqinvoices.*, aqbooksellers.name AS suppliername,
2314           COUNT(
2315             DISTINCT IF(
2316               aqorders.datereceived IS NOT NULL,
2317               aqorders.biblionumber,
2318               NULL
2319             )
2320           ) AS receivedbiblios,
2321           SUM(aqorders.quantityreceived) AS receiveditems
2322         FROM aqinvoices
2323           LEFT JOIN aqbooksellers ON aqbooksellers.id = aqinvoices.booksellerid
2324           LEFT JOIN aqorders ON aqorders.invoiceid = aqinvoices.invoiceid
2325           LEFT JOIN biblio ON aqorders.biblionumber = biblio.biblionumber
2326           LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
2327           LEFT JOIN subscription ON biblio.biblionumber = subscription.biblionumber
2328     };
2329
2330     my @bind_args;
2331     my @bind_strs;
2332     if($args{supplierid}) {
2333         push @bind_strs, " aqinvoices.booksellerid = ? ";
2334         push @bind_args, $args{supplierid};
2335     }
2336     if($args{invoicenumber}) {
2337         push @bind_strs, " aqinvoices.invoicenumber LIKE ? ";
2338         push @bind_args, "%$args{invoicenumber}%";
2339     }
2340     if($args{suppliername}) {
2341         push @bind_strs, " aqbooksellers.name LIKE ? ";
2342         push @bind_args, "%$args{suppliername}%";
2343     }
2344     if($args{shipmentdatefrom}) {
2345         push @bind_strs, " aqinvoices.shipementdate >= ? ";
2346         push @bind_args, $args{shipmentdatefrom};
2347     }
2348     if($args{shipmentdateto}) {
2349         push @bind_strs, " aqinvoices.shipementdate <= ? ";
2350         push @bind_args, $args{shipmentdateto};
2351     }
2352     if($args{billingdatefrom}) {
2353         push @bind_strs, " aqinvoices.billingdate >= ? ";
2354         push @bind_args, $args{billingdatefrom};
2355     }
2356     if($args{billingdateto}) {
2357         push @bind_strs, " aqinvoices.billingdate <= ? ";
2358         push @bind_args, $args{billingdateto};
2359     }
2360     if($args{isbneanissn}) {
2361         push @bind_strs, " (biblioitems.isbn LIKE ? OR biblioitems.ean LIKE ? OR biblioitems.issn LIKE ? ) ";
2362         push @bind_args, $args{isbneanissn}, $args{isbneanissn}, $args{isbneanissn};
2363     }
2364     if($args{title}) {
2365         push @bind_strs, " biblio.title LIKE ? ";
2366         push @bind_args, $args{title};
2367     }
2368     if($args{author}) {
2369         push @bind_strs, " biblio.author LIKE ? ";
2370         push @bind_args, $args{author};
2371     }
2372     if($args{publisher}) {
2373         push @bind_strs, " biblioitems.publishercode LIKE ? ";
2374         push @bind_args, $args{publisher};
2375     }
2376     if($args{publicationyear}) {
2377         push @bind_strs, " biblioitems.publicationyear = ? ";
2378         push @bind_args, $args{publicationyear};
2379     }
2380     if($args{branchcode}) {
2381         push @bind_strs, " aqorders.branchcode = ? ";
2382         push @bind_args, $args{branchcode};
2383     }
2384
2385     $query .= " WHERE " . join(" AND ", @bind_strs) if @bind_strs;
2386     $query .= " GROUP BY aqinvoices.invoiceid ";
2387
2388     if($args{order_by}) {
2389         my ($column, $direction) = split / /, $args{order_by};
2390         if(grep /^$column$/, @columns) {
2391             $direction ||= 'ASC';
2392             $query .= " ORDER BY $column $direction";
2393         }
2394     }
2395
2396     my $sth = $dbh->prepare($query);
2397     $sth->execute(@bind_args);
2398
2399     my $results = $sth->fetchall_arrayref({});
2400     return @$results;
2401 }
2402
2403 =head3 GetInvoice
2404
2405     my $invoice = GetInvoice($invoiceid);
2406
2407 Get informations about invoice with given $invoiceid
2408
2409 Return a hash filled with aqinvoices.* fields
2410
2411 =cut
2412
2413 sub GetInvoice {
2414     my ($invoiceid) = @_;
2415     my $invoice;
2416
2417     return unless $invoiceid;
2418
2419     my $dbh = C4::Context->dbh;
2420     my $query = qq{
2421         SELECT *
2422         FROM aqinvoices
2423         WHERE invoiceid = ?
2424     };
2425     my $sth = $dbh->prepare($query);
2426     $sth->execute($invoiceid);
2427
2428     $invoice = $sth->fetchrow_hashref;
2429     return $invoice;
2430 }
2431
2432 =head3 GetInvoiceDetails
2433
2434     my $invoice = GetInvoiceDetails($invoiceid)
2435
2436 Return informations about an invoice + the list of related order lines
2437
2438 Orders informations are in $invoice->{orders} (array ref)
2439
2440 =cut
2441
2442 sub GetInvoiceDetails {
2443     my ($invoiceid) = @_;
2444
2445     if ( !defined $invoiceid ) {
2446         carp 'GetInvoiceDetails called without an invoiceid';
2447         return;
2448     }
2449
2450     my $dbh = C4::Context->dbh;
2451     my $query = qq{
2452         SELECT aqinvoices.*, aqbooksellers.name AS suppliername
2453         FROM aqinvoices
2454           LEFT JOIN aqbooksellers ON aqinvoices.booksellerid = aqbooksellers.id
2455         WHERE invoiceid = ?
2456     };
2457     my $sth = $dbh->prepare($query);
2458     $sth->execute($invoiceid);
2459
2460     my $invoice = $sth->fetchrow_hashref;
2461
2462     $query = qq{
2463         SELECT aqorders.*, biblio.*,
2464         aqbasket.basketname
2465         FROM aqorders
2466           LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
2467           LEFT JOIN biblio ON aqorders.biblionumber = biblio.biblionumber
2468         WHERE invoiceid = ?
2469     };
2470     $sth = $dbh->prepare($query);
2471     $sth->execute($invoiceid);
2472     $invoice->{orders} = $sth->fetchall_arrayref({});
2473     $invoice->{orders} ||= []; # force an empty arrayref if fetchall_arrayref fails
2474
2475     return $invoice;
2476 }
2477
2478 =head3 AddInvoice
2479
2480     my $invoiceid = AddInvoice(
2481         invoicenumber => $invoicenumber,
2482         booksellerid => $booksellerid,
2483         shipmentdate => $shipmentdate,
2484         billingdate => $billingdate,
2485         closedate => $closedate,
2486         shipmentcost => $shipmentcost,
2487         shipmentcost_budgetid => $shipmentcost_budgetid
2488     );
2489
2490 Create a new invoice and return its id or undef if it fails.
2491
2492 =cut
2493
2494 sub AddInvoice {
2495     my %invoice = @_;
2496
2497     return unless(%invoice and $invoice{invoicenumber});
2498
2499     my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2500         closedate shipmentcost shipmentcost_budgetid);
2501
2502     my @set_strs;
2503     my @set_args;
2504     foreach my $key (keys %invoice) {
2505         if(0 < grep(/^$key$/, @columns)) {
2506             push @set_strs, "$key = ?";
2507             push @set_args, ($invoice{$key} || undef);
2508         }
2509     }
2510
2511     my $rv;
2512     if(@set_args > 0) {
2513         my $dbh = C4::Context->dbh;
2514         my $query = "INSERT INTO aqinvoices SET ";
2515         $query .= join (",", @set_strs);
2516         my $sth = $dbh->prepare($query);
2517         $rv = $sth->execute(@set_args);
2518         if($rv) {
2519             $rv = $dbh->last_insert_id(undef, undef, 'aqinvoices', undef);
2520         }
2521     }
2522     return $rv;
2523 }
2524
2525 =head3 ModInvoice
2526
2527     ModInvoice(
2528         invoiceid => $invoiceid,    # Mandatory
2529         invoicenumber => $invoicenumber,
2530         booksellerid => $booksellerid,
2531         shipmentdate => $shipmentdate,
2532         billingdate => $billingdate,
2533         closedate => $closedate,
2534         shipmentcost => $shipmentcost,
2535         shipmentcost_budgetid => $shipmentcost_budgetid
2536     );
2537
2538 Modify an invoice, invoiceid is mandatory.
2539
2540 Return undef if it fails.
2541
2542 =cut
2543
2544 sub ModInvoice {
2545     my %invoice = @_;
2546
2547     return unless(%invoice and $invoice{invoiceid});
2548
2549     my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2550         closedate shipmentcost shipmentcost_budgetid);
2551
2552     my @set_strs;
2553     my @set_args;
2554     foreach my $key (keys %invoice) {
2555         if(0 < grep(/^$key$/, @columns)) {
2556             push @set_strs, "$key = ?";
2557             push @set_args, ($invoice{$key} || undef);
2558         }
2559     }
2560
2561     my $dbh = C4::Context->dbh;
2562     my $query = "UPDATE aqinvoices SET ";
2563     $query .= join(",", @set_strs);
2564     $query .= " WHERE invoiceid = ?";
2565
2566     my $sth = $dbh->prepare($query);
2567     $sth->execute(@set_args, $invoice{invoiceid});
2568 }
2569
2570 =head3 CloseInvoice
2571
2572     CloseInvoice($invoiceid);
2573
2574 Close an invoice.
2575
2576 Equivalent to ModInvoice(invoiceid => $invoiceid, closedate => undef);
2577
2578 =cut
2579
2580 sub CloseInvoice {
2581     my ($invoiceid) = @_;
2582
2583     return unless $invoiceid;
2584
2585     my $dbh = C4::Context->dbh;
2586     my $query = qq{
2587         UPDATE aqinvoices
2588         SET closedate = CAST(NOW() AS DATE)
2589         WHERE invoiceid = ?
2590     };
2591     my $sth = $dbh->prepare($query);
2592     $sth->execute($invoiceid);
2593 }
2594
2595 =head3 ReopenInvoice
2596
2597     ReopenInvoice($invoiceid);
2598
2599 Reopen an invoice
2600
2601 Equivalent to ModInvoice(invoiceid => $invoiceid, closedate => C4::Dates->new()->output('iso'))
2602
2603 =cut
2604
2605 sub ReopenInvoice {
2606     my ($invoiceid) = @_;
2607
2608     return unless $invoiceid;
2609
2610     my $dbh = C4::Context->dbh;
2611     my $query = qq{
2612         UPDATE aqinvoices
2613         SET closedate = NULL
2614         WHERE invoiceid = ?
2615     };
2616     my $sth = $dbh->prepare($query);
2617     $sth->execute($invoiceid);
2618 }
2619
2620 =head3 DelInvoice
2621
2622     DelInvoice($invoiceid);
2623
2624 Delete an invoice if there are no items attached to it.
2625
2626 =cut
2627
2628 sub DelInvoice {
2629     my ($invoiceid) = @_;
2630
2631     return unless $invoiceid;
2632
2633     my $dbh   = C4::Context->dbh;
2634     my $query = qq{
2635         SELECT COUNT(*)
2636         FROM aqorders
2637         WHERE invoiceid = ?
2638     };
2639     my $sth = $dbh->prepare($query);
2640     $sth->execute($invoiceid);
2641     my $res = $sth->fetchrow_arrayref;
2642     if ( $res && $res->[0] == 0 ) {
2643         $query = qq{
2644             DELETE FROM aqinvoices
2645             WHERE invoiceid = ?
2646         };
2647         my $sth = $dbh->prepare($query);
2648         return ( $sth->execute($invoiceid) > 0 );
2649     }
2650     return;
2651 }
2652
2653 =head3 MergeInvoices
2654
2655     MergeInvoices($invoiceid, \@sourceids);
2656
2657 Merge the invoices identified by the IDs in \@sourceids into
2658 the invoice identified by $invoiceid.
2659
2660 =cut
2661
2662 sub MergeInvoices {
2663     my ($invoiceid, $sourceids) = @_;
2664
2665     return unless $invoiceid;
2666     foreach my $sourceid (@$sourceids) {
2667         next if $sourceid == $invoiceid;
2668         my $source = GetInvoiceDetails($sourceid);
2669         foreach my $order (@{$source->{'orders'}}) {
2670             $order->{'invoiceid'} = $invoiceid;
2671             ModOrder($order);
2672         }
2673         DelInvoice($source->{'invoiceid'});
2674     }
2675     return;
2676 }
2677
2678 =head3 GetBiblioCountByBasketno
2679
2680 $biblio_count = &GetBiblioCountByBasketno($basketno);
2681
2682 Looks up the biblio's count that has basketno value $basketno
2683
2684 Returns a quantity
2685
2686 =cut
2687
2688 sub GetBiblioCountByBasketno {
2689     my ($basketno) = @_;
2690     my $dbh          = C4::Context->dbh;
2691     my $query        = "
2692         SELECT COUNT( DISTINCT( biblionumber ) )
2693         FROM   aqorders
2694         WHERE  basketno = ?
2695             AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00')
2696         ";
2697
2698     my $sth = $dbh->prepare($query);
2699     $sth->execute($basketno);
2700     return $sth->fetchrow;
2701 }
2702
2703 1;
2704 __END__
2705
2706 =head1 AUTHOR
2707
2708 Koha Development Team <http://koha-community.org/>
2709
2710 =cut