Skip to content
Newer
Older
100755 245 lines (227 sloc) 7.84 KB
a0b06fb @ctfliblime Prepare for perlbrew usage by changing all script magic to "#!/usr/bi…
ctfliblime authored Mar 12, 2011
1 #!/usr/bin/env perl
7c2c39d NEW :
tipaul authored Mar 30, 2004
2
3
4 # Copyright 2000-2002 Katipo Communications
5 #
6 # This file is part of Koha.
7 #
8 # Koha is free software; you can redistribute it and/or modify it under the
9 # terms of the GNU General Public License as published by the Free Software
10 # Foundation; either version 2 of the License, or (at your option) any later
11 # version.
12 #
13 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
14 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
15 # A PARTICULAR PURPOSE. See the GNU General Public License for more details.
16 #
17 # You should have received a copy of the GNU General Public License along with
18 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
19 # Suite 330, Boston, MA 02111-1307 USA
20
21 use strict;
22 use C4::Auth;
23 use CGI;
3607caa @ctfliblime Add Koha.pm and include it universally
ctfliblime authored Jun 9, 2011
24 use Koha;
7c2c39d NEW :
tipaul authored Mar 30, 2004
25 use C4::Context;
0dd40fa language cleanups
kados authored Mar 10, 2007
26 use HTML::Template::Pro;
7c2c39d NEW :
tipaul authored Mar 30, 2004
27 use C4::Search;
28 use C4::Output;
29 use C4::Koha;
e459124 BugFixing : 1299 /displaying lists for document types and borrower ca…
Henri-Damien LAURENT authored Jan 16, 2008
30 use C4::Members;
31
fc1342f rel_3_0 moved to HEAD
tipaul authored Mar 9, 2007
32 use C4::Branch; # GetBranches
7c2c39d NEW :
tipaul authored Mar 30, 2004
33
34 =head1 NAME
35
36 plugin that shows a table with issues for categories and borrower
37
38 =head1 DESCRIPTION
39
40 this result is quite complex to build...
41 the 2D array contains :
42 * item types on lines
43 * borrowers types on rows
44
45 If no issues are done, the array must be filled by 0 anyway.
46 So, the script works as this :
47 1- parse the itemtype table to get itemtype descriptions and set itemtype total to 0
48 2- for each borrower category :
49 ** create an array with total = 0 for each itemtype defined in 1
50 ** calculate the total for each itemtype (SQL request)
51 The big hash has the following structure :
52 $itemtypes{itemtype}
53 ->{results}
54 ->{borrowercategorycode} => the total of issues for each cell of the table.
55 ->{total} => the total for the itemtype
56 ->{description} => the itemtype description
57
58 the borrowertype hash contains description and total for each borrowercategory.
59
60 the hashes are then translated to hash / arrays to be returned to manager.pl & send to the template
61
62 =over2
63
64 =cut
65
66 sub set_parameters {
67 my ($template) = @_;
68 my $dbh = C4::Context->dbh;
5b41a8e New XML API
tgarip1957 authored Sep 11, 2006
69 my $branches=GetBranches();
7c2c39d NEW :
tipaul authored Mar 30, 2004
70 my @branches;
71 my @select_branch;
72 my %select_branches;
73 push @select_branch,"";
74 $select_branches{""} = "";
75 foreach my $branch (keys %$branches) {
76 push @select_branch, $branch;
77 $select_branches{$branch} = $branches->{$branch}->{'branchname'};
78 }
79 my $CGIbranch=CGI::scrolling_list( -name => 'value',
c442e8f @oleonard Modifications to ensure XHTML compliance; Adding breadcrumbs and glob…
oleonard authored Sep 12, 2007
80 -id => 'branch',
7c2c39d NEW :
tipaul authored Mar 30, 2004
81 -values => \@select_branch,
82 -labels => \%select_branches,
83 -size => 1,
22eb22e @pianohacker Add multiple selection to some reports wizards
pianohacker authored Jun 22, 2009
84 -title => 'Select a branch',
7c2c39d NEW :
tipaul authored Mar 30, 2004
85 -multiple => 0 );
86 $template->param(CGIbranch => $CGIbranch);
e459124 BugFixing : 1299 /displaying lists for document types and borrower ca…
Henri-Damien LAURENT authored Jan 16, 2008
87
88 my ($codes,$labels)=GetborCatFromCatType(undef,undef);
89 my @borcatloop;
90 foreach my $thisborcat (sort keys %$labels) {
91 push @borcatloop, {value => $thisborcat,
92 description => $labels->{$thisborcat},
93 };
94 }
95 $template->param(loopcategories => \@borcatloop);
7c2c39d NEW :
tipaul authored Mar 30, 2004
96 return $template;
97 }
98 sub calculate {
99 my ($parameters) = @_;
100 my @results =();
101 # extract parameters
102 my $borrower_category = @$parameters[0];
22eb22e @pianohacker Add multiple selection to some reports wizards
pianohacker authored Jun 22, 2009
103 my @branch = split /,/, @$parameters[1];
7c2c39d NEW :
tipaul authored Mar 30, 2004
104 my $dbh = C4::Context->dbh;
105 # build the SQL query & execute it
106
107 # 1st, loop every itemtypes.
108 my $sth = $dbh->prepare("select itemtype,description from itemtypes");
109 $sth->execute;
110 my %itemtypes;
111 while (my ($itemtype,$description) = $sth->fetchrow) {
112 $itemtypes{$itemtype}->{description} = $description;
113 $itemtypes{$itemtype}->{total} = 0;
114 }
115 # now, parse each category. Before filling the result array, fill it with 0 to have every itemtype column.
b389979 big commit, still breaking things...
tipaul authored Oct 26, 2005
116 my $strsth="SELECT itemtype, count( * )
fc1342f rel_3_0 moved to HEAD
tipaul authored Mar 9, 2007
117 FROM issues, borrowers, biblioitems, items
7c2c39d NEW :
tipaul authored Mar 30, 2004
118 WHERE issues.borrowernumber = borrowers.borrowernumber
119 AND items.itemnumber = issues.itemnumber
fc1342f rel_3_0 moved to HEAD
tipaul authored Mar 9, 2007
120 AND biblioitems.biblionumber = items.biblionumber
b389979 big commit, still breaking things...
tipaul authored Oct 26, 2005
121 AND borrowers.categorycode = ?";
22eb22e @pianohacker Add multiple selection to some reports wizards
pianohacker authored Jun 22, 2009
122 $strsth.= " AND borrowers.branchcode IN (" . join( ',', ('?') x scalar(@branch) ) . ")";
fc1342f rel_3_0 moved to HEAD
tipaul authored Mar 9, 2007
123 $strsth .= " GROUP BY biblioitems.itemtype";
b389979 big commit, still breaking things...
tipaul authored Oct 26, 2005
124 my $sth = $dbh->prepare($strsth);
7c2c39d NEW :
tipaul authored Mar 30, 2004
125 my $sthcategories = $dbh->prepare("select categorycode,description from categories");
126 $sthcategories->execute;
127 my %borrowertype;
128 my @categorycodeloop;
31b4599 Adding reports
hdl authored Feb 19, 2005
129 my $categorycode;
130 my $description;
131 my $borrower_categorycode =0;
7c2c39d NEW :
tipaul authored Mar 30, 2004
132 my @mainloop;
133 my @itemtypeloop;
134 my @loopborrowertype;
31b4599 Adding reports
hdl authored Feb 19, 2005
135 my @loopborrowertotal;
7c2c39d NEW :
tipaul authored Mar 30, 2004
136 my %globalline;
137 my $hilighted=-1;
31b4599 Adding reports
hdl authored Feb 19, 2005
138 my $grantotal =0;
139 #If no Borrower-category selected....
140 # Print all
141 if (!$borrower_category) {
142 while ( ($categorycode,$description) = $sthcategories->fetchrow) {
143 $borrowertype{$categorycode}->{description} = $description;
144 $borrowertype{$categorycode}->{total} = 0;
145 my %categorycode;
146 $categorycode{categorycode} = $description;
147 push @categorycodeloop,\%categorycode;
148 foreach my $itemtype (keys %itemtypes) {
149 $itemtypes{$itemtype}->{results}->{$categorycode} = 0;
150 }
151 $sth->execute($categorycode);
152 while (my ($itemtype, $total) = $sth->fetchrow) {
153 $itemtypes{$itemtype}->{results}->{$categorycode} = $total;
154 $borrowertype{$categorycode}->{total} += $total;
155 $itemtypes{$itemtype}->{total} += $total;
156 $grantotal += $total;
157 }
158 }
159 # build the result
160 foreach my $itemtype (keys %itemtypes) {
161 my @loopitemtype;
162 $sthcategories->execute;
163 while (($categorycode,$description) = $sthcategories->fetchrow ) {
164 my %cell;
165 $cell{issues} = $itemtypes{$itemtype}->{results}->{$categorycode};
166 #printf stderr "%s ",$categorycode;
167 push @loopitemtype,\%cell;
168 }
169 #printf stderr "\n";
170 my %line;
171 $line{loopitemtype} = \@loopitemtype;
172 if ($itemtypes{$itemtype}->{description}) {
173 $line{itemtype} = $itemtypes{$itemtype}->{description};
174 } else {
175 $line{itemtype} = "$itemtype (no entry in itemtype table)";
176 }
177 $line{hilighted} = 1 if $hilighted eq 1;
178 $line{totalitemtype} = $itemtypes{$itemtype}->{total};
179 $hilighted = -$hilighted;
180 push @loopborrowertype, \%line;
181 }
182 $sthcategories->execute;
183 while (($categorycode,$description) = $sthcategories->fetchrow ) {
184 my %line;
185 $line{issues} = $borrowertype{$categorycode}->{total};
186 push @loopborrowertotal, \%line;
187 }
188 } else {
189 # A Borrower_category has been selected
190 # extracting corresponding data
191 $borrowertype{$categorycode}->{description} = $borrower_category;
192 $borrowertype{$categorycode}->{total} = 0;
193 while (($categorycode,$description) = $sthcategories->fetchrow) {
194 if ($description =~ /$borrower_category/ ) {
195 $borrower_categorycode = $categorycode;
196 my %cc;
197 $cc{categorycode} = $description;
198 push @categorycodeloop,\%cc;
199 foreach my $itemtype (keys %itemtypes) {
200 $itemtypes{$itemtype}->{results}->{$categorycode} = 0;
201 }
202 $sth->execute($categorycode);
203 while (my ($itemtype, $total) = $sth->fetchrow) {
204 $itemtypes{$itemtype}->{results}->{$categorycode} = $total;
205 $borrowertype{$categorycode}->{total} += $total;
206 $itemtypes{$itemtype}->{total} += $total;
207 $grantotal +=$total;
208 }
209 }
7c2c39d NEW :
tipaul authored Mar 30, 2004
210 }
31b4599 Adding reports
hdl authored Feb 19, 2005
211 # build the result
212 foreach my $itemtype (keys %itemtypes) {
213 my @loopitemtype;
214 my %cell;
215 $cell{issues}=$itemtypes{$itemtype}->{results}->{$borrower_categorycode};
216 push @loopitemtype, \%cell;
217 my %line;
218 $line{loopitemtype} = \@loopitemtype;
219 if ($itemtypes{$itemtype}->{description}) {
220 $line{itemtype} = $itemtypes{$itemtype}->{description};
221 } else {
222 $line{itemtype} = "$itemtype (no entry in itemtype table)";
223 }
224 $line{hilighted} = 1 if $hilighted eq 1;
225 $line{totalitemtype} = $itemtypes{$itemtype}->{total};
226 $hilighted = -$hilighted;
227 push @loopborrowertype, \%line;
fb41247 minor improvement
tipaul authored May 6, 2004
228 }
31b4599 Adding reports
hdl authored Feb 19, 2005
229 my %cell;
230 $cell{issues} = $borrowertype{$borrower_categorycode}->{total};
231 push @loopborrowertotal, \%cell;
7c2c39d NEW :
tipaul authored Mar 30, 2004
232 }
233 # the header of the table
234 $globalline{loopborrowertype} = \@loopborrowertype;
235 # the core of the table
236 $globalline{categorycodeloop} = \@categorycodeloop;
237 # the foot (totals by borrower type)
238 $globalline{loopborrowertotal} = \@loopborrowertotal;
31b4599 Adding reports
hdl authored Feb 19, 2005
239 $globalline{grantotal}= $grantotal;
7c2c39d NEW :
tipaul authored Mar 30, 2004
240 push @mainloop,\%globalline;
241 return \@mainloop;
242 }
243
fc1342f rel_3_0 moved to HEAD
tipaul authored Mar 9, 2007
244 1;
Something went wrong with that request. Please try again.