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 );
  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{
 161         SELECT b.borrowernumber AS bn, b.code AS attrcode, b.attribute AS attrval, a.lib AS avdescription
 162         FROM borrower_attributes b
 163         JOIN borrower_attribute_types bt ON (b.code = bt.code)
 164         LEFT JOIN authorised_values a ON (a.category = bt.authorised_value_category AND a.authorised_value = b.attribute)
 165     };
 166     my $sth = $dbh->prepare($sql);
 167     $sth->execute();
 168     while (my $row = $sth->fetchrow_hashref) {
 169         my $pattrs = $borrowernumber_to_attributes{$row->{bn}} ||= { };
 170         push @{ $pattrs->{$row->{attrcode}} }, [
 171             $row->{attrval},
 172             defined $row->{avdescription} ? $row->{avdescription} : $row->{attrval},
 173         ];
 174     }
 175
 176     for my $bn (keys %borrowernumber_to_attributes) {
 177         my $pattrs = $borrowernumber_to_attributes{$bn};
 178         my $keep = 1;
 179         for my $code (keys %cgi_attrcode_to_attrvalues) {
 180             # discard patrons that do not match (case insensitive) at least one of each attribute filter value
 181             my $discard = 1;
 182             for my $attrval (map { lc $_ } @{ $cgi_attrcode_to_attrvalues{$code} }) {
 183                 if (grep { $attrval eq lc($_->[0]) } @{ $pattrs->{$code} }) {
 184                     $discard = 0;
 185                     last;
 186                 }
 187             }
 188             if ($discard) {
 189                 $keep = 0;
 190                 last;
 191             }
 192         }
 193         delete $borrowernumber_to_attributes{$bn} if !$keep;
 194     }
 195 }
 196
 197
 198 $template->param(
 199     patron_attr_header_loop => [ map { { header => $_->{description} } } grep { ! $_->{isclone} } @patron_attr_filter_loop ],
 200     filters => $filters,
 201     borcatloop=> \@borcatloop,
 202     itemtypeloop => \@itemtypeloop,
 203     patron_attr_filter_loop => \@patron_attr_filter_loop,
 204     showall => $showall,
 205 );
 206
 207 if ($noreport) {
 208     # la de dah ... page comes up presto-quicko
 209     $template->param( noreport  => $noreport );
 210 } else {
 211     # FIXME : the left joins + where clauses make the following SQL query really slow with large datasets :(
 212     #
 213     #  FIX 1: use the table with the least rows as first in the join, second least second, etc
 214     #         ref: http://www.fiftyfoureleven.com/weblog/web-development/programming-and-scripts/mysql-optimization-tip
 215     #
 216     #  FIX 2: ensure there are indexes for columns participating in the WHERE clauses, where feasible/reasonable
 217
 218
 219     my $today_dt = dt_from_string();
 220     $today_dt->truncate(to => 'minute');
 221     my $todaysdate = $today_dt->strftime('%Y-%m-%d %H:%M');
 222
 223     $bornamefilter =~s/\*/\%/g;
 224     $bornamefilter =~s/\?/\_/g;
 225
 226     my $strsth="SELECT date_due,
 227         borrowers.title as borrowertitle,
 228         borrowers.surname,
 229         borrowers.firstname,
 230         borrowers.streetnumber,
 231         borrowers.streettype,
 232         borrowers.address,
 233         borrowers.address2,
 234         borrowers.city,
 235         borrowers.zipcode,
 236         borrowers.country,
 237         borrowers.phone,
 238         borrowers.email,
 239         borrowers.cardnumber,
 240         borrowers.borrowernumber,
 241         borrowers.branchcode,
 242         issues.itemnumber,
 243         issues.issuedate,
 244         items.barcode,
 245         items.homebranch,
 246         items.holdingbranch,
 247         items.location,
 248         biblio.title,
 249         biblio.subtitle,
 250         biblio.part_number,
 251         biblio.part_name,
 252         biblio.author,
 253         biblio.biblionumber,
 254         items.itemcallnumber,
 255         items.replacementprice,
 256         items.enumchron,
 257         items.itemnotes_nonpublic,
 258         items.itype,
 259         return_claims.created_on AS return_claim_created_on,
 260         return_claims.id AS return_claim_id
 261       FROM issues
 262     LEFT JOIN borrowers   ON (issues.borrowernumber=borrowers.borrowernumber )
 263     LEFT JOIN items       ON (issues.itemnumber=items.itemnumber)
 264     LEFT JOIN biblioitems ON (biblioitems.biblioitemnumber=items.biblioitemnumber)
 265     LEFT JOIN biblio      ON (biblio.biblionumber=items.biblionumber )
 266     LEFT JOIN return_claims ON (return_claims.borrowernumber=borrowers.borrowernumber AND return_claims.itemnumber=items.itemnumber)
 267     WHERE 1=1 "; # placeholder, since it is possible that none of the additional
 268                  # conditions will be selected by user
 269     $strsth.=" AND date_due               < '" . $todaysdate     . "' " unless ($showall or $datedueto);
 270     $strsth.=" AND (borrowers.firstname like '".$bornamefilter."%' or borrowers.surname like '".$bornamefilter."%' or borrowers.cardnumber like '".$bornamefilter."%')" if($bornamefilter) ;
 271     $strsth.=" AND borrowers.categorycode = '" . $borcatfilter   . "' " if $borcatfilter;
 272     if( $itemtypefilter ){
 273         if( C4::Context->preference('item-level_itypes') ){
 274             $strsth.=" AND items.itype   = '" . $itemtypefilter . "' ";
 275         } else {
 276             $strsth.=" AND biblioitems.itemtype   = '" . $itemtypefilter . "' ";
 277         }
 278     }
 279     if ( $borflagsfilter eq 'gonenoaddress' ) {
 280         $strsth .= " AND borrowers.gonenoaddress <> 0";
 281     }
 282     elsif ( $borflagsfilter eq 'debarred' ) {
 283         $strsth .= " AND borrowers.debarred >=  CURDATE()" ;
 284     }
 285     elsif ( $borflagsfilter eq 'lost') {
 286         $strsth .= " AND borrowers.lost <> 0";
 287     }
 288     $strsth.=" AND borrowers.branchcode   = '" . $branchfilter   . "' " if $branchfilter;
 289     $strsth.=" AND items.homebranch       = '" . $homebranchfilter . "' " if $homebranchfilter;
 290     $strsth.=" AND items.holdingbranch    = '" . $holdingbranchfilter . "' " if $holdingbranchfilter;
 291     $strsth.=" AND date_due >= ?" if $dateduefrom;
 292     $strsth.=" AND date_due <= ?" if $datedueto;
 293     # restrict patrons (borrowers) to those matching the patron attribute filter(s), if any
 294     my $bnlist = $have_pattr_filter_data ? join(',',keys %borrowernumber_to_attributes) : '';
 295     $strsth =~ s/WHERE 1=1/WHERE 1=1 AND borrowers.borrowernumber IN ($bnlist)/ if $bnlist;
 296     $strsth =~ s/WHERE 1=1/WHERE 0=1/ if $have_pattr_filter_data  && !$bnlist;  # no match if no borrowers matched patron attrs
 297     $strsth.=" ORDER BY date_due, surname, firstname";
 298     $template->param(sql=>$strsth);
 299     my $sth=$dbh->prepare($strsth);
 300     $sth->execute(
 301         ($dateduefrom ? DateTime::Format::MySQL->format_datetime($dateduefrom) : ()),
 302         ($datedueto ? DateTime::Format::MySQL->format_datetime($datedueto) : ()),
 303     );
 304
 305     my @overduedata;
 306     while (my $data = $sth->fetchrow_hashref) {
 307
 308         # most of the overdue report data is linked to the database schema, i.e. things like borrowernumber and phone
 309         # but the patron attributes (patron_attr_value_loop) are unnormalised and varies dynamically from one db to the next
 310
 311         my $pattrs = $borrowernumber_to_attributes{$data->{borrowernumber}} || {};  # patron attrs for this borrower
 312         # $pattrs is a hash { attrcode => [  [value,displayvalue], [value,displayvalue]... ] }
 313
 314         my @patron_attr_value_loop;   # template array [ {value=>v1}, {value=>v2} ... } ]
 315         for my $pattr_filter (grep { ! $_->{isclone} } @patron_attr_filter_loop) {
 316             my @displayvalues = map { $_->[1] } @{ $pattrs->{$pattr_filter->{code}} };   # grab second value from each subarray
 317             push @patron_attr_value_loop, { value => join(', ', sort { lc $a cmp lc $b } @displayvalues) };
 318         }
 319
 320         push @overduedata, {
 321             patron                 => Koha::Patrons->find( $data->{borrowernumber} ),
 322             duedate                => $data->{date_due},
 323             borrowernumber         => $data->{borrowernumber},
 324             cardnumber             => $data->{cardnumber},
 325             borrowertitle          => $data->{borrowertitle},
 326             surname                => $data->{surname},
 327             firstname              => $data->{firstname},
 328             streetnumber           => $data->{streetnumber},
 329             streettype             => $data->{streettype},
 330             address                => $data->{address},
 331             address2               => $data->{address2},
 332             city                   => $data->{city},
 333             zipcode                => $data->{zipcode},
 334             country                => $data->{country},
 335             phone                  => $data->{phone},
 336             email                  => $data->{email},
 337             branchcode             => $data->{branchcode},
 338             barcode                => $data->{barcode},
 339             itemnum                => $data->{itemnumber},
 340             issuedate              => $data->{issuedate},
 341             biblionumber           => $data->{biblionumber},
 342             title                  => $data->{title},
 343             subtitle               => $data->{subtitle},
 344             part_number            => $data->{part_number},
 345             part_name              => $data->{part_name},
 346             author                 => $data->{author},
 347             homebranchcode         => $data->{homebranch},
 348             holdingbranchcode      => $data->{holdingbranch},
 349             location               => $data->{location},
 350             itemcallnumber         => $data->{itemcallnumber},
 351             replacementprice       => $data->{replacementprice},
 352             itemnotes_nonpublic    => $data->{itemnotes_nonpublic},
 353             return_claim_created_on => $data->{return_claim_created_on},
 354             return_claim_id        => $data->{return_claim_id},
 355             enumchron              => $data->{enumchron},
 356             itemtype               => $data->{itype},
 357             patron_attr_value_loop => \@patron_attr_value_loop,
 358         };
 359     }
 360
 361     if ($op eq 'csv') {
 362         binmode(STDOUT, ":encoding(UTF-8)");
 363         my $csv = build_csv(\@overduedata);
 364         print $input->header(-type => 'application/vnd.sun.xml.calc',
 365                              -encoding    => 'utf-8',
 366                              -attachment=>"overdues.csv",
 367                              -filename=>"overdues.csv" );
 368         print $csv;
 369         exit;
 370     }
 371
 372     # generate parameter list for CSV download link
 373     my $new_cgi = CGI->new($input);
 374     $new_cgi->delete('op');
 375
 376     $template->param(
 377         todaysdate              => $today_dt,
 378         overdueloop             => \@overduedata,
 379         nnoverdue               => scalar(@overduedata),
 380         noverdue_is_plural      => scalar(@overduedata) != 1,
 381         noreport                => $noreport,
 382         isfiltered              => $isfiltered,
 383         borflag_gonenoaddress   => $borflagsfilter eq 'gonenoaddress',
 384         borflag_debarred        => $borflagsfilter eq 'debarred',
 385         borflag_lost            => $borflagsfilter eq 'lost',
 386     );
 387
 388 }
 389
 390 output_html_with_http_headers $input, $cookie, $template->output;
 391
 392
 393 sub build_csv {
 394     my $overdues = shift;
 395
 396     return "" if scalar(@$overdues) == 0;
 397
 398     my @lines = ();
 399
 400     # build header ...
 401     my @keys =
 402       qw ( duedate title author borrowertitle firstname surname phone barcode email address address2 zipcode city country
 403       branchcode itemcallnumber biblionumber borrowernumber itemnum issuedate replacementprice itemnotes_nonpublic streetnumber streettype);
 404     my $csv = Text::CSV_XS->new();
 405     $csv->combine(@keys);
 406     push @lines, $csv->string();
 407
 408     my @private_keys = qw( borrowertitle firstname surname phone email address address2 zipcode city country streetnumber streettype );
 409     # ... and rest of report
 410     foreach my $overdue ( @{ $overdues } ) {
 411         unless ( $logged_in_user->can_see_patron_infos( $overdue->{patron} ) ) {
 412             $overdue->{$_} = undef for @private_keys;
 413         }
 414         push @lines, $csv->string() if $csv->combine(map { $overdue->{$_} } @keys);
 415     }
 416
 417     return join("\n", @lines) . "\n";
 418 }