C4/Acquisition.pm

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