"Fossies" - the Fresh Open Source Software Archive

Member "koha-19.11.15/C4/Acquisition.pm" (23 Feb 2021, 105875 Bytes) of package /linux/misc/koha-19.11.15.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. For more information about "Acquisition.pm" see the Fossies "Dox" file reference documentation and the last Fossies "Diffs" side-by-side code changes report: 20.05.06_vs_20.11.00.

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