Bug 7276 : Follow up, adding a sub to clear the cache
[koha.git] / acqui / spent.pl
1 #!/usr/bin/perl
2
3 # script to show a breakdown of committed and spent budgets
4
5 # Copyright 2002-2009 Katipo Communications Limited
6 # Copyright 2010,2011 Catalyst IT Limited
7 # This file is part of Koha.
8 #
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.
13 #
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.
17 #
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.
21
22 =head1 NAME
23
24  spent.pl
25
26 =head1 DESCRIPTION
27
28 this script is designed to show the spent amount in budges
29
30 =cut
31
32 use C4::Context;
33 use C4::Auth;
34 use C4::Output;
35 use C4::Dates;
36 use strict;
37 use warnings;
38 use CGI;
39
40 my $dbh      = C4::Context->dbh;
41 my $input    = new CGI;
42 my $bookfund = $input->param('fund');
43 my $fund_code = $input->param('fund_code');
44
45 my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
46     {
47         template_name   => "acqui/spent.tt",
48         query           => $input,
49         type            => "intranet",
50         authnotrequired => 0,
51         flagsrequired   => { acquisition => 1 },
52         debug           => 1,
53     }
54 );
55
56 my $query = <<EOQ;
57 SELECT
58     aqorders.basketno, aqorders.ordernumber,
59     quantity-quantityreceived AS tleft,
60     ecost, budgetdate, entrydate,
61     aqbasket.booksellerid,
62     itype,
63     title,
64     aqorders.booksellerinvoicenumber,
65     quantityreceived,
66     unitprice,
67     freight,
68     datereceived,
69     aqorders.biblionumber
70 FROM (aqorders, aqbasket)
71 LEFT JOIN items ON
72     items.biblioitemnumber=aqorders.biblioitemnumber
73 LEFT JOIN biblio ON
74     biblio.biblionumber=aqorders.biblionumber
75 LEFT JOIN aqorders_items ON
76     aqorders.ordernumber=aqorders_items.ordernumber
77 WHERE
78     aqorders.basketno=aqbasket.basketno AND
79     budget_id=? AND
80     (datecancellationprinted IS NULL OR
81         datecancellationprinted='0000-00-00')
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;
88 }
89 my $total = 0;
90 my $toggle;
91 my @spent;
92 while ( my $data = $sth->fetchrow_hashref ) {
93     my $recv = $data->{'quantityreceived'};
94     if ( $recv > 0 ) {
95         my $subtotal = $recv * ( $data->{'unitprice'} + $data->{'freight'} );
96         $data->{'subtotal'}  = sprintf( "%.2f", $subtotal );
97         $data->{'freight'}   = sprintf( "%.2f", $data->{'freight'} );
98         $data->{'unitprice'} = sprintf( "%.2f", $data->{'unitprice'} );
99         $total += $subtotal;
100         push @spent, $data;
101     }
102
103 }
104 $total = sprintf( "%.2f", $total );
105
106 $template->{VARS}->{'fund'}  = $bookfund;
107 $template->{VARS}->{'spent'} = \@spent;
108 $template->{VARS}->{'total'} = $total;
109 $template->{VARS}->{'fund_code'} = $fund_code;
110 $sth->finish;
111
112 output_html_with_http_headers $input, $cookie, $template->output;