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($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     return ( $orderinfo->{'basketno'}, $ordernumber );
1046 }
1047
1048
1049
1050 #------------------------------------------------------------#
1051
1052 =head3 NewOrderItem
1053
1054   &NewOrderItem();
1055
1056 =cut
1057
1058 sub NewOrderItem {
1059     my ($itemnumber, $ordernumber)  = @_;
1060     my $dbh = C4::Context->dbh;
1061     my $query = qq|
1062             INSERT INTO aqorders_items
1063                 (itemnumber, ordernumber)
1064             VALUES (?,?)    |;
1065
1066     my $sth = $dbh->prepare($query);
1067     $sth->execute( $itemnumber, $ordernumber);
1068 }
1069
1070 #------------------------------------------------------------#
1071
1072 =head3 ModOrder
1073
1074   &ModOrder(\%hashref);
1075
1076 Modifies an existing order. Updates the order with order number
1077 $hashref->{'ordernumber'} and biblionumber $hashref->{'biblionumber'}. All
1078 other keys of the hash update the fields with the same name in the aqorders
1079 table of the Koha database.
1080
1081 =cut
1082
1083 sub ModOrder {
1084     my $orderinfo = shift;
1085
1086     die "Ordernumber is required"     if $orderinfo->{'ordernumber'} eq  '' ;
1087     die "Biblionumber is required"  if  $orderinfo->{'biblionumber'} eq '';
1088
1089     my $dbh = C4::Context->dbh;
1090     my @params;
1091
1092     # update uncertainprice to an integer, just in case (under FF, checked boxes have the value "ON" by default)
1093     $orderinfo->{uncertainprice}=1 if $orderinfo->{uncertainprice};
1094
1095 #    delete($orderinfo->{'branchcode'});
1096     # the hash contains a lot of entries not in aqorders, so get the columns ...
1097     my $sth = $dbh->prepare("SELECT * FROM aqorders LIMIT 1;");
1098     $sth->execute;
1099     my $colnames = $sth->{NAME};
1100     my $query = "UPDATE aqorders SET ";
1101
1102     foreach my $orderinfokey (grep(!/ordernumber/, keys %$orderinfo)){
1103         # ... and skip hash entries that are not in the aqorders table
1104         # FIXME : probably not the best way to do it (would be better to have a correct hash)
1105         next unless grep(/^$orderinfokey$/, @$colnames);
1106             $query .= "$orderinfokey=?, ";
1107             push(@params, $orderinfo->{$orderinfokey});
1108     }
1109
1110     $query .= "timestamp=NOW()  WHERE  ordernumber=?";
1111 #   push(@params, $specorderinfo{'ordernumber'});
1112     push(@params, $orderinfo->{'ordernumber'} );
1113     $sth = $dbh->prepare($query);
1114     $sth->execute(@params);
1115     $sth->finish;
1116 }
1117
1118 #------------------------------------------------------------#
1119
1120 =head3 ModOrderItem
1121
1122   &ModOrderItem(\%hashref);
1123
1124 Modifies the itemnumber in the aqorders_items table. The input hash needs three entities:
1125
1126 =over
1127
1128 =item - itemnumber: the old itemnumber
1129 =item - ordernumber: the order this item is attached to
1130 =item - newitemnumber: the new itemnumber we want to attach the line to
1131
1132 =back
1133
1134 =cut
1135
1136 sub ModOrderItem {
1137     my $orderiteminfo = shift;
1138     if (! $orderiteminfo->{'ordernumber'} || ! $orderiteminfo->{'itemnumber'} || ! $orderiteminfo->{'newitemnumber'}){
1139         die "Ordernumber, itemnumber and newitemnumber is required";
1140     }
1141
1142     my $dbh = C4::Context->dbh;
1143
1144     my $query = "UPDATE aqorders_items set itemnumber=? where itemnumber=? and ordernumber=?";
1145     my @params = ($orderiteminfo->{'newitemnumber'}, $orderiteminfo->{'itemnumber'}, $orderiteminfo->{'ordernumber'});
1146     my $sth = $dbh->prepare($query);
1147     $sth->execute(@params);
1148     return 0;
1149 }
1150
1151 =head3 ModItemOrder
1152
1153     ModItemOrder($itemnumber, $ordernumber);
1154
1155 Modifies the ordernumber of an item in aqorders_items.
1156
1157 =cut
1158
1159 sub ModItemOrder {
1160     my ($itemnumber, $ordernumber) = @_;
1161
1162     return unless ($itemnumber and $ordernumber);
1163
1164     my $dbh = C4::Context->dbh;
1165     my $query = qq{
1166         UPDATE aqorders_items
1167         SET ordernumber = ?
1168         WHERE itemnumber = ?
1169     };
1170     my $sth = $dbh->prepare($query);
1171     return $sth->execute($ordernumber, $itemnumber);
1172 }
1173
1174 #------------------------------------------------------------#
1175
1176
1177 =head3 ModOrderBibliotemNumber
1178
1179   &ModOrderBiblioitemNumber($biblioitemnumber,$ordernumber, $biblionumber);
1180
1181 Modifies the biblioitemnumber for an existing order.
1182 Updates the order with order number C<$ordernum> and biblionumber C<$biblionumber>.
1183
1184 =cut
1185
1186 #FIXME: is this used at all?
1187 sub ModOrderBiblioitemNumber {
1188     my ($biblioitemnumber,$ordernumber, $biblionumber) = @_;
1189     my $dbh = C4::Context->dbh;
1190     my $query = "
1191     UPDATE aqorders
1192     SET    biblioitemnumber = ?
1193     WHERE  ordernumber = ?
1194     AND biblionumber =  ?";
1195     my $sth = $dbh->prepare($query);
1196     $sth->execute( $biblioitemnumber, $ordernumber, $biblionumber );
1197 }
1198
1199 =head3 GetCancelledOrders
1200
1201   my @orders = GetCancelledOrders($basketno, $orderby);
1202
1203 Returns cancelled orders for a basket
1204
1205 =cut
1206
1207 sub GetCancelledOrders {
1208     my ( $basketno, $orderby ) = @_;
1209
1210     return () unless $basketno;
1211
1212     my $dbh   = C4::Context->dbh;
1213     my $query = "
1214         SELECT biblio.*, biblioitems.*, aqorders.*, aqbudgets.*
1215         FROM aqorders
1216           LEFT JOIN aqbudgets   ON aqbudgets.budget_id = aqorders.budget_id
1217           LEFT JOIN biblio      ON biblio.biblionumber = aqorders.biblionumber
1218           LEFT JOIN biblioitems ON biblioitems.biblionumber = biblio.biblionumber
1219         WHERE basketno = ?
1220           AND (datecancellationprinted IS NOT NULL
1221                AND datecancellationprinted <> '0000-00-00')
1222     ";
1223
1224     $orderby = "aqorders.datecancellationprinted desc, aqorders.timestamp desc"
1225         unless $orderby;
1226     $query .= " ORDER BY $orderby";
1227     my $sth = $dbh->prepare($query);
1228     $sth->execute($basketno);
1229     my $results = $sth->fetchall_arrayref( {} );
1230
1231     return @$results;
1232 }
1233
1234
1235 #------------------------------------------------------------#
1236
1237 =head3 ModReceiveOrder
1238
1239   &ModReceiveOrder($biblionumber, $ordernumber, $quantityreceived, $user,
1240     $unitprice, $booksellerinvoicenumber, $biblioitemnumber,
1241     $freight, $bookfund, $rrp);
1242
1243 Updates an order, to reflect the fact that it was received, at least
1244 in part. All arguments not mentioned below update the fields with the
1245 same name in the aqorders table of the Koha database.
1246
1247 If a partial order is received, splits the order into two.  The received
1248 portion must have a booksellerinvoicenumber.
1249
1250 Updates the order with bibilionumber C<$biblionumber> and ordernumber
1251 C<$ordernumber>.
1252
1253 =cut
1254
1255
1256 sub ModReceiveOrder {
1257     my (
1258         $biblionumber,    $ordernumber,  $quantrec, $user, $cost,
1259         $invoiceno, $freight, $rrp, $budget_id, $datereceived, $received_items
1260     )
1261     = @_;
1262     my $dbh = C4::Context->dbh;
1263     $datereceived = C4::Dates->output('iso') unless $datereceived;
1264     my $suggestionid = GetSuggestionFromBiblionumber( $biblionumber );
1265     if ($suggestionid) {
1266         ModSuggestion( {suggestionid=>$suggestionid,
1267                         STATUS=>'AVAILABLE',
1268                         biblionumber=> $biblionumber}
1269                         );
1270     }
1271
1272     my $sth=$dbh->prepare("
1273         SELECT * FROM   aqorders
1274         WHERE           biblionumber=? AND aqorders.ordernumber=?");
1275
1276     $sth->execute($biblionumber,$ordernumber);
1277     my $order = $sth->fetchrow_hashref();
1278     $sth->finish();
1279
1280     if ( $order->{quantity} > $quantrec ) {
1281         $sth=$dbh->prepare("
1282             UPDATE aqorders
1283             SET quantityreceived=?
1284                 , datereceived=?
1285                 , booksellerinvoicenumber=?
1286                 , unitprice=?
1287                 , freight=?
1288                 , rrp=?
1289                 , quantity=?
1290             WHERE biblionumber=? AND ordernumber=?");
1291
1292         $sth->execute($quantrec,$datereceived,$invoiceno,$cost,$freight,$rrp,$quantrec,$biblionumber,$ordernumber);
1293         $sth->finish;
1294
1295         # create a new order for the remaining items, and set its bookfund.
1296         foreach my $orderkey ( "linenumber", "allocation" ) {
1297             delete($order->{'$orderkey'});
1298         }
1299         $order->{'quantity'} -= $quantrec;
1300         $order->{'quantityreceived'} = 0;
1301         my $newOrder = NewOrder($order);
1302         # Change ordernumber in aqorders_items for items not received
1303         my @orderitems = GetItemnumbersFromOrder( $order->{'ordernumber'} );
1304         my $count = scalar @orderitems;
1305
1306         for (my $i=0; $i<$count; $i++){
1307             foreach (@$received_items){
1308                 splice (@orderitems, $i, 1) if ($orderitems[$i] == $_);
1309             }
1310         }
1311         foreach (@orderitems) {
1312             ModItemOrder($_, $newOrder);
1313         }
1314     } else {
1315         $sth=$dbh->prepare("update aqorders
1316                             set quantityreceived=?,datereceived=?,booksellerinvoicenumber=?,
1317                                 unitprice=?,freight=?,rrp=?
1318                             where biblionumber=? and ordernumber=?");
1319         $sth->execute($quantrec,$datereceived,$invoiceno,$cost,$freight,$rrp,$biblionumber,$ordernumber);
1320         $sth->finish;
1321     }
1322     return $datereceived;
1323 }
1324 #------------------------------------------------------------#
1325
1326 =head3 SearchOrder
1327
1328 @results = &SearchOrder($search, $biblionumber, $complete);
1329
1330 Searches for orders.
1331
1332 C<$search> may take one of several forms: if it is an ISBN,
1333 C<&ordersearch> returns orders with that ISBN. If C<$search> is an
1334 order number, C<&ordersearch> returns orders with that order number
1335 and biblionumber C<$biblionumber>. Otherwise, C<$search> is considered
1336 to be a space-separated list of search terms; in this case, all of the
1337 terms must appear in the title (matching the beginning of title
1338 words).
1339
1340 If C<$complete> is C<yes>, the results will include only completed
1341 orders. In any case, C<&ordersearch> ignores cancelled orders.
1342
1343 C<&ordersearch> returns an array.
1344 C<@results> is an array of references-to-hash with the following keys:
1345
1346 =over 4
1347
1348 =item C<author>
1349
1350 =item C<seriestitle>
1351
1352 =item C<branchcode>
1353
1354 =item C<bookfundid>
1355
1356 =back
1357
1358 =cut
1359
1360 sub SearchOrder {
1361 #### -------- SearchOrder-------------------------------
1362     my ( $ordernumber, $search, $ean, $supplierid, $basket ) = @_;
1363
1364     my $dbh = C4::Context->dbh;
1365     my @args = ();
1366     my $query =
1367             "SELECT *
1368             FROM aqorders
1369             LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1370             LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
1371             LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
1372                 WHERE  (datecancellationprinted is NULL)";
1373
1374     if($ordernumber){
1375         $query .= " AND (aqorders.ordernumber=?)";
1376         push @args, $ordernumber;
1377     }
1378     if($search){
1379         $query .= " AND (biblio.title like ? OR biblio.author LIKE ? OR biblioitems.isbn like ?)";
1380         push @args, ("%$search%","%$search%","%$search%");
1381     }
1382     if ($ean) {
1383         $query .= " AND biblioitems.ean = ?";
1384         push @args, $ean;
1385     }
1386     if ($supplierid) {
1387         $query .= "AND aqbasket.booksellerid = ?";
1388         push @args, $supplierid;
1389     }
1390     if($basket){
1391         $query .= "AND aqorders.basketno = ?";
1392         push @args, $basket;
1393     }
1394
1395     my $sth = $dbh->prepare($query);
1396     $sth->execute(@args);
1397     my $results = $sth->fetchall_arrayref({});
1398     $sth->finish;
1399     return $results;
1400 }
1401
1402 #------------------------------------------------------------#
1403
1404 =head3 DelOrder
1405
1406   &DelOrder($biblionumber, $ordernumber);
1407
1408 Cancel the order with the given order and biblio numbers. It does not
1409 delete any entries in the aqorders table, it merely marks them as
1410 cancelled.
1411
1412 =cut
1413
1414 sub DelOrder {
1415     my ( $bibnum, $ordernumber ) = @_;
1416     my $dbh = C4::Context->dbh;
1417     my $query = "
1418         UPDATE aqorders
1419         SET    datecancellationprinted=now()
1420         WHERE  biblionumber=? AND ordernumber=?
1421     ";
1422     my $sth = $dbh->prepare($query);
1423     $sth->execute( $bibnum, $ordernumber );
1424     $sth->finish;
1425     my @itemnumbers = GetItemnumbersFromOrder( $ordernumber );
1426     foreach my $itemnumber (@itemnumbers){
1427         C4::Items::DelItem( $dbh, $bibnum, $itemnumber );
1428     }
1429
1430 }
1431
1432 =head2 FUNCTIONS ABOUT PARCELS
1433
1434 =cut
1435
1436 #------------------------------------------------------------#
1437
1438 =head3 GetParcel
1439
1440   @results = &GetParcel($booksellerid, $code, $date);
1441
1442 Looks up all of the received items from the supplier with the given
1443 bookseller ID at the given date, for the given code (bookseller Invoice number). Ignores cancelled and completed orders.
1444
1445 C<@results> is an array of references-to-hash. The keys of each element are fields from
1446 the aqorders, biblio, and biblioitems tables of the Koha database.
1447
1448 C<@results> is sorted alphabetically by book title.
1449
1450 =cut
1451
1452 sub GetParcel {
1453     #gets all orders from a certain supplier, orders them alphabetically
1454     my ( $supplierid, $code, $datereceived ) = @_;
1455     my $dbh     = C4::Context->dbh;
1456     my @results = ();
1457     $code .= '%'
1458     if $code;  # add % if we search on a given code (otherwise, let him empty)
1459     my $strsth ="
1460         SELECT  authorisedby,
1461                 creationdate,
1462                 aqbasket.basketno,
1463                 closedate,surname,
1464                 firstname,
1465                 aqorders.biblionumber,
1466                 aqorders.ordernumber,
1467                 aqorders.quantity,
1468                 aqorders.quantityreceived,
1469                 aqorders.unitprice,
1470                 aqorders.listprice,
1471                 aqorders.rrp,
1472                 aqorders.ecost,
1473                 biblio.title
1474         FROM aqorders
1475         LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
1476         LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
1477         LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1478         WHERE
1479             aqbasket.booksellerid = ?
1480             AND aqorders.booksellerinvoicenumber LIKE ?
1481             AND aqorders.datereceived = ? ";
1482
1483     my @query_params = ( $supplierid, $code, $datereceived );
1484     if ( C4::Context->preference("IndependantBranches") ) {
1485         my $userenv = C4::Context->userenv;
1486         if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
1487             $strsth .= " and (borrowers.branchcode = ?
1488                         or borrowers.branchcode  = '')";
1489             push @query_params, $userenv->{branch};
1490         }
1491     }
1492     $strsth .= " ORDER BY aqbasket.basketno";
1493     # ## parcelinformation : $strsth
1494     my $sth = $dbh->prepare($strsth);
1495     $sth->execute( @query_params );
1496     while ( my $data = $sth->fetchrow_hashref ) {
1497         push( @results, $data );
1498     }
1499     # ## countparcelbiblio: scalar(@results)
1500     $sth->finish;
1501
1502     return @results;
1503 }
1504
1505 #------------------------------------------------------------#
1506
1507 =head3 GetParcels
1508
1509   $results = &GetParcels($bookseller, $order, $code, $datefrom, $dateto);
1510
1511 get a lists of parcels.
1512
1513 * Input arg :
1514
1515 =over
1516
1517 =item $bookseller
1518 is the bookseller this function has to get parcels.
1519
1520 =item $order
1521 To know on what criteria the results list has to be ordered.
1522
1523 =item $code
1524 is the booksellerinvoicenumber.
1525
1526 =item $datefrom & $dateto
1527 to know on what date this function has to filter its search.
1528
1529 =back
1530
1531 * return:
1532 a pointer on a hash list containing parcel informations as such :
1533
1534 =over
1535
1536 =item Creation date
1537
1538 =item Last operation
1539
1540 =item Number of biblio
1541
1542 =item Number of items
1543
1544 =back
1545
1546 =cut
1547
1548 sub GetParcels {
1549     my ($bookseller,$order, $code, $datefrom, $dateto) = @_;
1550     my $dbh    = C4::Context->dbh;
1551     my @query_params = ();
1552     my $strsth ="
1553         SELECT  aqorders.booksellerinvoicenumber,
1554                 datereceived,purchaseordernumber,
1555                 count(DISTINCT biblionumber) AS biblio,
1556                 sum(quantity) AS itemsexpected,
1557                 sum(quantityreceived) AS itemsreceived
1558         FROM   aqorders LEFT JOIN aqbasket ON aqbasket.basketno = aqorders.basketno
1559         WHERE aqbasket.booksellerid = ? and datereceived IS NOT NULL
1560     ";
1561     push @query_params, $bookseller;
1562
1563     if ( defined $code ) {
1564         $strsth .= ' and aqorders.booksellerinvoicenumber like ? ';
1565         # add a % to the end of the code to allow stemming.
1566         push @query_params, "$code%";
1567     }
1568
1569     if ( defined $datefrom ) {
1570         $strsth .= ' and datereceived >= ? ';
1571         push @query_params, $datefrom;
1572     }
1573
1574     if ( defined $dateto ) {
1575         $strsth .=  'and datereceived <= ? ';
1576         push @query_params, $dateto;
1577     }
1578
1579     $strsth .= "group by aqorders.booksellerinvoicenumber,datereceived ";
1580
1581     # can't use a placeholder to place this column name.
1582     # but, we could probably be checking to make sure it is a column that will be fetched.
1583     $strsth .= "order by $order " if ($order);
1584
1585     my $sth = $dbh->prepare($strsth);
1586
1587     $sth->execute( @query_params );
1588     my $results = $sth->fetchall_arrayref({});
1589     $sth->finish;
1590     return @$results;
1591 }
1592
1593 #------------------------------------------------------------#
1594
1595 =head3 GetLateOrders
1596
1597   @results = &GetLateOrders;
1598
1599 Searches for bookseller with late orders.
1600
1601 return:
1602 the table of supplier with late issues. This table is full of hashref.
1603
1604 =cut
1605
1606 sub GetLateOrders {
1607     my $delay      = shift;
1608     my $supplierid = shift;
1609     my $branch     = shift;
1610     my $estimateddeliverydatefrom = shift;
1611     my $estimateddeliverydateto = shift;
1612
1613     my $dbh = C4::Context->dbh;
1614
1615     #BEWARE, order of parenthesis and LEFT JOIN is important for speed
1616     my $dbdriver = C4::Context->config("db_scheme") || "mysql";
1617
1618     my @query_params = ();
1619     my $select = "
1620     SELECT aqbasket.basketno,
1621         aqorders.ordernumber,
1622         DATE(aqbasket.closedate)  AS orderdate,
1623         aqorders.rrp              AS unitpricesupplier,
1624         aqorders.ecost            AS unitpricelib,
1625         aqorders.claims_count     AS claims_count,
1626         aqorders.claimed_date     AS claimed_date,
1627         aqbudgets.budget_name     AS budget,
1628         borrowers.branchcode      AS branch,
1629         aqbooksellers.name        AS supplier,
1630         aqbooksellers.id          AS supplierid,
1631         biblio.author, biblio.title,
1632         biblioitems.publishercode AS publisher,
1633         biblioitems.publicationyear,
1634         ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) AS estimateddeliverydate,
1635     ";
1636     my $from = "
1637     FROM
1638         aqorders LEFT JOIN biblio     ON biblio.biblionumber         = aqorders.biblionumber
1639         LEFT JOIN biblioitems         ON biblioitems.biblionumber    = biblio.biblionumber
1640         LEFT JOIN aqbudgets           ON aqorders.budget_id          = aqbudgets.budget_id,
1641         aqbasket LEFT JOIN borrowers  ON aqbasket.authorisedby       = borrowers.borrowernumber
1642         LEFT JOIN aqbooksellers       ON aqbasket.booksellerid       = aqbooksellers.id
1643         WHERE aqorders.basketno = aqbasket.basketno
1644         AND ( datereceived = ''
1645             OR datereceived IS NULL
1646             OR aqorders.quantityreceived < aqorders.quantity
1647         )
1648         AND aqbasket.closedate IS NOT NULL
1649         AND (aqorders.datecancellationprinted IS NULL OR aqorders.datecancellationprinted='0000-00-00')
1650     ";
1651     my $having = "";
1652     if ($dbdriver eq "mysql") {
1653         $select .= "
1654         aqorders.quantity - IFNULL(aqorders.quantityreceived,0)                 AS quantity,
1655         (aqorders.quantity - IFNULL(aqorders.quantityreceived,0)) * aqorders.rrp AS subtotal,
1656         DATEDIFF(CAST(now() AS date),closedate) AS latesince
1657         ";
1658         if ( defined $delay ) {
1659             $from .= " AND (closedate <= DATE_SUB(CAST(now() AS date),INTERVAL ? DAY)) " ;
1660             push @query_params, $delay;
1661         }
1662         $having = "
1663         HAVING quantity          <> 0
1664             AND unitpricesupplier <> 0
1665             AND unitpricelib      <> 0
1666         ";
1667     } else {
1668         # FIXME: account for IFNULL as above
1669         $select .= "
1670                 aqorders.quantity                AS quantity,
1671                 aqorders.quantity * aqorders.rrp AS subtotal,
1672                 (CAST(now() AS date) - closedate)            AS latesince
1673         ";
1674         if ( defined $delay ) {
1675             $from .= " AND (closedate <= (CAST(now() AS date) -(INTERVAL ? DAY)) ";
1676             push @query_params, $delay;
1677         }
1678     }
1679     if (defined $supplierid) {
1680         $from .= ' AND aqbasket.booksellerid = ? ';
1681         push @query_params, $supplierid;
1682     }
1683     if (defined $branch) {
1684         $from .= ' AND borrowers.branchcode LIKE ? ';
1685         push @query_params, $branch;
1686     }
1687     if ( defined $estimateddeliverydatefrom ) {
1688         $from .= '
1689             AND aqbooksellers.deliverytime IS NOT NULL
1690             AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) >= ?';
1691         push @query_params, $estimateddeliverydatefrom;
1692     }
1693     if ( defined $estimateddeliverydatefrom and defined $estimateddeliverydateto ) {
1694         $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) <= ?';
1695         push @query_params, $estimateddeliverydateto;
1696     } elsif ( defined $estimateddeliverydatefrom ) {
1697         $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) <= CAST(now() AS date)';
1698     }
1699     if (C4::Context->preference("IndependantBranches")
1700             && C4::Context->userenv
1701             && C4::Context->userenv->{flags} != 1 ) {
1702         $from .= ' AND borrowers.branchcode LIKE ? ';
1703         push @query_params, C4::Context->userenv->{branch};
1704     }
1705     my $query = "$select $from $having\nORDER BY latesince, basketno, borrowers.branchcode, supplier";
1706     $debug and print STDERR "GetLateOrders query: $query\nGetLateOrders args: " . join(" ",@query_params);
1707     my $sth = $dbh->prepare($query);
1708     $sth->execute(@query_params);
1709     my @results;
1710     while (my $data = $sth->fetchrow_hashref) {
1711         $data->{orderdate} = format_date($data->{orderdate});
1712         $data->{claimed_date} = format_date($data->{claimed_date});
1713         push @results, $data;
1714     }
1715     return @results;
1716 }
1717
1718 #------------------------------------------------------------#
1719
1720 =head3 GetHistory
1721
1722   (\@order_loop, $total_qty, $total_price, $total_qtyreceived) = GetHistory( %params );
1723
1724 Retreives some acquisition history information
1725
1726 params:
1727   title
1728   author
1729   name
1730   from_placed_on
1731   to_placed_on
1732   basket                  - search both basket name and number
1733   booksellerinvoicenumber
1734
1735 returns:
1736     $order_loop is a list of hashrefs that each look like this:
1737             {
1738                 'author'           => 'Twain, Mark',
1739                 'basketno'         => '1',
1740                 'biblionumber'     => '215',
1741                 'count'            => 1,
1742                 'creationdate'     => 'MM/DD/YYYY',
1743                 'datereceived'     => undef,
1744                 'ecost'            => '1.00',
1745                 'id'               => '1',
1746                 'invoicenumber'    => undef,
1747                 'name'             => '',
1748                 'ordernumber'      => '1',
1749                 'quantity'         => 1,
1750                 'quantityreceived' => undef,
1751                 'title'            => 'The Adventures of Huckleberry Finn'
1752             }
1753     $total_qty is the sum of all of the quantities in $order_loop
1754     $total_price is the cost of each in $order_loop times the quantity
1755     $total_qtyreceived is the sum of all of the quantityreceived entries in $order_loop
1756
1757 =cut
1758
1759 sub GetHistory {
1760 # don't run the query if there are no parameters (list would be too long for sure !)
1761     croak "No search params" unless @_;
1762     my %params = @_;
1763     my $title = $params{title};
1764     my $author = $params{author};
1765     my $isbn   = $params{isbn};
1766     my $ean    = $params{ean};
1767     my $name = $params{name};
1768     my $from_placed_on = $params{from_placed_on};
1769     my $to_placed_on = $params{to_placed_on};
1770     my $basket = $params{basket};
1771     my $booksellerinvoicenumber = $params{booksellerinvoicenumber};
1772     my $basketgroupname = $params{basketgroupname};
1773     my @order_loop;
1774     my $total_qty         = 0;
1775     my $total_qtyreceived = 0;
1776     my $total_price       = 0;
1777
1778     my $dbh   = C4::Context->dbh;
1779     my $query ="
1780         SELECT
1781             biblio.title,
1782             biblio.author,
1783             biblioitems.isbn,
1784         biblioitems.ean,
1785             aqorders.basketno,
1786             aqbasket.basketname,
1787             aqbasket.basketgroupid,
1788             aqbasketgroups.name as groupname,
1789             aqbooksellers.name,
1790             aqbasket.creationdate,
1791             aqorders.datereceived,
1792             aqorders.quantity,
1793             aqorders.quantityreceived,
1794             aqorders.ecost,
1795             aqorders.ordernumber,
1796             aqorders.booksellerinvoicenumber as invoicenumber,
1797             aqbooksellers.id as id,
1798             aqorders.biblionumber
1799         FROM aqorders
1800         LEFT JOIN aqbasket ON aqorders.basketno=aqbasket.basketno
1801         LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid=aqbasketgroups.id
1802         LEFT JOIN aqbooksellers ON aqbasket.booksellerid=aqbooksellers.id
1803         LEFT JOIN biblioitems ON biblioitems.biblionumber=aqorders.biblionumber
1804         LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber";
1805
1806     $query .= " LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber"
1807     if ( C4::Context->preference("IndependantBranches") );
1808
1809     $query .= " WHERE (datecancellationprinted is NULL or datecancellationprinted='0000-00-00') ";
1810
1811     my @query_params  = ();
1812
1813     if ( $title ) {
1814         $query .= " AND biblio.title LIKE ? ";
1815         $title =~ s/\s+/%/g;
1816         push @query_params, "%$title%";
1817     }
1818
1819     if ( $author ) {
1820         $query .= " AND biblio.author LIKE ? ";
1821         push @query_params, "%$author%";
1822     }
1823
1824     if ( $isbn ) {
1825         $query .= " AND biblioitems.isbn LIKE ? ";
1826         push @query_params, "%$isbn%";
1827     }
1828     if ( defined $ean and $ean ) {
1829         $query .= " AND biblioitems.ean = ? ";
1830         push @query_params, "$ean";
1831     }
1832     if ( $name ) {
1833         $query .= " AND aqbooksellers.name LIKE ? ";
1834         push @query_params, "%$name%";
1835     }
1836
1837     if ( $from_placed_on ) {
1838         $query .= " AND creationdate >= ? ";
1839         push @query_params, $from_placed_on;
1840     }
1841
1842     if ( $to_placed_on ) {
1843         $query .= " AND creationdate <= ? ";
1844         push @query_params, $to_placed_on;
1845     }
1846
1847     if ($basket) {
1848         if ($basket =~ m/^\d+$/) {
1849             $query .= " AND aqorders.basketno = ? ";
1850             push @query_params, $basket;
1851         } else {
1852             $query .= " AND aqbasket.basketname LIKE ? ";
1853             push @query_params, "%$basket%";
1854         }
1855     }
1856
1857     if ($booksellerinvoicenumber) {
1858         $query .= " AND (aqorders.booksellerinvoicenumber LIKE ? OR aqbasket.booksellerinvoicenumber LIKE ?)";
1859         push @query_params, "%$booksellerinvoicenumber%", "%$booksellerinvoicenumber%";
1860     }
1861
1862     if ($basketgroupname) {
1863         $query .= " AND aqbasketgroups.name LIKE ? ";
1864         push @query_params, "%$basketgroupname%";
1865     }
1866
1867     if ( C4::Context->preference("IndependantBranches") ) {
1868         my $userenv = C4::Context->userenv;
1869         if ( $userenv && ($userenv->{flags} || 0) != 1 ) {
1870             $query .= " AND (borrowers.branchcode = ? OR borrowers.branchcode ='' ) ";
1871             push @query_params, $userenv->{branch};
1872         }
1873     }
1874     $query .= " ORDER BY id";
1875     my $sth = $dbh->prepare($query);
1876     $sth->execute( @query_params );
1877     my $cnt = 1;
1878     while ( my $line = $sth->fetchrow_hashref ) {
1879         $line->{count} = $cnt++;
1880         $line->{toggle} = 1 if $cnt % 2;
1881         push @order_loop, $line;
1882         $total_qty         += $line->{'quantity'};
1883         $total_qtyreceived += $line->{'quantityreceived'};
1884         $total_price       += $line->{'quantity'} * $line->{'ecost'};
1885     }
1886     return \@order_loop, $total_qty, $total_price, $total_qtyreceived;
1887 }
1888
1889 =head2 GetRecentAcqui
1890
1891   $results = GetRecentAcqui($days);
1892
1893 C<$results> is a ref to a table which containts hashref
1894
1895 =cut
1896
1897 sub GetRecentAcqui {
1898     my $limit  = shift;
1899     my $dbh    = C4::Context->dbh;
1900     my $query = "
1901         SELECT *
1902         FROM   biblio
1903         ORDER BY timestamp DESC
1904         LIMIT  0,".$limit;
1905
1906     my $sth = $dbh->prepare($query);
1907     $sth->execute;
1908     my $results = $sth->fetchall_arrayref({});
1909     return $results;
1910 }
1911
1912 =head3 GetContracts
1913
1914   $contractlist = &GetContracts($booksellerid, $activeonly);
1915
1916 Looks up the contracts that belong to a bookseller
1917
1918 Returns a list of contracts
1919
1920 =over
1921
1922 =item C<$booksellerid> is the "id" field in the "aqbooksellers" table.
1923
1924 =item C<$activeonly> if exists get only contracts that are still active.
1925
1926 =back
1927
1928 =cut
1929
1930 sub GetContracts {
1931     my ( $booksellerid, $activeonly ) = @_;
1932     my $dbh = C4::Context->dbh;
1933     my $query;
1934     if (! $activeonly) {
1935         $query = "
1936             SELECT *
1937             FROM   aqcontract
1938             WHERE  booksellerid=?
1939         ";
1940     } else {
1941         $query = "SELECT *
1942             FROM aqcontract
1943             WHERE booksellerid=?
1944                 AND contractenddate >= CURDATE( )";
1945     }
1946     my $sth = $dbh->prepare($query);
1947     $sth->execute( $booksellerid );
1948     my @results;
1949     while (my $data = $sth->fetchrow_hashref ) {
1950         push(@results, $data);
1951     }
1952     $sth->finish;
1953     return @results;
1954 }
1955
1956 #------------------------------------------------------------#
1957
1958 =head3 GetContract
1959
1960   $contract = &GetContract($contractID);
1961
1962 Looks up the contract that has PRIMKEY (contractnumber) value $contractID
1963
1964 Returns a contract
1965
1966 =cut
1967
1968 sub GetContract {
1969     my ( $contractno ) = @_;
1970     my $dbh = C4::Context->dbh;
1971     my $query = "
1972         SELECT *
1973         FROM   aqcontract
1974         WHERE  contractnumber=?
1975         ";
1976
1977     my $sth = $dbh->prepare($query);
1978     $sth->execute( $contractno );
1979     my $result = $sth->fetchrow_hashref;
1980     return $result;
1981 }
1982
1983 =head3 AddClaim
1984
1985 =over 4
1986
1987 &AddClaim($ordernumber);
1988
1989 Add a claim for an order
1990
1991 =back
1992
1993 =cut
1994 sub AddClaim {
1995     my ($ordernumber) = @_;
1996     my $dbh          = C4::Context->dbh;
1997     my $query        = "
1998         UPDATE aqorders SET
1999             claims_count = claims_count + 1,
2000             claimed_date = CURDATE()
2001         WHERE ordernumber = ?
2002         ";
2003     my $sth = $dbh->prepare($query);
2004     $sth->execute($ordernumber);
2005
2006 }
2007
2008 1;
2009 __END__
2010
2011 =head1 AUTHOR
2012
2013 Koha Development Team <http://koha-community.org/>
2014
2015 =cut