Bug 18821: (QA follow-up) Last tweaks for performance
[koha.git] / acqui / spent.pl
blob9a1c8059ec9409bd2cc957e36969b559abc292f6
1 #!/usr/bin/perl
3 # script to show a breakdown of committed and spent budgets
5 # Copyright 2002-2009 Katipo Communications Limited
6 # Copyright 2010,2011 Catalyst IT Limited
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 =head1 NAME
24 spent.pl
26 =head1 DESCRIPTION
28 this script is designed to show the spent amount in budgets
30 =cut
32 use C4::Context;
33 use C4::Auth;
34 use C4::Output;
35 use Modern::Perl;
36 use CGI qw ( -utf8 );
38 my $dbh = C4::Context->dbh;
39 my $input = new CGI;
40 my $bookfund = $input->param('fund');
41 my $fund_code = $input->param('fund_code');
43 my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
45 template_name => "acqui/spent.tt",
46 query => $input,
47 type => "intranet",
48 authnotrequired => 0,
49 flagsrequired => { acquisition => '*' },
50 debug => 1,
54 my $query = <<EOQ;
55 SELECT
56 aqorders.biblionumber, aqorders.basketno, aqorders.ordernumber,
57 quantity-quantityreceived AS tleft,
58 ecost, budgetdate, entrydate,
59 aqbasket.booksellerid,
60 itype,
61 title,
62 aqorders.invoiceid,
63 aqinvoices.invoicenumber,
64 quantityreceived,
65 unitprice,
66 datereceived
67 FROM (aqorders, aqbasket)
68 LEFT JOIN biblio ON
69 biblio.biblionumber=aqorders.biblionumber
70 LEFT JOIN aqorders_items ON
71 aqorders.ordernumber = aqorders_items.ordernumber
72 LEFT JOIN items ON
73 aqorders_items.itemnumber = items.itemnumber
74 LEFT JOIN aqinvoices ON
75 aqorders.invoiceid = aqinvoices.invoiceid
76 WHERE
77 aqorders.basketno=aqbasket.basketno AND
78 budget_id=? AND
79 (datecancellationprinted IS NULL OR
80 datecancellationprinted='0000-00-00') AND
81 datereceived IS NOT NULL
82 GROUP BY aqorders.ordernumber
83 EOQ
84 my $sth = $dbh->prepare($query);
85 $sth->execute($bookfund);
86 if ( $sth->err ) {
87 die "An error occurred fetching records: " . $sth->errstr;
89 my $subtotal = 0;
90 my @spent;
91 while ( my $data = $sth->fetchrow_hashref ) {
92 my $recv = $data->{'quantityreceived'};
93 if ( $recv > 0 ) {
94 my $rowtotal = $recv * $data->{'unitprice'};
95 $data->{'rowtotal'} = sprintf( "%.2f", $rowtotal );
96 $data->{'unitprice'} = sprintf( "%.2f", $data->{'unitprice'} );
97 $subtotal += $rowtotal;
98 push @spent, $data;
103 my $total = $subtotal;
104 $query = qq{
105 SELECT invoicenumber, shipmentcost
106 FROM aqinvoices
107 WHERE shipmentcost_budgetid = ?
109 $sth = $dbh->prepare($query);
110 $sth->execute($bookfund);
111 my @shipmentcosts;
112 while (my $data = $sth->fetchrow_hashref) {
113 push @shipmentcosts, {
114 shipmentcost => sprintf("%.2f", $data->{shipmentcost}),
115 invoicenumber => $data->{invoicenumber}
117 $total += $data->{shipmentcost};
119 $sth->finish;
121 $total = sprintf( "%.2f", $total );
123 $template->param(
124 fund => $bookfund,
125 spent => \@spent,
126 subtotal => $subtotal,
127 shipmentcosts => \@shipmentcosts,
128 total => $total,
129 fund_code => $fund_code
132 output_html_with_http_headers $input, $cookie, $template->output;