Bug 17575: (followup) Remove missing fine type warnings
[koha.git] / admin / aqbudgets.pl
blob0e6b744251619b7d87b6f1526abc41434f46b157
1 #!/usr/bin/perl
3 #script to administer the aqbudget table
5 # Copyright 2008-2009 BibLibre SARL
7 # This file is part of Koha.
9 # Koha is free software; you can redistribute it and/or modify it
10 # under the terms of the GNU General Public License as published by
11 # the Free Software Foundation; either version 3 of the License, or
12 # (at your option) any later version.
14 # Koha is distributed in the hope that it will be useful, but
15 # WITHOUT ANY WARRANTY; without even the implied warranty of
16 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 # GNU General Public License for more details.
19 # You should have received a copy of the GNU General Public License
20 # along with Koha; if not, see <http://www.gnu.org/licenses>.
22 use Modern::Perl;
24 use CGI qw ( -utf8 );
25 use List::Util qw/min/;
27 use Koha::Database;
28 use C4::Auth qw/get_user_subpermissions/;
29 use C4::Branch; # GetBranches
30 use C4::Auth;
31 use C4::Acquisition;
32 use C4::Budgets;
33 use C4::Members; # calls GetSortDetails()
34 use C4::Context;
35 use C4::Output;
36 use C4::Koha;
37 use C4::Debug;
38 use Koha::Acquisition::Currencies;
40 my $input = new CGI;
41 my $dbh = C4::Context->dbh;
43 my ($template, $borrowernumber, $cookie, $staffflags ) = get_template_and_user(
44 { template_name => "admin/aqbudgets.tt",
45 query => $input,
46 type => "intranet",
47 authnotrequired => 0,
48 flagsrequired => { acquisition => 'budget_manage' },
49 debug => 0,
53 my $active_currency = Koha::Acquisition::Currencies->get_active;
54 $template->param( symbol => $active_currency->symbol,
55 currency => $active_currency->currency
58 my $op = $input->param('op') || 'list';
60 # see if the user want to see all budgets or only owned ones by default
61 my $show_mine = $input->param('show_mine') // 0;
63 # IF USER DOESN'T HAVE PERM FOR AN 'ADD', THEN REDIRECT TO THE DEFAULT VIEW...
64 if (not defined $template->{VARS}->{'CAN_user_acquisition_budget_add_del'}
65 and $op eq 'add_form')
67 $op = 'list';
70 # get only the columns of aqbudgets in budget_hash
71 my @columns = Koha::Database->new()->schema->source('Aqbudget')->columns;
72 my $budget_hash = { map { join(' ',@columns) =~ /$_/ ? ( $_ => scalar $input->param($_) ) : () } keys( %{$input->Vars()}) } ;
74 my $budget_id = $input->param('budget_id');
75 my $budget_period_id = $input->param('budget_period_id');
76 my $budget_permission = $input->param('budget_permission');
77 my $budget_users_ids = $input->param('budget_users_ids');
78 my $filter_budgetbranch = $input->param('filter_budgetbranch') // '';
79 my $filter_budgetname = $input->param('filter_budgetname');
82 # ' ------- get periods stuff ------------------'
83 # IF PERIODID IS DEFINED, GET THE PERIOD - ELSE JUST GET THE ACTIVE PERIOD BY DEFAULT
84 my $period;
85 if ( $budget_period_id ) {
86 $period = GetBudgetPeriod( $budget_period_id );
89 # ------- get periods stuff ------------------
91 # USED FOR PERMISSION COMPARISON LATER
92 my $borrower_id = $template->{VARS}->{'USER_INFO'}->{'borrowernumber'};
93 my $user = C4::Members::GetMember( borrowernumber => $borrower_id );
94 my $user_branchcode = $user->{'branchcode'};
96 $template->param(
97 show_mine => $show_mine,
98 op => $op,
101 my $budget;
103 my $branchloop = C4::Branch::GetBranchesLoop($filter_budgetbranch);
105 $template->param(auth_cats_loop => GetBudgetAuthCats( $budget_period_id ))
106 if $budget_period_id;
108 # Used to create form to add or modify a record
109 if ($op eq 'add_form') {
110 #### ------------------- ADD_FORM -------------------------
111 # if no buget_id is passed then its an add
112 # pass the period_id to build the dropbox - because we only want to show budgets from this period
113 my $dropbox_disabled;
114 if (defined $budget_id ) { ### MOD
115 $budget = GetBudget($budget_id);
116 if (!CanUserModifyBudget($borrowernumber, $budget, $staffflags)) {
117 $template->param(error_not_authorised_to_modify => 1);
118 output_html_with_http_headers $input, $cookie, $template->output;
119 exit;
121 $dropbox_disabled = BudgetHasChildren($budget_id);
122 my $borrower = &GetMember( borrowernumber=>$budget->{budget_owner_id} );
123 $budget->{budget_owner_name} = ( $borrower ? $borrower->{'firstname'} . ' ' . $borrower->{'surname'} : '' );
126 # build budget hierarchy
127 my %labels;
128 my @values;
129 my $hier = GetBudgetHierarchy($$period{budget_period_id});
130 foreach my $r (@$hier) {
131 $labels{"$r->{budget_id}"} = $r->{budget_code};
132 push @values, $r->{budget_id};
134 push @values, '';
135 # if no buget_id is passed then its an add
136 my $budget_parent;
137 my $budget_parent_id;
138 if ($budget){
139 $budget_parent_id = $budget->{'budget_parent_id'} ;
140 }else{
141 $budget_parent_id = $input->param('budget_parent_id');
143 $budget_parent = GetBudget($budget_parent_id);
145 # build branches select
146 my $branches = GetBranches;
147 my @branchloop_select;
148 foreach my $thisbranch ( sort keys %$branches ) {
149 my %row = (
150 value => $thisbranch,
151 branchname => $branches->{$thisbranch}->{'branchname'},
153 $row{selected} = 1 if $budget and $thisbranch eq $budget->{'budget_branchcode'};
154 push @branchloop_select, \%row;
157 # populates the YUI planning button
158 my $categories = GetAuthorisedValueCategories();
159 my @auth_cats_loop1 = ();
160 foreach my $category (@$categories) {
161 my $entry = { category => $category,
162 selected => ( $budget and $budget->{sort1_authcat} eq $category ? 1 : 0 ),
164 push @auth_cats_loop1, $entry;
166 my @auth_cats_loop2 = ();
167 foreach my $category (@$categories) {
168 my $entry = { category => $category,
169 selected => ( $budget and $budget->{sort2_authcat} eq $category ? 1 : 0 ),
171 push @auth_cats_loop2, $entry;
173 $template->param(authorised_value_categories1 => \@auth_cats_loop1);
174 $template->param(authorised_value_categories2 => \@auth_cats_loop2);
176 if($budget->{'budget_permission'}){
177 my $budget_permission = "budget_perm_".$budget->{'budget_permission'};
178 $template->param($budget_permission => 1);
181 if ($budget) {
182 my @budgetusers = GetBudgetUsers($budget->{budget_id});
183 my @budgetusers_loop;
184 foreach my $borrowernumber (@budgetusers) {
185 my $member = C4::Members::GetMember(
186 borrowernumber => $borrowernumber);
187 push @budgetusers_loop, {
188 firstname => $member->{firstname},
189 surname => $member->{surname},
190 borrowernumber => $borrowernumber
193 $template->param(
194 budget_users => \@budgetusers_loop,
195 budget_users_ids => join ':', @budgetusers
199 # if no buget_id is passed then its an add
200 $template->param(
201 budget_has_children => BudgetHasChildren( $budget->{budget_id} ),
202 budget_parent_id => $budget_parent->{'budget_id'},
203 budget_parent_name => $budget_parent->{'budget_name'},
204 branchloop_select => \@branchloop_select,
205 %$period,
206 %$budget,
208 # END $OP eq ADD_FORM
209 #---------------------- DEFAULT DISPLAY BELOW ---------------------
211 # called by default form, used to confirm deletion of data in DB
212 } elsif ($op eq 'delete_confirm') {
214 my $budget = GetBudget($budget_id);
215 $template->param(
216 budget_id => $budget->{'budget_id'},
217 budget_code => $budget->{'budget_code'},
218 budget_name => $budget->{'budget_name'},
219 budget_amount => $budget->{'budget_amount'},
221 # END $OP eq DELETE_CONFIRM
222 # called by delete_confirm, used to effectively confirm deletion of data in DB
223 } elsif ( $op eq 'delete_confirmed' ) {
224 if ( BudgetHasChildren( $budget_id ) ) {
225 # We should never be here, the interface does not provide this action.
226 die("Delete a fund with children is not possible");
228 my $rc = DelBudget($budget_id);
229 $op = 'list';
230 } elsif( $op eq 'add_validate' ) {
231 my @budgetusersid;
232 if (defined $budget_users_ids){
233 @budgetusersid = split(':', $budget_users_ids);
236 my $budget_modified = 0;
237 if (defined $budget_id) {
238 if (CanUserModifyBudget($borrowernumber, $budget_hash->{budget_id},
239 $staffflags)
241 ModBudget( $budget_hash );
242 ModBudgetUsers($budget_hash->{budget_id}, @budgetusersid);
243 $budget_modified = 1;
245 else {
246 $template->param(error_not_authorised_to_modify => 1);
248 } else {
249 $budget_hash->{budget_id} = AddBudget( $budget_hash );
250 ModBudgetUsers($budget_hash->{budget_id}, @budgetusersid);
251 $budget_modified = 1;
254 my $set_owner_to_children = $input->param('set_owner_to_children');
255 if ( $set_owner_to_children and $budget_modified ) {
256 C4::Budgets::SetOwnerToFundHierarchy( $budget_hash->{budget_id}, $budget_hash->{budget_owner_id} );
258 $op = 'list';
261 if ( $op eq 'list' ) {
262 my $branches = GetBranches();
263 $template->param(
264 budget_id => $budget_id,
265 %$period,
268 my @budgets = @{
269 GetBudgetHierarchy($$period{budget_period_id},
270 C4::Context->userenv->{branchcode}, $show_mine ? $borrower_id : '')
273 my $period_total = 0;
274 my ($period_alloc_total, $spent_total, $ordered_total, $available_total) = (0,0,0,0);
276 #This Looks WEIRD to me : should budgets be filtered in such a way ppl who donot own it would not see the amount spent on the budget by others ?
278 my @budgets_to_display;
279 foreach my $budget (@budgets) {
280 # PERMISSIONS
281 unless(CanUserModifyBudget($borrowernumber, $budget, $staffflags)) {
282 $budget->{'budget_lock'} = 1;
285 # if a budget search doesn't match, next
286 if ($filter_budgetname) {
287 next
288 unless $budget->{budget_code} =~ m/$filter_budgetname/i
289 || $budget->{budget_name} =~ m/$filter_budgetname/i;
291 if ($filter_budgetbranch ) {
292 next unless $budget->{budget_branchcode} eq $filter_budgetbranch;
295 ## TOTALS
296 $budget->{'budget_remaining'} = $budget->{'budget_amount'} - $budget->{'budget_spent'} - $budget->{budget_ordered};
297 $budget->{'total_remaining'} = $budget->{'budget_amount'} - $budget->{'total_spent'} - $budget->{total_ordered};
298 # adds to total - only if budget is a 'top-level' budget
299 unless ( defined $budget->{budget_parent_id} ) {
300 $period_alloc_total += $budget->{'budget_amount'};
301 $spent_total += $budget->{total_spent};
302 $ordered_total += $budget->{total_ordered};
303 $available_total += $budget->{total_remaining};
306 # if amount == 0 don't display...
307 delete $budget->{'budget_unalloc_sublevel'}
308 if (!defined $budget->{'budget_unalloc_sublevel'}
309 or $budget->{'budget_unalloc_sublevel'} == 0);
311 # Value of budget_spent equals 0 instead of undefined value
312 $budget->{budget_spent} = 0 unless defined($budget->{budget_spent});
313 $budget->{budget_ordered} = 0 unless defined($budget->{budget_ordered});
315 #Make a list of parents of the bugdet
316 my @budget_hierarchy;
317 push @budget_hierarchy, { element_name => $budget->{"budget_name"}, element_id => $budget->{"budget_id"} };
318 my $parent_id = $budget->{"budget_parent_id"};
319 while ($parent_id) {
320 my $parent = GetBudget($parent_id);
321 push @budget_hierarchy, { element_name => $parent->{"budget_name"}, element_id => $parent->{"budget_id"} };
322 $parent_id = $parent->{"budget_parent_id"};
324 push @budget_hierarchy, { element_name => $period->{"budget_period_description"} };
325 @budget_hierarchy = reverse(@budget_hierarchy);
327 $budget->{budget_hierarchy} = \@budget_hierarchy;
329 $budget->{budget_has_children} = BudgetHasChildren( $budget->{budget_id} );
330 push @budgets_to_display, $budget;
333 my $budget_period_total = $period->{budget_period_total};
335 my $periods = GetBudgetPeriods();
337 $template->param(
338 op => 'list',
339 budgets => \@budgets_to_display,
340 periods => $periods,
341 budget_period_total => $budget_period_total,
342 period_alloc_total => $period_alloc_total,
343 spent_total => $spent_total,
344 ordered_total => $ordered_total,
345 available_total => $available_total,
346 branchloop => $branchloop,
347 filter_budgetname => $filter_budgetname,
350 } #---- END list
352 output_html_with_http_headers $input, $cookie, $template->output;