C4/Acquisition.pm

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