Koha/C4/Budgets.pm

package C4::Budgets;

# Copyright 2000-2002 Katipo Communications
#
# 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 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.
#
# 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 C4::Context;
use Koha::Database;
use Koha::Patrons;
use Koha::Acquisition::Invoice::Adjustments;
use C4::Acquisition;

our (@ISA, @EXPORT_OK);
BEGIN {
    require Exporter;
    @ISA       = qw(Exporter);
    @EXPORT_OK = qw(

      GetBudget
      GetBudgetByOrderNumber
      GetBudgetByCode
      GetBudgets
      BudgetsByActivity
      GetBudgetsReport
      GetBudgetReport
      GetBudgetsByActivity
      GetBudgetHierarchy
      AddBudget
      ModBudget
      DelBudget
      GetBudgetSpent
      GetBudgetOrdered
      GetBudgetName
      GetPeriodsCount
      GetBudgetHierarchySpent
      GetBudgetHierarchyOrdered

      GetBudgetUsers
      ModBudgetUsers
      CanUserUseBudget
      CanUserModifyBudget

      GetBudgetPeriod
      GetBudgetPeriods
      ModBudgetPeriod
      AddBudgetPeriod
      DelBudgetPeriod

      ModBudgetPlan

      GetBudgetsPlanCell
      AddBudgetPlanValue
      GetBudgetAuthCats
      BudgetHasChildren
      GetBudgetChildren
      SetOwnerToFundHierarchy
      CheckBudgetParent
      CheckBudgetParentPerm

      HideCols
      GetCols

      CloneBudgetPeriod
      CloneBudgetHierarchy
      MoveOrders
    );
}

# ----------------------------BUDGETS.PM-----------------------------";

=head1 FUNCTIONS ABOUT BUDGETS

=cut

sub HideCols {
    my ( $authcat, @hide_cols ) = @_;
    my $dbh = C4::Context->dbh;

    my $sth1 = $dbh->prepare(
        qq|
        UPDATE aqbudgets_planning SET display = 0 
        WHERE authcat = ? 
        AND  authvalue = ? |
    );
    foreach my $authvalue (@hide_cols) {
#        $sth1->{TraceLevel} = 3;
        $sth1->execute(  $authcat, $authvalue );
    }
}

sub GetCols {
    my ( $authcat, $authvalue ) = @_;

    my $dbh = C4::Context->dbh;
    my $sth = $dbh->prepare(
        qq|
        SELECT count(display) as cnt from aqbudgets_planning
        WHERE  authcat = ? 
        AND authvalue = ? and display  = 0   |
    );

#    $sth->{TraceLevel} = 3;
    $sth->execute( $authcat, $authvalue );
    my $res  = $sth->fetchrow_hashref;

    return  $res->{cnt} > 0 ? 0: 1

}

sub CheckBudgetParentPerm {
    my ( $budget, $borrower_id ) = @_;
    my $depth = $budget->{depth};
    my $parent_id = $budget->{budget_parent_id};
    while ($depth) {
        my $parent = GetBudget($parent_id);
        $parent_id = $parent->{budget_parent_id};
        if ( $parent->{budget_owner_id} == $borrower_id ) {
            return 1;
        }
        $depth--
    }
    return 0;
}

