circ/overdue.pl

   1 #!/usr/bin/perl
   2
   3
   4 # Copyright 2000-2002 Katipo Communications
   5 # Parts copyright 2010 BibLibre
   6 #
   7 # This file is part of Koha.
   8 #
   9 # Koha is free software; you can redistribute it and/or modify it
  10 # under the terms of the GNU General Public License as published by
  11 # the Free Software Foundation; either version 3 of the License, or
  12 # (at your option) any later version.
  13 #
  14 # Koha is distributed in the hope that it will be useful, but
  15 # WITHOUT ANY WARRANTY; without even the implied warranty of
  16 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  17 # GNU General Public License for more details.
  18 #
  19 # You should have received a copy of the GNU General Public License
  20 # along with Koha; if not, see <http://www.gnu.org/licenses>.
  21
  22 use Modern::Perl;
  23 use C4::Context;
  24 use C4::Output qw( output_html_with_http_headers );
  25 use CGI qw(-oldstyle_urls -utf8);
  26 use C4::Auth qw( get_template_and_user );
  27 use Text::CSV_XS;
  28 use Koha::DateUtils qw( dt_from_string output_pref );
  29 use Koha::Patron::Attribute::Types;
  30 use DateTime;
  31 use DateTime::Format::MySQL;
  32
  33 my $input = CGI->new;
  34 my $showall         = $input->param('showall');
  35 my $bornamefilter   = $input->param('borname') || '';
  36 my $borcatfilter    = $input->param('borcat') || '';
  37 my $itemtypefilter  = $input->param('itemtype') || '';
  38 my $borflagsfilter  = $input->param('borflag') || '';
  39 my $branchfilter    = $input->param('branch') || '';
  40 my $homebranchfilter    = $input->param('homebranch') || '';
  41 my $holdingbranchfilter = $input->param('holdingbranch') || '';
  42 my $dateduefrom     = $input->param('dateduefrom');
  43 my $datedueto       = $input->param('datedueto');
  44 my $op              = $input->param('op') || '';
  45
  46 if ( $dateduefrom ) {
  47     $dateduefrom = dt_from_string( $dateduefrom );
  48 }
  49 if ( $datedueto ) {
  50     $datedueto = dt_from_string( $datedueto )->set_hour(23)->set_minute(59);
  51 }
  52
  53 my $filters = {
  54     itemtype      => $itemtypefilter,
  55     borname       => $bornamefilter,
  56     borcat        => $borcatfilter,
  57     itemtype      => $itemtypefilter,
  58     borflag       => $borflagsfilter,
  59     branch        => $branchfilter,
  60     homebranch    => $homebranchfilter,
  61     holdingbranch => $holdingbranchfilter,
  62     dateduefrom   => $dateduefrom,
  63     datedueto     => $datedueto,
  64     showall       => $showall,
  65 };
  66
  67 my $isfiltered      = $op =~ /apply/i && $op =~ /filter/i;
  68 my $noreport        = C4::Context->preference('FilterBeforeOverdueReport') && ! $isfiltered && $op ne "csv";
  69
  70 my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
  71     {
  72         template_name   => "circ/overdue.tt",
  73         query           => $input,
  74         type            => "intranet",
  75         flagsrequired   => { circulate => "overdues_report" },
  76     }
  77 );
  78
  79 our $logged_in_user = Koha::Patrons->find( $loggedinuser );
  80
  81 my $dbh = C4::Context->dbh;
  82
  83 my $req;
  84 $req = $dbh->prepare( "select categorycode, description from categories order by description");
  85 $req->execute;
  86 my @borcatloop;
  87 while (my ($catcode, $description) =$req->fetchrow) {
  88     push @borcatloop, {
  89         value    => $catcode,
  90         selected => $catcode eq $borcatfilter ? 1 : 0,
  91         catname  => $description,
  92     };
  93 }
  94
  95 $req = $dbh->prepare( "select itemtype, description from itemtypes order by description");
  96 $req->execute;
  97 my @itemtypeloop;
  98 while (my ($itemtype, $description) =$req->fetchrow) {
  99     push @itemtypeloop, {
 100         value        => $itemtype,
 101         selected     => $itemtype eq $itemtypefilter ? 1 : 0,
 102         itemtypename => $description,
 103     };
 104 }
 105
 106 # Filtering by Patron Attributes
 107 #  @patron_attr_filter_loop        is non empty if there are any patron attribute filters
 108 #  %cgi_attrcode_to_attrvalues     contains the patron attribute filter values, as returned by the CGI
 109 #  %borrowernumber_to_attributes   is populated by those borrowernumbers matching the patron attribute filters
 110
 111 my %cgi_attrcode_to_attrvalues;     # ( patron_attribute_code => [ zero or more attribute filter values from the CGI ] )
 112 for my $attrcode (grep { /^patron_attr_filter_/ } $input->multi_param) {
 113     if (my @attrvalues = grep { length($_) > 0 } $input->multi_param($attrcode)) {
 114         $attrcode =~ s/^patron_attr_filter_//;
 115         $cgi_attrcode_to_attrvalues{$attrcode} = \@attrvalues;
 116     }
 117 }
 118 my $have_pattr_filter_data = keys(%cgi_attrcode_to_attrvalues) > 0;
 119
 120 my @patron_attr_filter_loop;   # array of [ domid cgivalue ismany isclone ordinal code description repeatable authorised_value_category ]
 121
 122 my $patron_attrs = Koha::Patron::Attribute::Types->search_with_library_limits(
 123     {
 124         staff_searchable => 1,
 125     },
 126     {},
 127     C4::Context->userenv->{'branch'}
 128 );
 129
 130 my $ordinal = 0;
 131 while (my $attr = $patron_attrs->next ) {
 132     my $row = {
 133         code => $attr->code,
 134         description => $attr->description,
 135         repeatable => $attr->repeatable,
 136         authorised_value_category => $attr->authorised_value_category,
 137     };
 138     $row->{ordinal} = $ordinal;
 139     my $code = $row->{code};
 140     my $cgivalues = $cgi_attrcode_to_attrvalues{$code} || [ '' ];
 141     my $isclone = 0;
 142     $row->{ismany} = @$cgivalues > 1;
 143     my $serial = 0;
 144     for (@$cgivalues) {
 145         $row->{domid} = $ordinal * 1000 + $serial;
 146         $row->{cgivalue} = $_;
 147         $row->{isclone} = $isclone;
 148         push @patron_attr_filter_loop, { %$row };  # careful: must store a *deep copy* of the modified row
 149     } continue { $isclone = 1, ++$serial }
 150 } continue { ++$ordinal }
 151
 152 my %borrowernumber_to_attributes;    # hash of { borrowernumber => { attrcode => [ [val,display], [val,display], ... ] } }
 153                                      #   i.e. val differs from display when attr is an authorised value
 154 if (@patron_attr_filter_loop) {
 155     # MAYBE FIXME: currently, *all* borrower_attributes are loaded into %borrowernumber_to_attributes
 156     #              then filtered and honed down to match the patron attribute filters. If this is
 157     #              too resource intensive, MySQL can be used to do the filtering, i.e. rewire the
 158     #              SQL below to select only those attribute values that match the filters.
 159
 160     my $sql = q(SELECT borrowernumber AS bn, b.code, attribute AS val, category AS avcategory, lib AS avdescription
 161         FROM borrower_attributes b
 162         JOIN borrower_attribute_types bt ON (b.code = bt.code)
 163         LEFT JOIN authorised_values a ON (a.category = bt.authorised_value_category AND a.authorised_value = b.attribute));
 164     my $sth = $dbh->prepare($sql);
 165     $sth->execute();
 166     while (my $row = $sth->fetchrow_hashref) {
 167         my $pattrs = $borrowernumber_to_attributes{$row->{bn}} ||= { };
 168         push @{ $pattrs->{$row->{code}} }, [
 169             $row->{val},
 170             defined $row->{avdescription} ? $row->{avdescription} : $row->{val},
 171         ];
 172     }
 173
 174     for my $bn (keys %borrowernumber_to_attributes) {
 175         my $pattrs = $borrowernumber_to_attributes{$bn};
 176         my $keep = 1;
 177         for my $code (keys %cgi_attrcode_to_attrvalues) {
 178             # discard patrons that do not match (case insensitive) at least one of each attribute filter value
 179             my $discard = 1;
 180             for my $attrval (map { lc $_ } @{ $cgi_attrcode_to_attrvalues{$code} }) {
 181                 ## if (grep { $attrval eq lc($_->[0]) } @{ $pattrs->{$code} })
 182                 if (grep { $attrval eq lc($_->[1]) } @{ $pattrs->{$code} }) {
 183                     $discard = 0;
 184                     last;
 185                 }
 186             }
 187             if ($discard) {
 188                 $keep = 0;
 189                 last;
 190             }
 191         }
 192         delete $borrowernumber_to_attributes{$bn} if !$keep;
 193     }
 194 }
 195
 196
 197 $template->param(
 198     patron_attr_header_loop => [ map { { header => $_->{description} } } grep { ! $_->{isclone} } @patron_attr_filter_loop ],
 199     filters => $filters,
 200     borcatloop=> \@borcatloop,
 201     itemtypeloop => \@itemtypeloop,
 202     patron_attr_filter_loop => \@patron_attr_filter_loop,
 203     showall => $showall,
 204 );
 205
 206 if ($noreport) {
 207     # la de dah ... page comes up presto-quicko
 208     $template->param( noreport  => $noreport );
 209 } else {
 210     # FIXME : the left joins + where clauses make the following SQL query really slow with large datasets :(
 211     #
 212     #  FIX 1: use the table with the least rows as first in the join, second least second, etc
 213     #         ref: http://www.fiftyfoureleven.com/weblog/web-development/programming-and-scripts/mysql-optimization-tip
 214     #
 215     #  FIX 2: ensure there are indexes for columns participating in the WHERE clauses, where feasible/reasonable
 216
 217
 218     my $today_dt = dt_from_string();
 219     $today_dt->truncate(to => 'minute');
 220     my $todaysdate = $today_dt->strftime('%Y-%m-%d %H:%M');
 221
 222     $bornamefilter =~s/\*/\%/g;
 223     $bornamefilter =~s/\?/\_/g;
 224
 225     my $strsth="SELECT date_due,
 226         borrowers.title as borrowertitle,
 227         borrowers.surname,
 228         borrowers.firstname,
 229         borrowers.streetnumber,
 230         borrowers.streettype,
 231         borrowers.address,
 232         borrowers.address2,
 233         borrowers.city,
 234         borrowers.zipcode,
 235         borrowers.country,
 236         borrowers.phone,
 237         borrowers.email,
 238         borrowers.cardnumber,
 239         borrowers.borrowernumber,
 240         borrowers.branchcode,
 241         issues.itemnumber,
 242         issues.issuedate,
 243         items.barcode,
 244         items.homebranch,
 245         items.holdingbranch,
 246         items.location,
 247         biblio.title,
 248         biblio.author,
 249         biblio.biblionumber,
 250         items.itemcallnumber,
 251         items.replacementprice,
 252         items.enumchron,
 253         items.itemnotes_nonpublic,
 254         items.itype
 255       FROM issues
 256     LEFT JOIN borrowers   ON (issues.borrowernumber=borrowers.borrowernumber )
 257     LEFT JOIN items       ON (issues.itemnumber=items.itemnumber)
 258     LEFT JOIN biblioitems ON (biblioitems.biblioitemnumber=items.biblioitemnumber)
 259     LEFT JOIN biblio      ON (biblio.biblionumber=items.biblionumber )
 260     WHERE 1=1 "; # placeholder, since it is possible that none of the additional
 261                  # conditions will be selected by user
 262     $strsth.=" AND date_due               < '" . $todaysdate     . "' " unless ($showall or $datedueto);
 263     $strsth.=" AND (borrowers.firstname like '".$bornamefilter."%' or borrowers.surname like '".$bornamefilter."%' or borrowers.cardnumber like '".$bornamefilter."%')" if($bornamefilter) ;
 264     $strsth.=" AND borrowers.categorycode = '" . $borcatfilter   . "' " if $borcatfilter;
 265     if( $itemtypefilter ){
 266         if( C4::Context->preference('item-level_itypes') ){
 267             $strsth.=" AND items.itype   = '" . $itemtypefilter . "' ";
 268         } else {
 269             $strsth.=" AND biblioitems.itemtype   = '" . $itemtypefilter . "' ";
 270         }
 271     }
 272     if ( $borflagsfilter eq 'gonenoaddress' ) {
 273         $strsth .= " AND borrowers.gonenoaddress <> 0";
 274     }
 275     elsif ( $borflagsfilter eq 'debarred' ) {
 276         $strsth .= " AND borrowers.debarred >=  CURDATE()" ;
 277     }
 278     elsif ( $borflagsfilter eq 'lost') {
 279         $strsth .= " AND borrowers.lost <> 0";
 280     }
 281     $strsth.=" AND borrowers.branchcode   = '" . $branchfilter   . "' " if $branchfilter;
 282     $strsth.=" AND items.homebranch       = '" . $homebranchfilter . "' " if $homebranchfilter;
 283     $strsth.=" AND items.holdingbranch    = '" . $holdingbranchfilter . "' " if $holdingbranchfilter;
 284     $strsth.=" AND date_due >= ?" if $dateduefrom;
 285     $strsth.=" AND date_due <= ?" if $datedueto;
 286     # restrict patrons (borrowers) to those matching the patron attribute filter(s), if any
 287     my $bnlist = $have_pattr_filter_data ? join(',',keys %borrowernumber_to_attributes) : '';
 288     $strsth =~ s/WHERE 1=1/WHERE 1=1 AND borrowers.borrowernumber IN ($bnlist)/ if $bnlist;
 289     $strsth =~ s/WHERE 1=1/WHERE 0=1/ if $have_pattr_filter_data  && !$bnlist;  # no match if no borrowers matched patron attrs
 290     $strsth.=" ORDER BY date_due, surname, firstname";
 291     $template->param(sql=>$strsth);
 292     my $sth=$dbh->prepare($strsth);
 293     $sth->execute(
 294         ($dateduefrom ? DateTime::Format::MySQL->format_datetime($dateduefrom) : ()),
 295         ($datedueto ? DateTime::Format::MySQL->format_datetime($datedueto) : ()),
 296     );
 297
 298     my @overduedata;
 299     while (my $data = $sth->fetchrow_hashref) {
 300
 301         # most of the overdue report data is linked to the database schema, i.e. things like borrowernumber and phone
 302         # but the patron attributes (patron_attr_value_loop) are unnormalised and varies dynamically from one db to the next
 303
 304         my $pattrs = $borrowernumber_to_attributes{$data->{borrowernumber}} || {};  # patron attrs for this borrower
 305         # $pattrs is a hash { attrcode => [  [value,displayvalue], [value,displayvalue]... ] }
 306
 307         my @patron_attr_value_loop;   # template array [ {value=>v1}, {value=>v2} ... } ]
 308         for my $pattr_filter (grep { ! $_->{isclone} } @patron_attr_filter_loop) {
 309             my @displayvalues = map { $_->[1] } @{ $pattrs->{$pattr_filter->{code}} };   # grab second value from each subarray
 310             push @patron_attr_value_loop, { value => join(', ', sort { lc $a cmp lc $b } @displayvalues) };
 311         }
 312
 313         push @overduedata, {
 314             patron                 => Koha::Patrons->find( $data->{borrowernumber} ),
 315             duedate                => $data->{date_due},
 316             borrowernumber         => $data->{borrowernumber},
 317             cardnumber             => $data->{cardnumber},
 318             borrowertitle          => $data->{borrowertitle},
 319             surname                => $data->{surname},
 320             firstname              => $data->{firstname},
 321             streetnumber           => $data->{streetnumber},
 322             streettype             => $data->{streettype},
 323             address                => $data->{address},
 324             address2               => $data->{address2},
 325             city                   => $data->{city},
 326             zipcode                => $data->{zipcode},
 327             country                => $data->{country},
 328             phone                  => $data->{phone},
 329             email                  => $data->{email},
 330             branchcode             => $data->{branchcode},
 331             barcode                => $data->{barcode},
 332             itemnum                => $data->{itemnumber},
 333             issuedate              => output_pref({ dt => dt_from_string( $data->{issuedate} ), dateonly => 1 }),
 334             biblionumber           => $data->{biblionumber},
 335             title                  => $data->{title},
 336             author                 => $data->{author},
 337             homebranchcode         => $data->{homebranch},
 338             holdingbranchcode      => $data->{holdingbranch},
 339             location               => $data->{location},
 340             itemcallnumber         => $data->{itemcallnumber},
 341             replacementprice       => $data->{replacementprice},
 342             itemnotes_nonpublic    => $data->{itemnotes_nonpublic},
 343             enumchron              => $data->{enumchron},
 344             itemtype               => $data->{itype},
 345             patron_attr_value_loop => \@patron_attr_value_loop,
 346         };
 347     }
 348
 349     if ($op eq 'csv') {
 350         binmode(STDOUT, ":encoding(UTF-8)");
 351         my $csv = build_csv(\@overduedata);
 352         print $input->header(-type => 'application/vnd.sun.xml.calc',
 353                              -encoding    => 'utf-8',
 354                              -attachment=>"overdues.csv",
 355                              -filename=>"overdues.csv" );
 356         print $csv;
 357         exit;
 358     }
 359
 360     # generate parameter list for CSV download link
 361     my $new_cgi = CGI->new($input);
 362     $new_cgi->delete('op');
 363
 364     $template->param(
 365         todaysdate              => output_pref($today_dt),
 366         overdueloop             => \@overduedata,
 367         nnoverdue               => scalar(@overduedata),
 368         noverdue_is_plural      => scalar(@overduedata) != 1,
 369         noreport                => $noreport,
 370         isfiltered              => $isfiltered,
 371         borflag_gonenoaddress   => $borflagsfilter eq 'gonenoaddress',
 372         borflag_debarred        => $borflagsfilter eq 'debarred',
 373         borflag_lost            => $borflagsfilter eq 'lost',
 374     );
 375
 376 }
 377
 378 output_html_with_http_headers $input, $cookie, $template->output;
 379
 380
 381 sub build_csv {
 382     my $overdues = shift;
 383
 384     return "" if scalar(@$overdues) == 0;
 385
 386     my @lines = ();
 387
 388     # build header ...
 389     my @keys =
 390       qw ( duedate title author borrowertitle firstname surname phone barcode email address address2 zipcode city country
 391       branchcode itemcallnumber biblionumber borrowernumber itemnum issuedate replacementprice itemnotes_nonpublic streetnumber streettype);
 392     my $csv = Text::CSV_XS->new();
 393     $csv->combine(@keys);
 394     push @lines, $csv->string();
 395
 396     my @private_keys = qw( borrowertitle firstname surname phone email address address2 zipcode city country streetnumber streettype );
 397     # ... and rest of report
 398     foreach my $overdue ( @{ $overdues } ) {
 399         unless ( $logged_in_user->can_see_patron_infos( $overdue->{patron} ) ) {
 400             $overdue->{$_} = undef for @private_keys;
 401         }
 402         push @lines, $csv->string() if $csv->combine(map { $overdue->{$_} } @keys);
 403     }
 404
 405     return join("\n", @lines) . "\n";
 406 }