Bug 8521 - Error in warning message when deleting list
[srvgit] / C4 / Budgets.pm
index 1f7ad3a..e0e8f72 100644 (file)
@@ -1013,11 +1013,18 @@ sub ConvertCurrency {
 
   my $new_budget_period_id = CloneBudgetPeriod({
     budget_period_id => $budget_period_id,
-    budget_period_startdate => $budget_period_startdate;
-    $budget_period_enddate   => $budget_period_enddate;
+    budget_period_startdate => $budget_period_startdate,
+    budget_period_enddate   => $budget_period_enddate,
+    mark_original_budget_as_inactive => 1n
+    reset_all_budgets => 1,
   });
 
 Clone a budget period with all budgets.
+If the mark_origin_budget_as_inactive is set (0 by default),
+the original budget will be marked as inactive.
+
+If the reset_all_budgets is set (0 by default), all budget (fund)
+amounts will be reset.
 
 =cut
 
@@ -1026,19 +1033,45 @@ sub CloneBudgetPeriod {
     my $budget_period_id        = $params->{budget_period_id};
     my $budget_period_startdate = $params->{budget_period_startdate};
     my $budget_period_enddate   = $params->{budget_period_enddate};
+    my $mark_original_budget_as_inactive =
+      $params->{mark_original_budget_as_inactive} || 0;
+    my $reset_all_budgets = $params->{reset_all_budgets} || 0;
 
     my $budget_period = GetBudgetPeriod($budget_period_id);
 
     $budget_period->{budget_period_startdate} = $budget_period_startdate;
     $budget_period->{budget_period_enddate}   = $budget_period_enddate;
+    # The new budget (budget_period) should be active by default
+    $budget_period->{budget_period_active}    = 1;
     my $original_budget_period_id = $budget_period->{budget_period_id};
     delete $budget_period->{budget_period_id};
     my $new_budget_period_id = AddBudgetPeriod( $budget_period );
 
     my $budgets = GetBudgetHierarchy($budget_period_id);
     CloneBudgetHierarchy(
-        { budgets => $budgets, new_budget_period_id => $new_budget_period_id }
+        {
+            budgets              => $budgets,
+            new_budget_period_id => $new_budget_period_id
+        }
     );
+
+    if ($mark_original_budget_as_inactive) {
+        ModBudgetPeriod(
+            {
+                budget_period_id     => $budget_period_id,
+                budget_period_active => 0,
+            }
+        );
+    }
+
+    if ( $reset_all_budgets ) {
+        my $budgets = GetBudgets({ budget_period_id => $new_budget_period_id });
+        for my $budget ( @$budgets ) {
+            $budget->{budget_amount} = 0;
+            ModBudget( $budget );
+        }
+    }
+
     return $new_budget_period_id;
 }
 
@@ -1076,7 +1109,7 @@ sub CloneBudgetHierarchy {
 
         my $tidy_budget =
           { map { join( ' ', @columns ) =~ /$_/ ? ( $_ => $budget->{$_} ) : () }
-              keys($budget) };
+              keys %$budget };
         my $new_budget_id = AddBudget(
             {
                 %$tidy_budget,
@@ -1096,6 +1129,105 @@ sub CloneBudgetHierarchy {
     }
 }
 
+=head2 MoveOrders
+
+  my $report = MoveOrders({
+    from_budget_period_id => $from_budget_period_id,
+    to_budget_period_id   => $to_budget_period_id,
+  });
+
+Move orders from one budget period to another.
+
+=cut
+
+sub MoveOrders {
+    my ($params)              = @_;
+    my $from_budget_period_id = $params->{from_budget_period_id};
+    my $to_budget_period_id   = $params->{to_budget_period_id};
+    my $move_remaining_unspent = $params->{move_remaining_unspent};
+    return
+      if not $from_budget_period_id
+          or not $to_budget_period_id
+          or $from_budget_period_id == $to_budget_period_id;
+
+    # Can't move orders to an inactive budget (budgetperiod)
+    my $budget_period = GetBudgetPeriod($to_budget_period_id);
+    return unless $budget_period->{budget_period_active};
+
+    my @report;
+    my $dbh     = C4::Context->dbh;
+    my $sth_update_aqorders = $dbh->prepare(
+        q|
+            UPDATE aqorders
+            SET budget_id = ?
+            WHERE ordernumber = ?
+        |
+    );
+    my $sth_update_budget_amount = $dbh->prepare(
+        q|
+            UPDATE aqbudgets
+            SET budget_amount = ?
+            WHERE budget_id = ?
+        |
+    );
+    my $from_budgets = GetBudgetHierarchy($from_budget_period_id);
+    for my $from_budget (@$from_budgets) {
+        my $new_budget_id = $dbh->selectcol_arrayref(
+            q|
+                SELECT budget_id
+                FROM aqbudgets
+                WHERE budget_period_id = ?
+                    AND budget_code = ?
+            |, {}, $to_budget_period_id, $from_budget->{budget_code}
+        );
+        $new_budget_id = $new_budget_id->[0];
+        my $new_budget = GetBudget( $new_budget_id );
+        unless ( $new_budget ) {
+            push @report,
+              {
+                moved       => 0,
+                budget      => $from_budget,
+                error       => 'budget_code_not_exists',
+              };
+            next;
+        }
+        my $orders_to_move = C4::Acquisition::SearchOrders(
+            {
+                budget_id => $from_budget->{budget_id},
+                pending   => 1,
+            }
+        );
+
+        my @orders_moved;
+        for my $order (@$orders_to_move) {
+            $sth_update_aqorders->execute( $new_budget->{budget_id}, $order->{ordernumber} );
+            push @orders_moved, $order;
+        }
+
+        my $unspent_moved = 0;
+        if ($move_remaining_unspent) {
+            my $spent   = GetBudgetHierarchySpent( $from_budget->{budget_id} );
+            my $unspent = $from_budget->{budget_amount} - $spent;
+            my $new_budget_amount = $new_budget->{budget_amount};
+            if ( $unspent > 0 ) {
+                $new_budget_amount += $unspent;
+                $unspent_moved = $unspent;
+            }
+            $new_budget->{budget_amount} = $new_budget_amount;
+            $sth_update_budget_amount->execute( $new_budget_amount,
+                $new_budget->{budget_id} );
+        }
+
+        push @report,
+          {
+            budget        => $new_budget,
+            orders_moved  => \@orders_moved,
+            moved         => 1,
+            unspent_moved => $unspent_moved,
+          };
+    }
+    return \@report;
+}
 
 END { }    # module clean-up code here (global destructor)