sub AddBudgetPeriod {
    my ($budgetperiod) = @_;
    return unless($budgetperiod->{budget_period_startdate} && $budgetperiod->{budget_period_enddate});

    undef $budgetperiod->{budget_period_id};
    my $resultset = Koha::Database->new()->schema->resultset('Aqbudgetperiod');
    return $resultset->create($budgetperiod)->id;
}
# -------------------------------------------------------------------
sub GetPeriodsCount {
    my $dbh = C4::Context->dbh;
    my $sth = $dbh->prepare("
        SELECT COUNT(*) AS sum FROM aqbudgetperiods ");
    $sth->execute();
    my $res = $sth->fetchrow_hashref;
    return $res->{'sum'};
}

# -------------------------------------------------------------------
sub CheckBudgetParent {
    my ( $new_parent, $budget ) = @_;
    my $new_parent_id = $new_parent->{'budget_id'};
    my $budget_id     = $budget->{'budget_id'};
    my $dbh           = C4::Context->dbh;
    my $parent_id_tmp = $new_parent_id;

    # check new-parent is not a child (or a child's child ;)
    my $sth = $dbh->prepare(qq|
        SELECT budget_parent_id FROM
            aqbudgets where budget_id = ? | );
    while (1) {
        $sth->execute($parent_id_tmp);
        my $res = $sth->fetchrow_hashref;
        if ( $res->{'budget_parent_id'} == $budget_id ) {
            return 1;
        }
        if ( not defined $res->{'budget_parent_id'} ) {
            return 0;
        }
        $parent_id_tmp = $res->{'budget_parent_id'};
    }
}

# -------------------------------------------------------------------
sub BudgetHasChildren {
    my ( $budget_id  ) = @_;
    my $dbh = C4::Context->dbh;
    my $sth = $dbh->prepare(qq|
       SELECT count(*) as sum FROM  aqbudgets
        WHERE budget_parent_id = ?   | );
    $sth->execute( $budget_id );
    my $sum = $sth->fetchrow_hashref;
    return $sum->{'sum'};
}

sub GetBudgetChildren {
    my ( $budget_id ) = @_;
    my $dbh = C4::Context->dbh;
    return $dbh->selectall_arrayref(q|
       SELECT  * FROM  aqbudgets
        WHERE budget_parent_id = ?
    |, { Slice => {} }, $budget_id );
}

sub SetOwnerToFundHierarchy {
    my ( $budget_id, $borrowernumber ) = @_;

    my $budget = GetBudget( $budget_id );
    $budget->{budget_owner_id} = $borrowernumber;
    ModBudget( $budget );
    my $children = GetBudgetChildren( $budget_id );
    for my $child ( @$children ) {
        SetOwnerToFundHierarchy( $child->{budget_id}, $borrowernumber );
    }
}

# -------------------------------------------------------------------
sub GetBudgetsPlanCell {
    my ( $cell, $period, $budget ) = @_; #FIXME we don't use $period
    my ($actual, $sth);
    my $dbh = C4::Context->dbh;
    my $roundsql = C4::Acquisition::get_rounding_sql(qq|ecost_tax_included|);
    if ( $cell->{'authcat'} eq 'MONTHS' ) {
        # get the actual amount
        # FIXME we should consider quantity
        $sth = $dbh->prepare( qq|

            SELECT SUM(| .  $roundsql . qq|) AS actual FROM aqorders
                WHERE    budget_id = ? AND
                entrydate like "$cell->{'authvalue'}%"  |
        );
        $sth->execute( $cell->{'budget_id'} );
    } elsif ( $cell->{'authcat'} eq 'BRANCHES' ) {
        # get the actual amount
        # FIXME we should consider quantity
        $sth = $dbh->prepare( qq|

            SELECT SUM(| . $roundsql . qq|) FROM aqorders
                LEFT JOIN aqorders_items
                ON (aqorders.ordernumber = aqorders_items.ordernumber)
                LEFT JOIN items
                ON (aqorders_items.itemnumber = items.itemnumber)
                WHERE budget_id = ? AND homebranch = ? |          );

        $sth->execute( $cell->{'budget_id'}, $cell->{'authvalue'} );
    } elsif ( $cell->{'authcat'} eq 'ITEMTYPES' ) {
        # get the actual amount
        $sth = $dbh->prepare(  qq|

            SELECT SUM( | . $roundsql . qq| *  quantity) AS actual
                FROM aqorders JOIN biblioitems
                ON (biblioitems.biblionumber = aqorders.biblionumber )
                WHERE aqorders.budget_id = ? and itemtype  = ? |
        );
        $sth->execute(  $cell->{'budget_id'},
                        $cell->{'authvalue'} );
    }
    # ELSE GENERIC ORDERS SORT1/SORT2 STAT COUNT.
    else {
        # get the actual amount
        $sth = $dbh->prepare( qq|

        SELECT  SUM(| . $roundsql . qq| * quantity) AS actual
            FROM aqorders
            JOIN aqbudgets ON (aqbudgets.budget_id = aqorders.budget_id )
            WHERE  aqorders.budget_id = ? AND
                ((aqbudgets.sort1_authcat = ? AND sort1 =?) OR
                (aqbudgets.sort2_authcat = ? AND sort2 =?))    |
        );
        $sth->execute(  $cell->{'budget_id'},
                        $budget->{'sort1_authcat'},
                        $cell->{'authvalue'},
                        $budget->{'sort2_authcat'},
                        $cell->{'authvalue'}
        );
    }
    $actual = $sth->fetchrow_array;

    # get the estimated amount
    $sth = $dbh->prepare( qq|

        SELECT estimated_amount AS estimated, display FROM aqbudgets_planning
            WHERE budget_period_id = ? AND
                budget_id = ? AND
                authvalue = ? AND
                authcat = ?         |
    );
    $sth->execute(  $cell->{'budget_period_id'},
                    $cell->{'budget_id'},
                    $cell->{'authvalue'},
                    $cell->{'authcat'},
    );


    my $res  = $sth->fetchrow_hashref;
  #  my $display = $res->{'display'};
    my $estimated = $res->{'estimated'};


    return $actual, $estimated;
}

# -------------------------------------------------------------------
sub ModBudgetPlan {
    my ( $budget_plan, $budget_period_id, $authcat ) = @_;
    my $dbh = C4::Context->dbh;
    foreach my $buds (@$budget_plan) {
        my $lines = $buds->{lines};
        my $sth = $dbh->prepare( qq|
                DELETE FROM aqbudgets_planning
                    WHERE   budget_period_id   = ? AND
                            budget_id   = ? AND
                            authcat            = ? |
        );
    #delete a aqplan line of cells, then insert new cells, 
    # these could be UPDATES rather than DEL/INSERTS...
        $sth->execute( $budget_period_id,  $lines->[0]{budget_id}   , $authcat );

        foreach my $cell (@$lines) {
            my $sth = $dbh->prepare( qq|

                INSERT INTO aqbudgets_planning
                     SET   budget_id     = ?,
                     budget_period_id  = ?,
                     authcat          = ?,
                     estimated_amount  = ?,
                     authvalue       = ?  |
            );
            $sth->execute(
                            $cell->{'budget_id'},
                            $cell->{'budget_period_id'},
                            $cell->{'authcat'},
                            $cell->{'estimated_amount'},
                            $cell->{'authvalue'},
            );
        }
    }
}

# -------------------------------------------------------------------
sub GetBudgetSpent {
    my ($budget_id) = @_;
    my $dbh = C4::Context->dbh;
    # unitprice_tax_included should always been set here
    # we should not need to retrieve ecost_tax_included
    my $sth = $dbh->prepare(qq|
        SELECT SUM( | . C4::Acquisition::get_rounding_sql("COALESCE(unitprice_tax_included, ecost_tax_included)") . qq| * quantity ) AS sum FROM aqorders
            WHERE budget_id = ? AND
            quantityreceived > 0 AND
            datecancellationprinted IS NULL
    |);
	$sth->execute($budget_id);
    my $sum = ( $sth->fetchrow_array || 0 ) + 0;

    $sth = $dbh->prepare(qq|
        SELECT SUM(shipmentcost) AS sum
        FROM aqinvoices
        WHERE shipmentcost_budgetid = ?
    |);

    $sth->execute($budget_id);
    my ($shipmentcost_sum) = $sth->fetchrow_array;
    $sum += ( $shipmentcost_sum || 0 ) + 0;

    my $adjustments = Koha::Acquisition::Invoice::Adjustments->search({budget_id => $budget_id, closedate => { '!=' => undef } },{ join => 'invoiceid' });
    while ( my $adj = $adjustments->next ){
        $sum += $adj->adjustment;
    }

	return $sum;
}

# -------------------------------------------------------------------
sub GetBudgetOrdered {
	my ($budget_id) = @_;
	my $dbh = C4::Context->dbh;
	my $sth = $dbh->prepare(qq|
        SELECT SUM(| . C4::Acquisition::get_rounding_sql(qq|ecost_tax_included|) . qq| *  quantity) AS sum FROM aqorders
            WHERE budget_id = ? AND
            quantityreceived = 0 AND
            datecancellationprinted IS NULL
    |);
	$sth->execute($budget_id);
    my $sum =  ( $sth->fetchrow_array || 0 ) + 0;

    my $adjustments = Koha::Acquisition::Invoice::Adjustments->search({budget_id => $budget_id, encumber_open => 1, closedate => undef},{ join => 'invoiceid' });
    while ( my $adj = $adjustments->next ){
        $sum += $adj->adjustment;
    }

	return $sum;
}

=head2 GetBudgetName

  my $budget_name = &GetBudgetName($budget_id);

get the budget_name for a given budget_id

=cut

sub GetBudgetName {
    my ( $budget_id ) = @_;
    my $dbh         = C4::Context->dbh;
    my $sth         = $dbh->prepare(
        qq|
        SELECT budget_name
        FROM aqbudgets
        WHERE budget_id = ?
    |);

    $sth->execute($budget_id);
    return $sth->fetchrow_array;
}

=head2 GetBudgetAuthCats

  my $auth_cats = &GetBudgetAuthCats($budget_period_id);

Return the list of authcat for a given budget_period_id

=cut

sub GetBudgetAuthCats  {
    my ($budget_period_id) = shift;
    # now, populate the auth_cats_loop used in the budget planning button
    # we must retrieve all auth values used by at least one budget
    my $dbh = C4::Context->dbh;
    my $sth=$dbh->prepare("SELECT sort1_authcat,sort2_authcat FROM aqbudgets WHERE budget_period_id=?");
    $sth->execute($budget_period_id);
    my %authcats;
    while (my ($sort1_authcat,$sort2_authcat) = $sth->fetchrow) {
        $authcats{$sort1_authcat}=1 if $sort1_authcat;
        $authcats{$sort2_authcat}=1 if $sort2_authcat;
    }
    return [ sort keys %authcats ];
}

# -------------------------------------------------------------------
sub GetBudgetPeriods {
	my ($filters,$orderby) = @_;

    my $rs = Koha::Database->new()->schema->resultset('Aqbudgetperiod');
    $rs = $rs->search( $filters, { order_by => $orderby } );
    $rs->result_class('DBIx::Class::ResultClass::HashRefInflator');
    return [ $rs->all ];
}
# -------------------------------------------------------------------
sub GetBudgetPeriod {
    my ($budget_period_id) = @_;
    my $dbh = C4::Context->dbh;
    my $sth = $dbh->prepare( qq|
        SELECT      *
        FROM aqbudgetperiods
        WHERE budget_period_id=? |
    );
    $sth->execute($budget_period_id);
    return $sth->fetchrow_hashref;
}

sub DelBudgetPeriod{
	my ($budget_period_id) = @_;
	my $dbh = C4::Context->dbh;
	  ; ## $total = number of records linked to the record that must be deleted
    my $total = 0;

	## get information about the record that will be deleted
	my $sth = $dbh->prepare(qq|
		DELETE 
         FROM aqbudgetperiods
         WHERE budget_period_id=? |
	);
	return $sth->execute($budget_period_id);
}

# -------------------------------------------------------------------
sub ModBudgetPeriod {
    my ($budget_period) = @_;
    my $result = Koha::Database->new()->schema->resultset('Aqbudgetperiod')->find($budget_period);
    return unless($result);

    $result = $result->update($budget_period);
    return $result->in_storage;
}

# -------------------------------------------------------------------
sub GetBudgetHierarchy {
    my ( $budget_period_id, $branchcode, $owner ) = @_;
    my @bind_params;
    my $dbh   = C4::Context->dbh;
    my $query = qq|
                    SELECT aqbudgets.*, aqbudgetperiods.budget_period_active, aqbudgetperiods.budget_period_description,
                           b.firstname as budget_owner_firstname, b.surname as budget_owner_surname, b.borrowernumber as budget_owner_borrowernumber
                    FROM aqbudgets 
                    LEFT JOIN borrowers b on b.borrowernumber = aqbudgets.budget_owner_id
                    JOIN aqbudgetperiods USING (budget_period_id)|;

	my @where_strings;
    # show only period X if requested
    if ($budget_period_id) {
        push @where_strings," aqbudgets.budget_period_id = ?";
        push @bind_params, $budget_period_id;
    }
	# show only budgets owned by me, my branch or everyone
    if ($owner) {
        if ($branchcode) {
            push @where_strings,
            qq{ (budget_owner_id = ? OR budget_branchcode = ? OR ((budget_branchcode IS NULL or budget_branchcode="") AND (budget_owner_id IS NULL OR budget_owner_id="")))};
            push @bind_params, ( $owner, $branchcode );
        } else {
            push @where_strings, ' (budget_owner_id = ? OR budget_owner_id IS NULL or budget_owner_id ="") ';
            push @bind_params, $owner;
        }
    } else {
        if ($branchcode) {
            push @where_strings," (budget_branchcode =? or budget_branchcode is NULL OR budget_branchcode='')";
            push @bind_params, $branchcode;
        }
    }
	$query.=" WHERE ".join(' AND ', @where_strings) if @where_strings;
	my $sth = $dbh->prepare($query);
	$sth->execute(@bind_params);

    my %links;
    # create hash with budget_id has key
    while ( my $data = $sth->fetchrow_hashref ) {
        $links{ $data->{'budget_id'} } = $data;
    }

    # link child to parent
    my @first_parents;
    foreach my $budget ( sort { $a->{budget_code} cmp $b->{budget_code} } values %links ) {
        my $child = $links{$budget->{budget_id}};
        if ( $child->{'budget_parent_id'} ) {
            my $parent = $links{ $child->{'budget_parent_id'} };
            if ($parent) {
                unless ( $parent->{'children'} ) {
                    # init child arrayref
                    $parent->{'children'} = [];
                }
                # add as child
                push @{ $parent->{'children'} }, $child;
            }
        } else {
            push @first_parents, $child;
        }
    }

    my @sort = ();
    foreach my $first_parent (@first_parents) {
        _add_budget_children(\@sort, $first_parent, 0);
    }

    # Get all the budgets totals in as few queries as possible
    my $hr_budget_spent = $dbh->selectall_hashref(q|
        SELECT aqorders.budget_id, aqbudgets.budget_parent_id,
               SUM( | . C4::Acquisition::get_rounding_sql(qq|COALESCE(unitprice_tax_included, ecost_tax_included)|) . q| * quantity ) AS budget_spent
        FROM aqorders JOIN aqbudgets USING (budget_id)
        WHERE quantityreceived > 0 AND datecancellationprinted IS NULL
        GROUP BY budget_id, budget_parent_id
        |, 'budget_id');
    my $hr_budget_ordered = $dbh->selectall_hashref(q|
        SELECT aqorders.budget_id, aqbudgets.budget_parent_id,
               SUM( | . C4::Acquisition::get_rounding_sql(qq|ecost_tax_included|) . q| *  quantity) AS budget_ordered
        FROM aqorders JOIN aqbudgets USING (budget_id)
        WHERE quantityreceived = 0 AND datecancellationprinted IS NULL
        GROUP BY budget_id, budget_parent_id
        |, 'budget_id');
    my $hr_budget_spent_shipment = $dbh->selectall_hashref(q|
        SELECT shipmentcost_budgetid as budget_id,
               SUM(shipmentcost) as shipmentcost
        FROM aqinvoices
        GROUP BY shipmentcost_budgetid
        |, 'budget_id');
    my $hr_budget_spent_adjustment = $dbh->selectall_hashref(q|
        SELECT budget_id,
               SUM(adjustment) as adjustments
        FROM aqinvoice_adjustments
        JOIN aqinvoices USING (invoiceid)
        WHERE closedate IS NOT NULL
        GROUP BY budget_id
        |, 'budget_id');
    my $hr_budget_ordered_adjustment = $dbh->selectall_hashref(q|
        SELECT budget_id,
               SUM(adjustment) as adjustments
        FROM aqinvoice_adjustments
        JOIN aqinvoices USING (invoiceid)
        WHERE closedate IS NULL AND encumber_open = 1
        GROUP BY budget_id
        |, 'budget_id');


    foreach my $budget (@sort) {
        if ( not defined $budget->{budget_parent_id} ) {
            _recursiveAdd( $budget, undef, $hr_budget_spent, $hr_budget_spent_shipment, $hr_budget_ordered, $hr_budget_spent_adjustment, $hr_budget_ordered_adjustment );
        }
    }
    return \@sort;
}

sub _recursiveAdd {
    my ($budget, $parent, $hr_budget_spent, $hr_budget_spent_shipment, $hr_budget_ordered, $hr_budget_spent_adjustment, $hr_budget_ordered_adjustment ) = @_;

    foreach my $child (@{$budget->{children}}){
        _recursiveAdd($child, $budget, $hr_budget_spent, $hr_budget_spent_shipment, $hr_budget_ordered, $hr_budget_spent_adjustment, $hr_budget_ordered_adjustment );
    }

    $budget->{budget_spent} += $hr_budget_spent->{$budget->{budget_id}}->{budget_spent}               || 0;
    $budget->{budget_spent} += $hr_budget_spent_shipment->{$budget->{budget_id}}->{shipmentcost}      || 0;
    $budget->{budget_spent} += $hr_budget_spent_adjustment->{$budget->{budget_id}}->{adjustments}     || 0;
    $budget->{budget_ordered} += $hr_budget_ordered->{$budget->{budget_id}}->{budget_ordered}         || 0;
    $budget->{budget_ordered} += $hr_budget_ordered_adjustment->{$budget->{budget_id}}->{adjustments} || 0;

    $budget->{total_spent} += $budget->{budget_spent};
    $budget->{total_ordered} += $budget->{budget_ordered};

    if ($parent) {
        $parent->{total_spent} += $budget->{total_spent};
        $parent->{total_ordered} += $budget->{total_ordered};
    }
}

# Recursive method to add a budget and its chidren to an array
sub _add_budget_children {
    my $res = shift;
    my $budget = shift;
    $budget->{budget_level} = shift;
    push @$res, $budget;
    my $children = $budget->{'children'} || [];
    return unless @$children; # break recursivity
    foreach my $child (@$children) {
        _add_budget_children($res, $child, $budget->{budget_level} + 1);
    }
}

# -------------------------------------------------------------------
# FIXME Must be replaced by Koha::Acquisition::Fund->store
sub AddBudget {
    my ($budget) = @_;
    return unless ($budget);

    undef $budget->{budget_encumb}   if defined $budget->{budget_encumb}   && $budget->{budget_encumb}   eq '';
    undef $budget->{budget_owner_id} if defined $budget->{budget_owner_id} && $budget->{budget_owner_id} eq '';
    my $resultset = Koha::Database->new()->schema->resultset('Aqbudget');
    return $resultset->create($budget)->id;
}

# -------------------------------------------------------------------
# FIXME Must be replaced by Koha::Acquisition::Fund->store
sub ModBudget {
    my ($budget) = @_;
    my $result = Koha::Database->new()->schema->resultset('Aqbudget')->find($budget);
    return unless($result);

    undef $budget->{budget_encumb}   if defined $budget->{budget_encumb}   && $budget->{budget_encumb}   eq '';
    undef $budget->{budget_owner_id} if defined $budget->{budget_owner_id} && $budget->{budget_owner_id} eq '';
    $result = $result->update($budget);
    return $result->in_storage;
}

# -------------------------------------------------------------------
# FIXME Must be replaced by Koha::Acquisition::Fund->delete
sub DelBudget {
	my ($budget_id) = @_;
	my $dbh         = C4::Context->dbh;
	my $sth         = $dbh->prepare("delete from aqbudgets where budget_id=?");
	my $rc          = $sth->execute($budget_id);
	return $rc;
}


# -------------------------------------------------------------------

=head2 GetBudget

  &GetBudget($budget_id);

get a specific budget

=cut

sub GetBudget {
    my ( $budget_id ) = @_;
    my $dbh = C4::Context->dbh;
    my $query = "
        SELECT *
        FROM   aqbudgets
        WHERE  budget_id=?
        ";
    my $sth = $dbh->prepare($query);
    $sth->execute( $budget_id );
    my $result = $sth->fetchrow_hashref;
    return $result;
}

# -------------------------------------------------------------------

=head2 GetBudgetByOrderNumber

  &GetBudgetByOrderNumber($ordernumber);

get a specific budget by order number

=cut

sub GetBudgetByOrderNumber {
    my ( $ordernumber ) = @_;
    my $dbh = C4::Context->dbh;
    my $query = "
        SELECT aqbudgets.*
        FROM   aqbudgets, aqorders
        WHERE  ordernumber=?
        AND    aqorders.budget_id = aqbudgets.budget_id
        ";
    my $sth = $dbh->prepare($query);
    $sth->execute( $ordernumber );
    my $result = $sth->fetchrow_hashref;
    return $result;
}

=head2 GetBudgetReport

  &GetBudgetReport( [$budget_id] );

Get all orders for a specific budget, without cancelled orders.

Returns an array of hashrefs.

=cut

# --------------------------------------------------------------------
sub GetBudgetReport {
    my ( $budget_id ) = @_;
    my $dbh = C4::Context->dbh;
    my $query = '
        SELECT o.*, b.budget_name
        FROM   aqbudgets b
        INNER JOIN aqorders o
        ON b.budget_id = o.budget_id
        WHERE  b.budget_id=?
        AND (o.orderstatus != "cancelled")
        ORDER BY b.budget_name';

    my $sth = $dbh->prepare($query);
    $sth->execute( $budget_id );

    my @results = ();
    while ( my $data = $sth->fetchrow_hashref ) {
        push( @results, $data );
    }
    return @results;
}

=head2 GetBudgetsByActivity

  &GetBudgetsByActivity( $budget_period_active );

Get all active or inactive budgets, depending of the value
of the parameter.

1 = active
0 = inactive

=cut

# --------------------------------------------------------------------
sub GetBudgetsByActivity {
    my ( $budget_period_active ) = @_;
    my $dbh = C4::Context->dbh;
    my $query = "
        SELECT DISTINCT b.*
        FROM   aqbudgetperiods bp
        INNER JOIN aqbudgets b
        ON bp.budget_period_id = b.budget_period_id
        WHERE  bp.budget_period_active=?
        ";
    my $sth = $dbh->prepare($query);
    $sth->execute( $budget_period_active );
    my @results = ();
    while ( my $data = $sth->fetchrow_hashref ) {
        push( @results, $data );
    }
    return @results;
}
# --------------------------------------------------------------------

=head2 GetBudgetsReport

  &GetBudgetsReport( [$activity] );

Get all but cancelled orders for all funds.

If the optionnal activity parameter is passed, returns orders for active/inactive budgets only.

active = 1
inactive = 0

Returns an array of hashrefs.

=cut

sub GetBudgetsReport {
    my ($activity) = @_;
    my $dbh = C4::Context->dbh;
    my $query = '
        SELECT o.*, b.budget_name
        FROM   aqbudgetperiods bp
        INNER JOIN aqbudgets b
        ON bp.budget_period_id = b.budget_period_id
        INNER JOIN aqorders o
        ON b.budget_id = o.budget_id ';
    if ( $activity && $activity ne '' ) {
        $query .= 'WHERE  bp.budget_period_active=? ';
    }
    $query .= 'AND (o.orderstatus != "cancelled")
               ORDER BY b.budget_name';

    my $sth = $dbh->prepare($query);
    if ( $activity && $activity ne '' ) {
        $sth->execute($activity);
    }
    else{
        $sth->execute;
    }
    my @results = ();
    while ( my $data = $sth->fetchrow_hashref ) {
        push( @results, $data );
    }
    return @results;
}

=head2 GetBudgetByCode

    my $budget = &GetBudgetByCode($budget_code);

Retrieve all aqbudgets fields as a hashref for the budget that has
given budget_code

=cut

sub GetBudgetByCode {
    my ( $budget_code ) = @_;

    my $dbh = C4::Context->dbh;
    my $query = qq{
        SELECT aqbudgets.*
        FROM aqbudgets
        JOIN aqbudgetperiods USING (budget_period_id)
        WHERE budget_code = ?
        ORDER BY budget_period_active DESC, budget_id DESC
        LIMIT 1
    };
    my $sth = $dbh->prepare( $query );
    $sth->execute( $budget_code );
    return $sth->fetchrow_hashref;
}

=head2 GetBudgetHierarchySpent

  my $spent = GetBudgetHierarchySpent( $budget_id );

Gets the total spent of the level and sublevels of $budget_id

=cut

sub GetBudgetHierarchySpent {
    my ( $budget_id ) = @_;
    my $dbh = C4::Context->dbh;
    my $children_ids = $dbh->selectcol_arrayref(q|
        SELECT budget_id
        FROM   aqbudgets
        WHERE  budget_parent_id = ?
    |, {}, $budget_id );

    my $total_spent = GetBudgetSpent( $budget_id );
    for my $child_id ( @$children_ids ) {
        $total_spent += GetBudgetHierarchySpent( $child_id );
    }
    return $total_spent;
}

=head2 GetBudgetHierarchyOrdered

  my $ordered = GetBudgetHierarchyOrdered( $budget_id );

Gets the total ordered of the level and sublevels of $budget_id

=cut

sub GetBudgetHierarchyOrdered {
    my ( $budget_id ) = @_;
    my $dbh = C4::Context->dbh;
    my $children_ids = $dbh->selectcol_arrayref(q|
        SELECT budget_id
        FROM   aqbudgets
        WHERE  budget_parent_id = ?
    |, {}, $budget_id );

    my $total_ordered = GetBudgetOrdered( $budget_id );
    for my $child_id ( @$children_ids ) {
        $total_ordered += GetBudgetHierarchyOrdered( $child_id );
    }
    return $total_ordered;
}

=head2 GetBudgets

  &GetBudgets($filter, $order_by);

gets all budgets

=cut

# -------------------------------------------------------------------
sub GetBudgets {
    my ($filters, $orderby) = @_;
    $orderby = 'budget_name' unless($orderby);

    my $rs = Koha::Database->new()->schema->resultset('Aqbudget');
    $rs = $rs->search( $filters, { order_by => $orderby } );
    $rs->result_class('DBIx::Class::ResultClass::HashRefInflator');
    return [ $rs->all  ];
}

=head2 GetBudgetUsers

    my @borrowernumbers = &GetBudgetUsers($budget_id);

Return the list of borrowernumbers linked to a budget

=cut

sub GetBudgetUsers {
    my ($budget_id) = @_;

    my $dbh = C4::Context->dbh;
    my $query = qq{
        SELECT borrowernumber
        FROM aqbudgetborrowers
        WHERE budget_id = ?
    };
    my $sth = $dbh->prepare($query);
    $sth->execute($budget_id);

    my @borrowernumbers;
    while (my ($borrowernumber) = $sth->fetchrow_array) {
        push @borrowernumbers, $borrowernumber
    }

    return @borrowernumbers;
}

=head2 ModBudgetUsers

    &ModBudgetUsers($budget_id, @borrowernumbers);

Modify the list of borrowernumbers linked to a budget

=cut

sub ModBudgetUsers {
    my ($budget_id, @budget_users_id) = @_;

    return unless $budget_id;

    my $dbh = C4::Context->dbh;
    my $query = "DELETE FROM aqbudgetborrowers WHERE budget_id = ?";
    my $sth = $dbh->prepare($query);
    $sth->execute($budget_id);

    $query = qq{
        INSERT INTO aqbudgetborrowers (budget_id, borrowernumber)
        VALUES (?,?)
    };
    $sth = $dbh->prepare($query);
    foreach my $borrowernumber (@budget_users_id) {
        next unless $borrowernumber;
        $sth->execute($budget_id, $borrowernumber);
    }
}

sub CanUserUseBudget {
    my ($borrower, $budget, $userflags) = @_;

    if (not ref $borrower) {
        $borrower = Koha::Patrons->find( $borrower );
        return 0 unless $borrower;
        $borrower = $borrower->unblessed;
    }
    if (not ref $budget) {
        $budget = GetBudget($budget);
    }

    return 0 unless ($borrower and $budget);

    if (not defined $userflags) {
        $userflags = C4::Auth::getuserflags($borrower->{flags},
            $borrower->{userid});
    }

    unless ($userflags->{superlibrarian}
    || (ref $userflags->{acquisition}
        && $userflags->{acquisition}->{budget_manage_all})
    || (!ref $userflags->{acquisition} && $userflags->{acquisition}))
    {
        if (not exists $userflags->{acquisition}) {
            return 0;
        }

        if (!ref $userflags->{acquisition} && !$userflags->{acquisition}) {
            return 0;
        }

        # Budget restricted to owner
        if ( $budget->{budget_permission} == 1 ) {
            if (    $budget->{budget_owner_id}
                and $budget->{budget_owner_id} != $borrower->{borrowernumber} )
            {
                return 0;
            }
        }

        # Budget restricted to owner, users and library
        elsif ( $budget->{budget_permission} == 2 ) {
            my @budget_users = GetBudgetUsers( $budget->{budget_id} );

            if (
                (
                        $budget->{budget_owner_id}
                    and $budget->{budget_owner_id} !=
                    $borrower->{borrowernumber}
                    or not $budget->{budget_owner_id}
                )
                and ( 0 == grep { $borrower->{borrowernumber} == $_ }
                    @budget_users )
                and defined $budget->{budget_branchcode}
                and $budget->{budget_branchcode} ne
                C4::Context->userenv->{branch}
              )
            {
                return 0;
            }
        }

        # Budget restricted to owner and users
        elsif ( $budget->{budget_permission} == 3 ) {
            my @budget_users = GetBudgetUsers( $budget->{budget_id} );
            if (
                (
                        $budget->{budget_owner_id}
                    and $budget->{budget_owner_id} !=
                    $borrower->{borrowernumber}
                    or not $budget->{budget_owner_id}
                )
                and ( 0 == grep { $borrower->{borrowernumber} == $_ }
                    @budget_users )
              )
            {
                return 0;
            }
        }
    }

    return 1;
}

sub CanUserModifyBudget {
    my ($borrower, $budget, $userflags) = @_;

    if (not ref $borrower) {
        $borrower = Koha::Patrons->find( $borrower );
        return 0 unless $borrower;
        $borrower = $borrower->unblessed;
    }
    if (not ref $budget) {
        $budget = GetBudget($budget);
    }

    return 0 unless ($borrower and $budget);

    if (not defined $userflags) {
        $userflags = C4::Auth::getuserflags($borrower->{flags},
            $borrower->{userid});
    }

    unless ($userflags->{superlibrarian}
    || (ref $userflags->{acquisition}
        && $userflags->{acquisition}->{budget_manage_all})
    || (!ref $userflags->{acquisition} && $userflags->{acquisition}))
    {
        if (!CanUserUseBudget($borrower, $budget, $userflags)) {
            return 0;
        }

        if (ref $userflags->{acquisition}
        && !$userflags->{acquisition}->{budget_modify}) {
            return 0;
        }
    }

    return 1;
}

sub _round {
    my ($value, $increment) = @_;

    if ($increment && $increment != 0) {
        $value = int($value / $increment) * $increment;
    }

    return $value;
}

=head2 CloneBudgetPeriod

  my $new_budget_period_id = CloneBudgetPeriod({
    budget_period_id => $budget_period_id,
    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

sub CloneBudgetPeriod {
    my ($params)                  = @_;
    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 $budget_period_description = $params->{budget_period_description};
    my $amount_change_percentage  = $params->{amount_change_percentage};
    my $amount_change_round_increment = $params->{amount_change_round_increment};
    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;
    $budget_period->{budget_period_description} = $budget_period_description;
    # The new budget (budget_period) should be active by default
    $budget_period->{budget_period_active}    = 1;

    if ($amount_change_percentage) {
        my $total = $budget_period->{budget_period_total};
        $total += $total * $amount_change_percentage / 100;
        $total = _round($total, $amount_change_round_increment);
        $budget_period->{budget_period_total} = $total;
    }

    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
        }
    );

    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 );
        }
    } elsif ($amount_change_percentage) {
        my $budgets = GetBudgets({ budget_period_id => $new_budget_period_id });
        for my $budget ( @$budgets ) {
            my $amount = $budget->{budget_amount};
            $amount += $amount * $amount_change_percentage / 100;
            $amount = _round($amount, $amount_change_round_increment);
            $budget->{budget_amount} = $amount;
            ModBudget( $budget );
        }
    }

    return $new_budget_period_id;
}

