Bug 17089: Improve errors handling
[srvgit] / C4 / Acquisition.pm
index 0bb34c6..6a2ed3e 100644 (file)
@@ -4,26 +4,24 @@ package C4::Acquisition;
 #
 # This file is part of Koha.
 #
-# Koha is free software; you can redistribute it and/or modify it under the
-# terms of the GNU General Public License as published by the Free Software
-# Foundation; either version 2 of the License, or (at your option) any later
-# version.
+# Koha is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
 #
-# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
-# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
-# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+# Koha is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
 #
-# You should have received a copy of the GNU General Public License along
-# with Koha; if not, write to the Free Software Foundation, Inc.,
-# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+# You should have received a copy of the GNU General Public License
+# along with Koha; if not, see <http://www.gnu.org/licenses>.
 
 
 use Modern::Perl;
 use Carp;
 use C4::Context;
 use C4::Debug;
-use C4::Dates qw(format_date format_date_in_iso);
-use MARC::Record;
 use C4::Suggestions;
 use C4::Biblio;
 use C4::Contract;
@@ -33,15 +31,18 @@ use Koha::DateUtils qw( dt_from_string output_pref );
 use Koha::Acquisition::Order;
 use Koha::Acquisition::Bookseller;
 use Koha::Number::Price;
+use Koha::Libraries;
+
+use C4::Koha;
+
+use MARC::Field;
+use MARC::Record;
 
 use Time::localtime;
-use HTML::Entities;
 
