Updating perlcriticrc to allow Modern::Perl to suffice instead of use warnings; and...
[koha.git] / acqui / fetch_sort_dropbox.pl
1 #!/usr/bin/perl
2
3 # Copyright 2008-2009 BibLibre SARL
4 #
5 # This file is part of Koha.
6 #
7 # Koha is free software; you can redistribute it and/or modify it under the
8 # terms of the GNU General Public License as published by the Free Software
9 # Foundation; either version 2 of the License, or (at your option) any later
10 # version.
11 #
12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
15 #
16 # You should have received a copy of the GNU General Public License along
17 # with Koha; if not, write to the Free Software Foundation, Inc.,
18 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19
20 use strict;
21 use warnings;
22 use CGI;
23 use C4::Context;
24 use C4::Output;
25 use C4::Auth;
26 use C4::Budgets;
27
28 =head1 NAME
29
30 fetch_sort_dropbox.pl
31
32 =head1 DESCRIPTION
33
34  This script fetches sort values for a given budget id. Currently it is used to dynamically fill
35  'Statistic 1' and 'Statistic 2' comboboxes in neworderempty page. Values retrieved depend on
36  categories of authorized values defined in funds configuration.
37
38 =head1 CGI PARAMETERS
39
40 =over 4
41
42 =item budget_id
43
44 Budget identifier
45
46 =item sort
47
48 Sort number. 1 or 2 for the moment.
49
50 =back
51
52 =cut
53
54 my $input = new CGI;
55
56 my $budget_id = $input->param('budget_id');
57 my $sort_id   = $input->param('sort');
58
59 my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
60     {   template_name   => "acqui/ajax.tmpl",
61         query           => $input,
62         type            => "intranet",
63         authnotrequired => 0,
64         flagsrequired => {editcatalogue => 'edit_catalogue'},
65         debug => 0,
66     }
67 );
68
69 my $budget = GetBudget($budget_id);
70 my $dropbox_values = GetAuthvalueDropbox( $budget->{'sort'.$sort_id.'_authcat'}, '' );
71
72 my @authorised_values;
73 my %authorised_lib;
74
75 foreach ( @$dropbox_values) {
76     push @authorised_values, $_->{value};
77     $authorised_lib{$_->{value}} = $_->{label};
78 }
79
80 my $budget_authvalue_dropbox = CGI::scrolling_list(
81     -values   => \@authorised_values,
82     -labels   => \%authorised_lib,
83     -default  => $authorised_values[0],
84 );
85
86
87 # strip off select tags
88 $budget_authvalue_dropbox =~ s/^\<select.*?\"\>//;
89 $budget_authvalue_dropbox =~ s/\<\/select\>$//;
90 chomp $budget_authvalue_dropbox;
91
92 $template->param( return => $budget_authvalue_dropbox );
93 output_html_with_http_headers $input, $cookie, $template->output;