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;