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.address,
 120   borrowers.city,
 121   borrowers.zipcode,
 122   borrowers.phone,
 123   borrowers.email,
 124   issues.itemnumber,
 125   issues.issuedate,
 126   items.barcode,
 127   items.itemcallnumber,
 128   biblio.title,
 129   biblio.author,
 130   borrowers.borrowernumber,
 131   biblio.biblionumber,
 132   borrowers.branchcode
 133   FROM issues
 134 LEFT JOIN borrowers   ON (issues.borrowernumber=borrowers.borrowernumber )
 135 LEFT JOIN items       ON (issues.itemnumber=items.itemnumber)
 136 LEFT JOIN biblioitems ON (biblioitems.biblioitemnumber=items.biblioitemnumber)
 137 LEFT JOIN biblio      ON (biblio.biblionumber=items.biblionumber )
 138 WHERE 1=1 "; # placeholder, since it is possible that none of the additional
 139              # conditions will be selected by user
 140 $strsth.=" AND date_due               < NOW() " unless ($showall);
 141 $strsth.=" AND (borrowers.firstname like '".$bornamefilter."%' or borrowers.surname like '".$bornamefilter."%' or borrowers.cardnumber like '".$bornamefilter."%')" if($bornamefilter) ;
 142 $strsth.=" AND borrowers.categorycode = '" . $borcatfilter   . "' " if $borcatfilter;
 143 $strsth.=" AND biblioitems.itemtype   = '" . $itemtypefilter . "' " if $itemtypefilter;
 144 $strsth.=" AND borrowers.flags        = '" . $borflagsfilter . "' " if $borflagsfilter;
 145 $strsth.=" AND borrowers.branchcode   = '" . $branchfilter   . "' " if $branchfilter;
 146 $strsth.=" ORDER BY " . (
 147     ($order eq "surname" or $order eq "surname desc") ? "$order, date_due"                 :
 148     ($order eq "title"    or $order eq    "title desc") ? "$order, date_due, surname"       :
 149     ($order eq "barcode"  or $order eq  "barcode desc") ? "items.$order, date_due, surname" :
 150                             ($order eq "date_due desc") ? "date_due DESC, surname"          :
 151                                                           "date_due, surname"  # default sort order
 152 );
 153 $template->param(sql=>$strsth);
 154 my $sth=$dbh->prepare($strsth);
 155 #warn "overdue.pl : query string ".$strsth;
 156 $sth->execute();
 157
 158 my @overduedata;
 159 while (my $data=$sth->fetchrow_hashref) {
 160     push @overduedata, {
 161         issuedate      => format_date($data->{issuedate}),
 162         duedate        => format_date($data->{date_due}),
 163         surname        => $data->{surname},
 164         firstname      => $data->{firstname},
 165         borrowernumber => $data->{borrowernumber},
 166         barcode        => $data->{barcode},
 167         itemnum        => $data->{itemnumber},
 168         itemcallnumber => $data->{itemcallnumber},
 169         address        => $data->{address},
 170         city           => $data->{city},
 171         zipcode        => $data->{zipcode},
 172         phone          => $data->{phone},
 173         email          => $data->{email},
 174         biblionumber   => $data->{biblionumber},
 175         title          => $data->{title},
 176         author         => $data->{author},
 177         branchcode     => $data->{branchcode},
 178     };
 179 }
 180
 181 $template->param(
 182     todaysdate  => format_date($todaysdate),
 183     overdueloop => \@overduedata
 184 );
 185
 186 # download the complete CSV
 187 if ($op eq 'csv') {
 188         binmode(STDOUT, ":utf8");
 189         my $csv = build_csv(\@overduedata);
 190         print $input->header(-type => 'application/vnd.sun.xml.calc',
 191                              -encoding    => 'utf-8',
 192                              -attachment=>"overdues.csv",
 193                              -filename=>"overdues.csv" );
 194         print $csv;
 195         exit;
 196 }
 197
 198 output_html_with_http_headers $input, $cookie, $template->output;
 199
 200
 201 sub build_csv {
 202     my $overdues = shift;
 203
 204     return "" if scalar(@$overdues) == 0;
 205
 206     my @lines = ();
 207
 208     # build header ...
 209     my @keys = sort keys %{ $overdues->[0] };
 210     my $csv = Text::CSV_XS->new({
 211         sep_char => C4::Context->preference("delimiter") ?
 212                     C4::Context->preference("delimiter") : ';' ,
 213     });
 214     $csv->combine(@keys);
 215     push @lines, $csv->string();
 216
 217     # ... and rest of report
 218     foreach my $overdue ( @{ $overdues } ) {
 219         push @lines, $csv->string() if $csv->combine(map { $overdue->{$_} } @keys);
 220     }
 221
 222     return join("\n", @lines) . "\n";
 223 }