=head2 CloneBudgetHierarchy

  CloneBudgetHierarchy({
    budgets => $budgets,
    new_budget_period_id => $new_budget_period_id;
  });

Clone a budget hierarchy.

=cut

sub CloneBudgetHierarchy {
    my ($params)             = @_;
    my $budgets              = $params->{budgets};
    my $new_budget_period_id = $params->{new_budget_period_id};
    next unless @$budgets or $new_budget_period_id;

    my $children_of   = $params->{children_of};
    my $new_parent_id = $params->{new_parent_id};

    my @first_level_budgets =
      ( not defined $children_of )
      ? map { ( not $_->{budget_parent_id} )             ? $_ : () } @$budgets
      : map { ( defined $_->{budget_parent_id} && $_->{budget_parent_id} == $children_of ) ? $_ : () } @$budgets;

    # get only the columns of aqbudgets
    my @columns = Koha::Database->new()->schema->source('Aqbudget')->columns;

    for my $budget ( sort { $a->{budget_id} <=> $b->{budget_id} }
        @first_level_budgets )
    {

        my $tidy_budget =
          { map { join( ' ', @columns ) =~ /$_/ ? ( $_ => $budget->{$_} ) : () }
              keys %$budget };
        delete $tidy_budget->{timestamp};
        my $new_budget_id = AddBudget(
            {
                %$tidy_budget,
                budget_id        => undef,
                budget_parent_id => $new_parent_id,
                budget_period_id => $new_budget_period_id
            }
        );
        CloneBudgetHierarchy(
            {
                budgets              => $budgets,
                new_budget_period_id => $new_budget_period_id,
                children_of          => $budget->{budget_id},
                new_parent_id        => $new_budget_id
            }
        );
    }
}

=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)

1;
__END__

=head1 AUTHOR

Koha Development Team <http://koha-community.org/>

=cut