-use vars qw($VERSION @ISA @EXPORT);
+use vars qw(@ISA @EXPORT);
 
 BEGIN {
-    # set the version for version checking
-    $VERSION = 3.07.00.049;
     require Exporter;
     @ISA    = qw(Exporter);
     @EXPORT = qw(
@@ -62,7 +63,7 @@ BEGIN {
         &GetLateOrders &GetOrderFromItemnumber
         &SearchOrders &GetHistory &GetRecentAcqui
         &ModReceiveOrder &CancelReceipt
-        &GetCancelledOrders &TransferOrder
+        &TransferOrder
         &GetLastOrderNotReceivedFromSubscriptionid &GetLastOrderReceivedFromSubscriptionid
         &ModItemOrder
 
@@ -86,6 +87,8 @@ BEGIN {
         &GetOrderUsers
         &ModOrderUsers
         &NotifyOrderUsers
+
+        &FillWithDefaultValues
     );
 }
 
@@ -182,8 +185,8 @@ sub GetBasket {
 
 =head3 NewBasket
 
-  $basket = &NewBasket( $booksellerid, $authorizedby, $basketname, 
-      $basketnote, $basketbooksellernote, $basketcontractnumber, $deliveryplace, $billingplace );
+  $basket = &NewBasket( $booksellerid, $authorizedby, $basketname,
+      $basketnote, $basketbooksellernote, $basketcontractnumber, $deliveryplace, $billingplace, $is_standing );
 
 Create a new basket in aqbasket table
 
@@ -202,7 +205,7 @@ The other parameters are optional, see ModBasketHeader for more info on them.
 sub NewBasket {
     my ( $booksellerid, $authorisedby, $basketname, $basketnote,
         $basketbooksellernote, $basketcontractnumber, $deliveryplace,
-        $billingplace ) = @_;
+        $billingplace, $is_standing ) = @_;
     my $dbh = C4::Context->dbh;
     my $query =
         'INSERT INTO aqbasket (creationdate,booksellerid,authorisedby) '
@@ -214,7 +217,7 @@ sub NewBasket {
     $basketnote           ||= q{};
     $basketbooksellernote ||= q{};
     ModBasketHeader( $basket, $basketname, $basketnote, $basketbooksellernote,
-        $basketcontractnumber, $booksellerid, $deliveryplace, $billingplace );
+        $basketcontractnumber, $booksellerid, $deliveryplace, $billingplace, $is_standing );
     return $basket;
 }
 
@@ -231,24 +234,11 @@ close a basket (becomes unmodifiable, except for receives)
 sub CloseBasket {
     my ($basketno) = @_;
     my $dbh        = C4::Context->dbh;
-    my $query = "
-        UPDATE aqbasket
-        SET    closedate=now()
-        WHERE  basketno=?
-    ";
-    my $sth = $dbh->prepare($query);
-    $sth->execute($basketno);
+    $dbh->do('UPDATE aqbasket SET closedate=now() WHERE basketno=?', {}, $basketno );
 
-    my @orders = GetOrders($basketno);
-    foreach my $order (@orders) {
-        $query = qq{
-            UPDATE aqorders
-            SET orderstatus = 'ordered'
-            WHERE ordernumber = ?;
-        };
-        $sth = $dbh->prepare($query);
-        $sth->execute($order->{'ordernumber'});
-    }
+    $dbh->do( q{UPDATE aqorders SET orderstatus = 'ordered' WHERE basketno = ? AND orderstatus != 'complete'},
+        {}, $basketno);
+    return;
 }
 
 =head3 ReopenBasket
@@ -262,24 +252,15 @@ reopen a basket
 sub ReopenBasket {
     my ($basketno) = @_;
     my $dbh        = C4::Context->dbh;
-    my $query = "
-        UPDATE aqbasket
-        SET    closedate=NULL
-        WHERE  basketno=?
-    ";
-    my $sth = $dbh->prepare($query);
-    $sth->execute($basketno);
+    $dbh->do( q{UPDATE aqbasket SET closedate=NULL WHERE  basketno=?}, {}, $basketno );
 
-    my @orders = GetOrders($basketno);
-    foreach my $order (@orders) {
-        $query = qq{
-            UPDATE aqorders
-            SET orderstatus = 'new'
-            WHERE ordernumber = ?;
-        };
-        $sth = $dbh->prepare($query);
-        $sth->execute($order->{'ordernumber'});
-    }
+    $dbh->do( q{
+        UPDATE aqorders
+        SET orderstatus = 'new'
+        WHERE basketno = ?
+        AND orderstatus != 'complete'
+        }, {}, $basketno);
+    return;
 }
 
 #------------------------------------------------------------#
@@ -320,9 +301,12 @@ sub GetBasketAsCSV {
             notes => $order->{'order_vendornote'},
             quantity => $order->{'quantity'},
             rrp => $order->{'rrp'},
-            deliveryplace => C4::Branch::GetBranchName( $basket->{'deliveryplace'} ),
-            billingplace => C4::Branch::GetBranchName( $basket->{'billingplace'} ),
         };
+        for my $place ( qw( deliveryplace billingplace ) ) {
+            if ( my $library = Koha::Libraries->find( $row->{deliveryplace} ) ) {
+                $row->{$place} = $library->branchname
+            }
+        }
         foreach(qw(
             contractname author title publishercode collectiontitle notes
             deliveryplace billingplace
@@ -393,11 +377,18 @@ sub GetBasketGroupAsCSV {
                 booksellerpostal => $bookseller->{postal},
                 contractnumber => $contract->{contractnumber},
                 contractname => $contract->{contractname},
-                basketgroupdeliveryplace => C4::Branch::GetBranchName( $basketgroup->{deliveryplace} ),
-                basketgroupbillingplace => C4::Branch::GetBranchName( $basketgroup->{billingplace} ),
-                basketdeliveryplace => C4::Branch::GetBranchName( $basket->{deliveryplace} ),
-                basketbillingplace => C4::Branch::GetBranchName( $basket->{billingplace} ),
             };
+            my $temp = {
+                basketgroupdeliveryplace => $basketgroup->{deliveryplace},
+                basketgroupbillingplace  => $basketgroup->{billingplace},
+                basketdeliveryplace      => $basket->{deliveryplace},
+                basketbillingplace       => $basket->{billingplace},
+            };
+            for my $place (qw( basketgroupdeliveryplace basketgroupbillingplace basketdeliveryplace basketbillingplace )) {
+                if ( my $library = Koha::Libraries->find( $temp->{$place} ) ) {
+                    $row->{$place} = $library->branchname;
+                }
+            }
             foreach(qw(
                 basketname author title publishercode collectiontitle notes
                 booksellername bookselleraddress booksellerpostal contractname
@@ -549,21 +540,23 @@ Modifies a basket's header.
 
 =item C<$billingplace> is the "billingplace" field in the aqbasket table.
 
+=item C<$is_standing> is the "is_standing" field in the aqbasket table.
+
 =back
 
 =cut
 
 sub ModBasketHeader {
-    my ($basketno, $basketname, $note, $booksellernote, $contractnumber, $booksellerid, $deliveryplace, $billingplace) = @_;
+    my ($basketno, $basketname, $note, $booksellernote, $contractnumber, $booksellerid, $deliveryplace, $billingplace, $is_standing) = @_;
     my $query = qq{
         UPDATE aqbasket
-        SET basketname=?, note=?, booksellernote=?, booksellerid=?, deliveryplace=?, billingplace=?
+        SET basketname=?, note=?, booksellernote=?, booksellerid=?, deliveryplace=?, billingplace=?, is_standing=?
         WHERE basketno=?
     };
 
     my $dbh = C4::Context->dbh;
     my $sth = $dbh->prepare($query);
-    $sth->execute($basketname, $note, $booksellernote, $booksellerid, $deliveryplace, $billingplace, $basketno);
+    $sth->execute($basketname, $note, $booksellernote, $booksellerid, $deliveryplace, $billingplace, $is_standing, $basketno);
 
     if ( $contractnumber ) {
         my $query2 ="UPDATE aqbasket SET contractnumber=? WHERE basketno=?";
@@ -1036,43 +1029,75 @@ sub GetBasketgroups {
 
 =head3 GetOrders
 
-  @orders = &GetOrders($basketnumber, $orderby);
+  @orders = &GetOrders( $basketno, { orderby => 'biblio.title', cancelled => 0|1 } );
 
 Looks up the pending (non-cancelled) orders with the given basket
-number. If C<$booksellerID> is non-empty, only orders from that seller
-are returned.
+number.
 
-return :
-C<&basket> returns a two-element array. C<@orders> is an array of
-references-to-hash, whose keys are the fields from the aqorders,
-biblio, and biblioitems tables in the Koha database.
+If cancelled is set, only cancelled orders will be returned.
 
 =cut
 
 sub GetOrders {
-    my ( $basketno, $orderby ) = @_;
+    my ( $basketno, $params ) = @_;
+
     return () unless $basketno;
+
+    my $orderby = $params->{orderby};
+    my $cancelled = $params->{cancelled} || 0;
+
     my $dbh   = C4::Context->dbh;
-    my $query  ="
+    my $query = q|
         SELECT biblio.*,biblioitems.*,
                 aqorders.*,
                 aqbudgets.*,
+        |;
+    $query .= $cancelled
+      ? q|
+                aqorders_transfers.ordernumber_to AS transferred_to,
+                aqorders_transfers.timestamp AS transferred_to_timestamp
+    |
+      : q|
                 aqorders_transfers.ordernumber_from AS transferred_from,
                 aqorders_transfers.timestamp AS transferred_from_timestamp
+    |;
+    $query .= q|
         FROM    aqorders
             LEFT JOIN aqbudgets        ON aqbudgets.budget_id = aqorders.budget_id
             LEFT JOIN biblio           ON biblio.biblionumber = aqorders.biblionumber
             LEFT JOIN biblioitems      ON biblioitems.biblionumber =biblio.biblionumber
+    |;
+    $query .= $cancelled
+      ? q|
+            LEFT JOIN aqorders_transfers ON aqorders_transfers.ordernumber_from = aqorders.ordernumber
+    |
+      : q|
             LEFT JOIN aqorders_transfers ON aqorders_transfers.ordernumber_to = aqorders.ordernumber
+
+    |;
+    $query .= q|
         WHERE   basketno=?
+    |;
+
+    if ($cancelled) {
+        $orderby ||= q|biblioitems.publishercode, biblio.title|;
+        $query .= q|
+            AND (datecancellationprinted IS NOT NULL
+               AND datecancellationprinted <> '0000-00-00')
+        |;
+    }
+    else {
+        $orderby ||=
+          q|aqorders.datecancellationprinted desc, aqorders.timestamp desc|;
+        $query .= q|
             AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00')
-    ";
+        |;
+    }
 
-    $orderby = "biblioitems.publishercode,biblio.title" unless $orderby;
     $query .= " ORDER BY $orderby";
-    my $result_set =
+    my $orders =
       $dbh->selectall_arrayref( $query, { Slice => {} }, $basketno );
-    return @{$result_set};
+    return @{$orders};
 
 }
 
@@ -1247,8 +1272,7 @@ table of the Koha database.
 sub ModOrder {
     my $orderinfo = shift;
 
-    die "Ordernumber is required"     if $orderinfo->{'ordernumber'} eq  '' ;
-    die "Biblionumber is required"  if  $orderinfo->{'biblionumber'} eq '';
+    die "Ordernumber is required" if $orderinfo->{'ordernumber'} eq '';
 
     my $dbh = C4::Context->dbh;
     my @params;
@@ -1308,51 +1332,6 @@ sub ModItemOrder {
 
 #------------------------------------------------------------#
 
-=head3 GetCancelledOrders
-
-  my @orders = GetCancelledOrders($basketno, $orderby);
-
-Returns cancelled orders for a basket
-
-=cut
-
-sub GetCancelledOrders {
-    my ( $basketno, $orderby ) = @_;
-
-    return () unless $basketno;
-
-    my $dbh   = C4::Context->dbh;
-    my $query = "
-        SELECT
-            biblio.*,
-            biblioitems.*,
-            aqorders.*,
-            aqbudgets.*,
-            aqorders_transfers.ordernumber_to AS transferred_to,
-            aqorders_transfers.timestamp AS transferred_to_timestamp
-        FROM aqorders
-          LEFT JOIN aqbudgets   ON aqbudgets.budget_id = aqorders.budget_id
-          LEFT JOIN biblio      ON biblio.biblionumber = aqorders.biblionumber
-          LEFT JOIN biblioitems ON biblioitems.biblionumber = biblio.biblionumber
-          LEFT JOIN aqorders_transfers ON aqorders_transfers.ordernumber_from = aqorders.ordernumber
-        WHERE basketno = ?
-          AND (datecancellationprinted IS NOT NULL
-               AND datecancellationprinted <> '0000-00-00')
-    ";
-
-    $orderby = "aqorders.datecancellationprinted desc, aqorders.timestamp desc"
-        unless $orderby;
-    $query .= " ORDER BY $orderby";
-    my $sth = $dbh->prepare($query);
-    $sth->execute($basketno);
-    my $results = $sth->fetchall_arrayref( {} );
-
-    return @$results;
-}
-
-
-#------------------------------------------------------------#
-
 =head3 ModReceiveOrder
 
   &ModReceiveOrder({
@@ -1400,7 +1379,13 @@ sub ModReceiveOrder {
     my $order_vendornote = $params->{order_vendornote};
 
     my $dbh = C4::Context->dbh;
-    $datereceived = C4::Dates->output('iso') unless $datereceived;
+    $datereceived = output_pref(
+        {
+            dt => ( $datereceived ? dt_from_string( $datereceived ) : dt_from_string ),
+            dateformat => 'iso',
+            dateonly => 1,
+        }
+    );
     my $suggestionid = GetSuggestionFromBiblionumber( $biblionumber );
     if ($suggestionid) {
         ModSuggestion( {suggestionid=>$suggestionid,
@@ -1410,7 +1395,7 @@ sub ModReceiveOrder {
     }
 
     my $result_set = $dbh->selectall_arrayref(
-q{SELECT * FROM aqorders WHERE biblionumber=? AND aqorders.ordernumber=?},
+q{SELECT *, aqbasket.is_standing FROM aqorders LEFT JOIN aqbasket USING (basketno) WHERE biblionumber=? AND aqorders.ordernumber=?},
         { Slice => {} }, $biblionumber, $ordernumber
     );
 
@@ -1418,7 +1403,7 @@ q{SELECT * FROM aqorders WHERE biblionumber=? AND aqorders.ordernumber=?},
     my $order = $result_set->[0];
 
     my $new_ordernumber = $ordernumber;
-    if ( $order->{quantity} > $quantrec ) {
+    if ( $order->{is_standing} || $order->{quantity} > $quantrec ) {
         # Split order line in two parts: the first is the original order line
         # without received items (the quantity is decreased),
         # the second part is a new order line with quantity=quantityrec
@@ -1433,7 +1418,7 @@ q{SELECT * FROM aqorders WHERE biblionumber=? AND aqorders.ordernumber=?},
         my $sth = $dbh->prepare($query);
 
         $sth->execute(
-            $order->{quantity} - $quantrec,
+            ( $order->{is_standing} ? 1 : ( $order->{quantity} - $quantrec ) ),
             ( defined $order_internalnote ? $order_internalnote : () ),
             ( defined $order_vendornote ? $order_vendornote : () ),
             $ordernumber
@@ -1699,7 +1684,7 @@ sub SearchOrders {
             LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
     };
 
-    # If we search on ordernumber, we retrieve the transfered order if a transfer has been done.
+    # If we search on ordernumber, we retrieve the transferred order if a transfer has been done.
     $query .= q{
             LEFT JOIN aqorders_transfers ON aqorders_transfers.ordernumber_to = aqorders.ordernumber
     } if $ordernumber;
@@ -1709,10 +1694,20 @@ sub SearchOrders {
     };
 
     if ( $pending or $ordered ) {
-        $query .= q{ AND (quantity > quantityreceived OR quantityreceived is NULL)};
-    }
-    if ( $ordered ) {
-        $query .= q{ AND aqorders.orderstatus IN ( "ordered", "partial" )};
+        $query .= q{
+            AND (
+                ( aqbasket.is_standing AND aqorders.orderstatus IN ( "new", "ordered", "partial" ) )
+                OR (
+                    ( quantity > quantityreceived OR quantityreceived is NULL )
+        };
+
+        if ( $ordered ) {
+            $query .= q{ AND aqorders.orderstatus IN ( "ordered", "partial" )};
+        }
+        $query .= q{
+                )
+            )
+        };
     }
 
     my $userenv = C4::Context->userenv;
@@ -1815,7 +1810,7 @@ sub DelOrder {
 
     my @itemnumbers = GetItemnumbersFromOrder( $ordernumber );
     foreach my $itemnumber (@itemnumbers){
-        my $delcheck = C4::Items::DelItemCheck( $dbh, $bibnum, $itemnumber );
+        my $delcheck = C4::Items::DelItemCheck( $bibnum, $itemnumber );
 
         if($delcheck != 1) {
             $error->{'delitem'} = 1;
@@ -1845,11 +1840,11 @@ sub DelOrder {
     my $newordernumber = TransferOrder($ordernumber, $basketno);
 
 Transfer an order line to a basket.
-Mark $ordernumber as cancelled with an internal note 'Cancelled and transfered
+Mark $ordernumber as cancelled with an internal note 'Cancelled and transferred
 to BOOKSELLER on DATE' and create new order with internal note
-'Transfered from BOOKSELLER on DATE'.
+'Transferred from BOOKSELLER on DATE'.
 Move all attached items to the new order.
-Received orders cannot be transfered.
+Received orders cannot be transferred.
 Return the ordernumber of created order.
 
 =cut
@@ -1869,11 +1864,11 @@ sub TransferOrder {
 
     $query = q{
         UPDATE aqorders
-        SET datecancellationprinted = CAST(NOW() AS date)
+        SET datecancellationprinted = CAST(NOW() AS date), orderstatus = ?
         WHERE ordernumber = ?
     };
     $sth = $dbh->prepare($query);
-    $rv = $sth->execute($ordernumber);
+    $rv = $sth->execute('cancelled', $ordernumber);
 
     delete $order->{'ordernumber'};
     delete $order->{parent_ordernumber};
@@ -2501,6 +2496,10 @@ sub GetInvoices {
         push @bind_strs, " borrowers.branchcode = ? ";
         push @bind_args, $args{branchcode};
     }
+    if($args{message_id}) {
+        push @bind_strs, " aqinvoices.message_id = ? ";
+        push @bind_args, $args{message_id};
+    }
 
     $query .= " WHERE " . join(" AND ", @bind_strs) if @bind_strs;
     $query .= " GROUP BY aqinvoices.invoiceid ";
@@ -2625,7 +2624,7 @@ sub AddInvoice {
     return unless(%invoice and $invoice{invoicenumber});
 
     my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
-        closedate shipmentcost shipmentcost_budgetid);
+        closedate shipmentcost shipmentcost_budgetid message_id);
 
     my @set_strs;
     my @set_args;
@@ -2726,7 +2725,7 @@ sub CloseInvoice {
 
 Reopen an invoice
 
-Equivalent to ModInvoice(invoiceid => $invoiceid, closedate => C4::Dates->new()->output('iso'))
+Equivalent to ModInvoice(invoiceid => $invoiceid, closedate => output_pref({ dt=>dt_from_string, dateonly=>1, otputpref=>'iso' }))
 
 =cut
 
@@ -2973,14 +2972,14 @@ sub NotifyOrderUsers {
     my $order = GetOrder( $ordernumber );
     for my $borrowernumber (@borrowernumbers) {
         my $borrower = C4::Members::GetMember( borrowernumber => $borrowernumber );
-        my $branch = C4::Branch::GetBranchDetail( $borrower->{branchcode} );
+        my $library = Koha::Libraries->find( $borrower->{branchcode} )->unblessed;
         my $biblio = C4::Biblio::GetBiblio( $order->{biblionumber} );
         my $letter = C4::Letters::GetPreparedLetter(
             module      => 'acquisition',
             letter_code => 'ACQ_NOTIF_ON_RECEIV',
-            branchcode  => $branch->{branchcode},
+            branchcode  => $library->{branchcode},
             tables      => {
-                'branches'    => $branch,
+                'branches'    => $library,
                 'borrowers'   => $borrower,
                 'biblio'      => $biblio,
                 'aqorders'    => $order,
@@ -2999,6 +2998,51 @@ sub NotifyOrderUsers {
     }
 }
 
+=head3 FillWithDefaultValues
+
+FillWithDefaultValues( $marc_record );
+
+This will update the record with default value defined in the ACQ framework.
+For all existing fields, if a default value exists and there are no subfield, it will be created.
+If the field does not exist, it will be created too.
+
+=cut
+
+sub FillWithDefaultValues {
+    my ($record) = @_;
+    my $tagslib = C4::Biblio::GetMarcStructure( 1, 'ACQ' );
+    if ($tagslib) {
+        my ($itemfield) =
+          C4::Biblio::GetMarcFromKohaField( 'items.itemnumber', '' );
+        for my $tag ( sort keys %$tagslib ) {
+            next unless $tag;
+            next if $tag == $itemfield;
+            for my $subfield ( sort keys %{ $tagslib->{$tag} } ) {
+                next if IsMarcStructureInternal($tagslib->{$tag}{$subfield});
+                my $defaultvalue = $tagslib->{$tag}{$subfield}{defaultvalue};
+                if ( defined $defaultvalue and $defaultvalue ne '' ) {
+                    my @fields = $record->field($tag);
+                    if (@fields) {
+                        for my $field (@fields) {
+                            unless ( defined $field->subfield($subfield) ) {
+                                $field->add_subfields(
+                                    $subfield => $defaultvalue );
+                            }
+                        }
+                    }
+                    else {
+                        $record->insert_fields_ordered(
+                            MARC::Field->new(
+                                $tag, '', '', $subfield => $defaultvalue
+                            )
+                        );
+                    }
+                }
+            }
+        }
+    }
+}
+
 1;
 __END__