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