Bug 6679 - [SIGNED-OFF] fix 2 perlcritic violations in C4/ItemCirculationAlertPrefere...
[koha.git] / acqui / spent.pl
blob2d555f9a765a6815924f18d50dbaf39ff92f573e
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 under the
10 # terms of the GNU General Public License as published by the Free Software
11 # Foundation; either version 2 of the License, or (at your option) any later
12 # version.
14 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
15 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
16 # A PARTICULAR PURPOSE. See the GNU General Public License for more details.
18 # You should have received a copy of the GNU General Public License along
19 # with Koha; if not, write to the Free Software Foundation, Inc.,
20 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
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 strict;
36 use warnings;
37 use CGI;
39 my $dbh = C4::Context->dbh;
40 my $input = new CGI;
41 my $bookfund = $input->param('fund');
42 my $fund_code = $input->param('fund_code');
44 my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
46 template_name => "acqui/spent.tt",
47 query => $input,
48 type => "intranet",
49 authnotrequired => 0,
50 flagsrequired => { acquisition => '*' },
51 debug => 1,
55 my $query = <<EOQ;
56 SELECT
57 aqorders.basketno, aqorders.ordernumber,
58 quantity-quantityreceived AS tleft,
59 ecost, budgetdate, entrydate,
60 aqbasket.booksellerid,
61 itype,
62 title,
63 aqorders.invoiceid,
64 aqinvoices.invoicenumber,
65 quantityreceived,
66 unitprice,
67 datereceived,
68 aqorders.biblionumber
69 FROM (aqorders, aqbasket)
70 LEFT JOIN items ON
71 items.biblioitemnumber=aqorders.biblioitemnumber
72 LEFT JOIN biblio ON
73 biblio.biblionumber=aqorders.biblionumber
74 LEFT JOIN aqorders_items ON
75 aqorders.ordernumber=aqorders_items.ordernumber
76 LEFT JOIN aqinvoices ON
77 aqorders.invoiceid = aqinvoices.invoiceid
78 WHERE
79 aqorders.basketno=aqbasket.basketno AND
80 budget_id=? AND
81 (datecancellationprinted IS NULL OR
82 datecancellationprinted='0000-00-00')
83 GROUP BY aqorders.ordernumber
84 EOQ
85 my $sth = $dbh->prepare($query);
86 $sth->execute($bookfund);
87 if ( $sth->err ) {
88 die "An error occurred fetching records: " . $sth->errstr;
90 my $subtotal = 0;
91 my $toggle;
92 my @spent;
93 while ( my $data = $sth->fetchrow_hashref ) {
94 my $recv = $data->{'quantityreceived'};
95 if ( $recv > 0 ) {
96 my $rowtotal = $recv * $data->{'unitprice'};
97 $data->{'rowtotal'} = sprintf( "%.2f", $rowtotal );
98 $data->{'unitprice'} = sprintf( "%.2f", $data->{'unitprice'} );
99 $subtotal += $rowtotal;
100 push @spent, $data;
105 my $total = $subtotal;
106 $query = qq{
107 SELECT invoicenumber, shipmentcost
108 FROM aqinvoices
109 WHERE shipmentcost_budgetid = ?
111 $sth = $dbh->prepare($query);
112 $sth->execute($bookfund);
113 my @shipmentcosts;
114 while (my $data = $sth->fetchrow_hashref) {
115 push @shipmentcosts, {
116 shipmentcost => sprintf("%.2f", $data->{shipmentcost}),
117 invoicenumber => $data->{invoicenumber}
119 $total += $data->{shipmentcost};
121 $sth->finish;
123 $total = sprintf( "%.2f", $total );
125 $template->param(
126 fund => $bookfund,
127 spent => \@spent,
128 subtotal => $subtotal,
129 shipmentcosts => \@shipmentcosts,
130 total => $total,
131 fund_code => $fund_code
134 output_html_with_http_headers $input, $cookie, $template->output;