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