Bug 14766: unimarc_field_4XX: escape ', ", \n, \r
[koha.git] / acqui / spent.pl
blob4d60029115f8f49a3154e4843cea3c3a1100c338
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 strict;
36 use warnings;
37 use CGI qw ( -utf8 );
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 biblio ON
71 biblio.biblionumber=aqorders.biblionumber
72 LEFT JOIN aqorders_items ON
73 aqorders.ordernumber = aqorders_items.ordernumber
74 LEFT JOIN items ON
75 aqorders_items.itemnumber = items.itemnumber
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') AND
83 datereceived IS NOT NULL
84 GROUP BY aqorders.ordernumber
85 EOQ
86 my $sth = $dbh->prepare($query);
87 $sth->execute($bookfund);
88 if ( $sth->err ) {
89 die "An error occurred fetching records: " . $sth->errstr;
91 my $subtotal = 0;
92 my $toggle;
93 my @spent;
94 while ( my $data = $sth->fetchrow_hashref ) {
95 my $recv = $data->{'quantityreceived'};
96 if ( $recv > 0 ) {
97 my $rowtotal = $recv * $data->{'unitprice'};
98 $data->{'rowtotal'} = sprintf( "%.2f", $rowtotal );
99 $data->{'unitprice'} = sprintf( "%.2f", $data->{'unitprice'} );
100 $subtotal += $rowtotal;
101 push @spent, $data;
106 my $total = $subtotal;
107 $query = qq{
108 SELECT invoicenumber, shipmentcost
109 FROM aqinvoices
110 WHERE shipmentcost_budgetid = ?
112 $sth = $dbh->prepare($query);
113 $sth->execute($bookfund);
114 my @shipmentcosts;
115 while (my $data = $sth->fetchrow_hashref) {
116 push @shipmentcosts, {
117 shipmentcost => sprintf("%.2f", $data->{shipmentcost}),
118 invoicenumber => $data->{invoicenumber}
120 $total += $data->{shipmentcost};
122 $sth->finish;
124 $total = sprintf( "%.2f", $total );
126 $template->param(
127 fund => $bookfund,
128 spent => \@spent,
129 subtotal => $subtotal,
130 shipmentcosts => \@shipmentcosts,
131 total => $total,
132 fund_code => $fund_code
135 output_html_with_http_headers $input, $cookie, $template->output;