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