circ/overdue.pl

   1 #!/usr/bin/perl
   2
   3
   4 # Copyright 2000-2002 Katipo Communications
   5 #
   6 # This file is part of Koha.
   7 #
   8 # Koha is free software; you can redistribute it and/or modify it under the
   9 # terms of the GNU General Public License as published by the Free Software
  10 # Foundation; either version 2 of the License, or (at your option) any later
  11 # version.
  12 #
  13 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  14 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  15 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU General Public License along with
  18 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
  19 # Suite 330, Boston, MA  02111-1307 USA
  20
  21 use strict;
  22 # use warnings; # FIXME
  23 use C4::Context;
  24 use C4::Output;
  25 use CGI;
  26 use C4::Auth;
  27 use C4::Branch;
  28 use C4::Dates qw/format_date/;
  29 use Date::Calc qw/Today/;
  30 use Text::CSV_XS;
  31
  32 my $input = new CGI;
  33 my $order   = $input->param( 'order' ) || '';
  34 my $showall = $input->param('showall');
  35
  36 my  $bornamefilter = $input->param( 'borname');
  37 my   $borcatfilter = $input->param( 'borcat' );
  38 my $itemtypefilter = $input->param('itemtype');
  39 my $borflagsfilter = $input->param('borflags') || "";
  40 my   $branchfilter = $input->param( 'branch' );
  41 my $op             = $input->param(   'op'   ) || '';
  42
  43 my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
  44     {
  45         template_name   => "circ/overdue.tmpl",
  46         query           => $input,
  47         type            => "intranet",
  48         authnotrequired => 0,
  49         flagsrequired   => { reports => 1, circulate => "circulate_remaining_permissions" },
  50         debug           => 1,
  51     }
  52 );
  53
  54 my $dbh = C4::Context->dbh;
  55
  56 my $req;
  57 $req = $dbh->prepare( "select categorycode, description from categories order by description");
  58 $req->execute;
  59 my @borcatloop;
  60 while (my ($catcode, $description) =$req->fetchrow) {
  61     push @borcatloop, {
  62         value    => $catcode,
  63         selected => $catcode eq $borcatfilter ? 1 : 0,
  64         catname  => $description,
  65     };
  66 }
  67
  68 $req = $dbh->prepare( "select itemtype, description from itemtypes order by description");
  69 $req->execute;
  70 my @itemtypeloop;
  71 while (my ($itemtype, $description) =$req->fetchrow) {
  72     push @itemtypeloop, {
  73         value        => $itemtype,
  74         selected     => $itemtype eq $itemtypefilter ? 1 : 0,
  75         itemtypename => $description,
  76     };
  77 }
  78 my $onlymine=C4::Context->preference('IndependantBranches') &&
  79              C4::Context->userenv &&
  80              C4::Context->userenv->{flags}!=1 &&
  81              C4::Context->userenv->{branch};
  82
  83 $branchfilter = C4::Context->userenv->{'branch'} if ($onlymine && !$branchfilter);
  84
  85 $template->param(
  86     branchloop   => GetBranchesLoop($branchfilter, $onlymine),
  87     branchfilter => $branchfilter,
  88     borcatloop   => \@borcatloop,
  89     itemtypeloop => \@itemtypeloop,
  90     borname      => $bornamefilter,
  91     order        => $order,
  92     showall      => $showall,
  93     csv_param_string => $input->query_string(),
  94 );
  95
  96 my @sort_roots = qw(borrower title barcode date_due);
  97 push @sort_roots, map {$_ . " desc"} @sort_roots;
  98 my @order_loop = ({selected => $order ? 0 : 1});   # initial blank row
  99 foreach (@sort_roots) {
 100     my $tmpl_name = $_;
 101     $tmpl_name =~ s/\s/_/g;
 102     push @order_loop, {
 103         selected => $order eq $_ ? 1 : 0,
 104         ordervalue => $_,
 105         foo => $tmpl_name,
 106         'order_' . $tmpl_name => 1,
 107     };
 108 }
 109 $template->param(ORDER_LOOP => \@order_loop);
 110
 111 my $todaysdate = sprintf("%-04.4d-%-02.2d-%02.2d", Today());
 112
 113 $bornamefilter =~s/\*/\%/g;
 114 $bornamefilter =~s/\?/\_/g;
 115
 116 my $strsth="SELECT date_due,
 117   surname,
 118   firstname,
 119   borrowers.title as borrowertitle,
 120   CONCAT(borrowers.address, '\n', borrowers.address2) as address,
 121   borrowers.city,
 122   borrowers.zipcode,
 123   borrowers.phone,
 124   borrowers.email,
 125   issues.itemnumber,
 126   issues.issuedate,
 127   items.barcode,
 128   items.itemcallnumber,
 129   biblio.title,
 130   biblio.author,
 131   borrowers.borrowernumber,
 132   biblio.biblionumber,
 133   borrowers.branchcode
 134   FROM issues
 135 LEFT JOIN borrowers   ON (issues.borrowernumber=borrowers.borrowernumber )
 136 LEFT JOIN items       ON (issues.itemnumber=items.itemnumber)
 137 LEFT JOIN biblioitems ON (biblioitems.biblioitemnumber=items.biblioitemnumber)
 138 LEFT JOIN biblio      ON (biblio.biblionumber=items.biblionumber )
 139 WHERE 1=1 "; # placeholder, since it is possible that none of the additional
 140              # conditions will be selected by user
 141 $strsth.=" AND date_due               < NOW() " unless ($showall);
 142 $strsth.=" AND (borrowers.firstname like '".$bornamefilter."%' or borrowers.surname like '".$bornamefilter."%' or borrowers.cardnumber like '".$bornamefilter."%')" if($bornamefilter) ;
 143 $strsth.=" AND borrowers.categorycode = '" . $borcatfilter   . "' " if $borcatfilter;
 144 $strsth.=" AND biblioitems.itemtype   = '" . $itemtypefilter . "' " if $itemtypefilter;
 145 $strsth.=" AND borrowers.flags        = '" . $borflagsfilter . "' " if $borflagsfilter;
 146 $strsth.=" AND borrowers.branchcode   = '" . $branchfilter   . "' " if $branchfilter;
 147 $strsth.=" ORDER BY " . (
 148     ($order eq "surname" or $order eq "surname desc") ? "$order, date_due"                 :
 149     ($order eq "title"    or $order eq    "title desc") ? "$order, date_due, surname"       :
 150     ($order eq "barcode"  or $order eq  "barcode desc") ? "items.$order, date_due, surname" :
 151                             ($order eq "date_due desc") ? "date_due DESC, surname"          :
 152                                                           "date_due, surname"  # default sort order
 153 );
 154 $template->param(sql=>$strsth);
 155 my $sth=$dbh->prepare($strsth);
 156 #warn "overdue.pl : query string ".$strsth;
 157 $sth->execute();
 158
 159 my @overduedata;
 160 while (my $data=$sth->fetchrow_hashref) {
 161     push @overduedata, {
 162         issuedate      => format_date($data->{issuedate}),
 163         duedate        => format_date($data->{date_due}),
 164         surname        => $data->{surname},
 165         firstname      => $data->{firstname},
 166         borrowertitle  => $data->{borrowertitle},
 167         borrowernumber => $data->{borrowernumber},
 168         barcode        => $data->{barcode},
 169         itemnum        => $data->{itemnumber},
 170         itemcallnumber => $data->{itemcallnumber},
 171         address        => $data->{address},
 172         city           => $data->{city},
 173         zipcode        => $data->{zipcode},
 174         phone          => $data->{phone},
 175         email          => $data->{email},
 176         biblionumber   => $data->{biblionumber},
 177         title          => $data->{title},
 178         author         => $data->{author},
 179         branchcode     => $data->{branchcode},
 180     };
 181 }
 182
 183 $template->param(
 184     todaysdate  => format_date($todaysdate),
 185     overdueloop => \@overduedata
 186 );
 187
 188 # download the complete CSV
 189 if ($op eq 'csv') {
 190         binmode(STDOUT, ":utf8");
 191         my $csv = build_csv(\@overduedata);
 192         print $input->header(-type => 'application/vnd.sun.xml.calc',
 193                              -encoding    => 'utf-8',
 194                              -attachment=>"overdues.csv",
 195                              -filename=>"overdues.csv" );
 196         print $csv;
 197         exit;
 198 }
 199
 200 output_html_with_http_headers $input, $cookie, $template->output;
 201
 202
 203 sub build_csv {
 204     my $overdues = shift;
 205
 206     return "" if scalar(@$overdues) == 0;
 207
 208     my @lines = ();
 209
 210     # build header ...
 211     my @keys = sort keys %{ $overdues->[0] };
 212     my $csv = Text::CSV_XS->new({
 213         binary   => 1,
 214         sep_char => C4::Context->preference("delimiter") ?
 215                     C4::Context->preference("delimiter") : ';' ,
 216     });
 217     $csv->combine(@keys);
 218     push @lines, $csv->string();
 219
 220     # ... and rest of report
 221     foreach my $overdue ( @{ $overdues } ) {
 222         push @lines, $csv->string() if $csv->combine(map { $overdue->{$_} } @keys);
 223     }
 224
 225     return join("\n", @lines) . "\n";
 226 }