X-Git-Url: http://koha-dev.rot13.org:8081/gitweb/?a=blobdiff_plain;f=circ%2Foverdue.pl;h=cad8e6d57138750115b3d04c00185daf10ceed68;hb=8c7ce82ad609cd3a4dee1e443918ccbc09024c75;hp=85bfdb75320c49c587b33603efeceb5d6617ae1e;hpb=f8e9fb6445dadbdef91e13a253c9c6bcb75e0eec;p=srvgit diff --git a/circ/overdue.pl b/circ/overdue.pl index 85bfdb7532..cad8e6d571 100755 --- a/circ/overdue.pl +++ b/circ/overdue.pl @@ -1,6 +1,5 @@ #!/usr/bin/perl -# $Id$ # Copyright 2000-2002 Katipo Communications # @@ -15,22 +14,33 @@ # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR # A PARTICULAR PURPOSE. See the GNU General Public License for more details. # -# You should have received a copy of the GNU General Public License along with -# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place, -# Suite 330, Boston, MA 02111-1307 USA +# You should have received a copy of the GNU General Public License along +# with Koha; if not, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. use strict; +use warnings; use C4::Context; use C4::Output; -use C4::Interface::CGI::Output; -use CGI; +use CGI qw(-oldstyle_urls); use C4::Auth; -use C4::Date; +use C4::Branch; +use C4::Debug; +use C4::Dates qw/format_date/; +use Date::Calc qw/Today/; +use Text::CSV_XS; my $input = new CGI; -my $type = $input->param('type'); - -my $theme = $input->param('theme'); # only used if allowthemeoverride is set +my $order = $input->param('order') || ''; +my $showall = $input->param('showall'); +my $bornamefilter = $input->param('borname') || ''; +my $borcatfilter = $input->param('borcat') || ''; +my $itemtypefilter = $input->param('itemtype') || ''; +my $borflagsfilter = $input->param('borflag') || ''; +my $branchfilter = $input->param('branch') || ''; +my $op = $input->param('op') || ''; +my $isfiltered = $op =~ /apply/i && $op =~ /filter/i; +my $noreport = C4::Context->preference('FilterBeforeOverdueReport') && ! $isfiltered && $op ne "csv"; my ( $template, $loggedinuser, $cookie ) = get_template_and_user( { @@ -38,88 +48,334 @@ my ( $template, $loggedinuser, $cookie ) = get_template_and_user( query => $input, type => "intranet", authnotrequired => 0, - flagsrequired => { reports => 1 }, + flagsrequired => { reports => 1, circulate => "circulate_remaining_permissions" }, debug => 1, } ); -my $duedate; -my $borrowernumber; -my $itemnum; -my $data1; -my $data2; -my $data3; -my $name; -my $phone; -my $email; -my $biblionumber; -my $title; -my $author; -my @datearr = localtime( time() ); -my $todaysdate = - ( 1900 + $datearr[5] ) . '-' - . sprintf( "%0.2d", ( $datearr[4] + 1 ) ) . '-' - . sprintf( "%0.2d", $datearr[3] ); my $dbh = C4::Context->dbh; -my $sth = - $dbh->prepare( - "select date_due,borrowernumber,itemnumber - from issues - where isnull(returndate) && date_dueexecute($todaysdate); - -my @overduedata; -while ( my $data = $sth->fetchrow_hashref ) { - $duedate = format_date($data->{'date_due'}); - $borrowernumber = $data->{'borrowernumber'}; - $itemnum = $data->{'itemnumber'}; - - my $sth1 = - $dbh->prepare( -"select concat(firstname,' ',surname),phone,email from borrowers where borrowernumber=?" - ); - $sth1->execute($borrowernumber); - $data1 = $sth1->fetchrow_hashref; - $name = $data1->{'concat(firstname,\' \',surname)'}; - $phone = $data1->{'phone'}; - $email = $data1->{'email'}; - $sth1->finish; - - my $sth2 = - $dbh->prepare("select biblionumber from items where itemnumber=?"); - $sth2->execute($itemnum); - $data2 = $sth2->fetchrow_hashref; - $biblionumber = $data2->{'biblionumber'}; - $sth2->finish; - - my $sth3 = - $dbh->prepare("select title,author from biblio where biblionumber=?"); - $sth3->execute($biblionumber); - $data3 = $sth3->fetchrow_hashref; - $title = $data3->{'title'}; - $author = $data3->{'author'}; - $sth3->finish; - push( - @overduedata, - { - duedate => $duedate, - borrowernumber => $borrowernumber, - itemnum => $itemnum, - name => $name, - phone => $phone, - email => $email, - biblionumber => $biblionumber, - title => $title, - author => $author +my $req; +$req = $dbh->prepare( "select categorycode, description from categories order by description"); +$req->execute; +my @borcatloop; +while (my ($catcode, $description) =$req->fetchrow) { + push @borcatloop, { + value => $catcode, + selected => $catcode eq $borcatfilter ? 1 : 0, + catname => $description, + }; +} + +$req = $dbh->prepare( "select itemtype, description from itemtypes order by description"); +$req->execute; +my @itemtypeloop; +while (my ($itemtype, $description) =$req->fetchrow) { + push @itemtypeloop, { + value => $itemtype, + selected => $itemtype eq $itemtypefilter ? 1 : 0, + itemtypename => $description, + }; +} +my $onlymine=C4::Context->preference('IndependantBranches') && + C4::Context->userenv && + C4::Context->userenv->{flags} % 2 !=1 && + C4::Context->userenv->{branch}; + +$branchfilter = C4::Context->userenv->{'branch'} if ($onlymine && !$branchfilter); + +# Filtering by Patron Attributes +# @patron_attr_filter_loop is non empty if there are any patron attribute filters +# %cgi_attrcode_to_attrvalues contains the patron attribute filter values, as returned by the CGI +# %borrowernumber_to_attributes is populated by those borrowernumbers matching the patron attribute filters + +my %cgi_attrcode_to_attrvalues; # ( patron_attribute_code => [ zero or more attribute filter values from the CGI ] ) +for my $attrcode (grep { /^patron_attr_filter_/ } $input->param) { + if (my @attrvalues = grep { length($_) > 0 } $input->param($attrcode)) { + $attrcode =~ s/^patron_attr_filter_//; + $cgi_attrcode_to_attrvalues{$attrcode} = \@attrvalues; + print STDERR ">>>param($attrcode)[@{[scalar @attrvalues]}] = '@attrvalues'\n" if $debug; + } +} +my $have_pattr_filter_data = keys(%cgi_attrcode_to_attrvalues) > 0; + +my @patron_attr_filter_loop; # array of [ domid cgivalue ismany isclone ordinal code description repeatable authorised_value_category ] +my @patron_attr_order_loop; # array of { label => $patron_attr_label, value => $patron_attr_order } + +my @sort_roots = qw(borrower title barcode date_due); +push @sort_roots, map {$_ . " desc"} @sort_roots; +my @order_loop = ({selected => $order ? 0 : 1}); # initial blank row +foreach (@sort_roots) { + my $tmpl_name = $_; + $tmpl_name =~ s/\s/_/g; + push @order_loop, { + selected => $order eq $_ ? 1 : 0, + ordervalue => $_, + 'order_' . $tmpl_name => 1, + }; +} + +my $sth = $dbh->prepare('SELECT code,description,repeatable,authorised_value_category + FROM borrower_attribute_types + WHERE staff_searchable <> 0 + ORDER BY description'); +$sth->execute(); +my $ordinal = 0; +while (my $row = $sth->fetchrow_hashref) { + $row->{ordinal} = $ordinal; + my $code = $row->{code}; + my $cgivalues = $cgi_attrcode_to_attrvalues{$code} || [ '' ]; + my $isclone = 0; + $row->{ismany} = @$cgivalues > 1; + my $serial = 0; + for (@$cgivalues) { + $row->{domid} = $ordinal * 1000 + $serial; + $row->{cgivalue} = $_; + $row->{isclone} = $isclone; + push @patron_attr_filter_loop, { %$row }; # careful: must store a *deep copy* of the modified row + } continue { $isclone = 1, ++$serial } + foreach my $sortorder ('asc', 'desc') { + my $ordervalue = "patron_attr_${sortorder}_${code}"; + push @order_loop, { + selected => $order eq $ordervalue ? 1 : 0, + ordervalue => $ordervalue, + label => $row->{description}, + $sortorder => 1, + }; + } +} continue { ++$ordinal } +for (@patron_attr_order_loop) { $_->{selected} = 1 if $order eq $_->{value} } + +$template->param(ORDER_LOOP => \@order_loop); + +my %borrowernumber_to_attributes; # hash of { borrowernumber => { attrcode => [ [val,display], [val,display], ... ] } } + # i.e. val differs from display when attr is an authorised value +if (@patron_attr_filter_loop) { + # MAYBE FIXME: currently, *all* borrower_attributes are loaded into %borrowernumber_to_attributes + # then filtered and honed down to match the patron attribute filters. If this is + # too resource intensive, MySQL can be used to do the filtering, i.e. rewire the + # SQL below to select only those attribute values that match the filters. + + my $sql = q(SELECT borrowernumber AS bn, b.code, attribute AS val, category AS avcategory, lib AS avdescription + FROM borrower_attributes b + JOIN borrower_attribute_types bt ON (b.code = bt.code) + LEFT JOIN authorised_values a ON (a.category = bt.authorised_value_category AND a.authorised_value = b.attribute)); + my $sth = $dbh->prepare($sql); + $sth->execute(); + while (my $row = $sth->fetchrow_hashref) { + my $pattrs = $borrowernumber_to_attributes{$row->{bn}} ||= { }; + push @{ $pattrs->{$row->{code}} }, [ + $row->{val}, + defined $row->{avdescription} ? $row->{avdescription} : $row->{val}, + ]; + } + + for my $bn (keys %borrowernumber_to_attributes) { + my $pattrs = $borrowernumber_to_attributes{$bn}; + my $keep = 1; + for my $code (keys %cgi_attrcode_to_attrvalues) { + # discard patrons that do not match (case insensitive) at least one of each attribute filter value + my $discard = 1; + for my $attrval (map { lc $_ } @{ $cgi_attrcode_to_attrvalues{$code} }) { + ## if (grep { $attrval eq lc($_->[0]) } @{ $pattrs->{$code} }) + if (grep { $attrval eq lc($_->[1]) } @{ $pattrs->{$code} }) { + $discard = 0; + last; + } + } + if ($discard) { + $keep = 0; + last; + } } - ); + if ($debug) { + my $showkeep = $keep ? 'keep' : 'do NOT keep'; + print STDERR ">>> patron $bn: $showkeep attributes: "; + for (sort keys %$pattrs) { my @a=map { "$_->[0]/$_->[1] " } @{$pattrs->{$_}}; print STDERR "attrcode $_ = [@a] " } + print STDERR "\n"; + } + delete $borrowernumber_to_attributes{$bn} if !$keep; + } } + $template->param( - todaysdate => $todaysdate, - overdueloop => \@overduedata -); + patron_attr_header_loop => [ map { { header => $_->{description} } } grep { ! $_->{isclone} } @patron_attr_filter_loop ], + branchloop => GetBranchesLoop($branchfilter, $onlymine), + branchfilter => $branchfilter, + borcatloop=> \@borcatloop, + itemtypeloop => \@itemtypeloop, + patron_attr_filter_loop => \@patron_attr_filter_loop, + borname => $bornamefilter, + order => $order, + showall => $showall); + +if ($noreport) { + # la de dah ... page comes up presto-quicko + $template->param( noreport => $noreport ); +} else { + # FIXME : the left joins + where clauses make the following SQL query really slow with large datasets :( + # + # FIX 1: use the table with the least rows as first in the join, second least second, etc + # ref: http://www.fiftyfoureleven.com/weblog/web-development/programming-and-scripts/mysql-optimization-tip + # + # FIX 2: ensure there are indexes for columns participating in the WHERE clauses, where feasible/reasonable + + + my $todaysdate = sprintf("%-04.4d-%-02.2d-%02.2d", Today()); + + $bornamefilter =~s/\*/\%/g; + $bornamefilter =~s/\?/\_/g; + + my $strsth="SELECT date_due, + concat(surname,' ', firstname) as borrower, + borrowers.phone, + borrowers.email, + issues.itemnumber, + items.barcode, + biblio.title, + biblio.author, + borrowers.borrowernumber, + biblio.biblionumber, + borrowers.branchcode, + items.itemcallnumber, + items.replacementprice + FROM issues + LEFT JOIN borrowers ON (issues.borrowernumber=borrowers.borrowernumber ) + LEFT JOIN items ON (issues.itemnumber=items.itemnumber) + LEFT JOIN biblioitems ON (biblioitems.biblioitemnumber=items.biblioitemnumber) + LEFT JOIN biblio ON (biblio.biblionumber=items.biblionumber ) + WHERE 1=1 "; # placeholder, since it is possible that none of the additional + # conditions will be selected by user + $strsth.=" AND date_due < '" . $todaysdate . "' " unless ($showall); + $strsth.=" AND (borrowers.firstname like '".$bornamefilter."%' or borrowers.surname like '".$bornamefilter."%' or borrowers.cardnumber like '".$bornamefilter."%')" if($bornamefilter) ; + $strsth.=" AND borrowers.categorycode = '" . $borcatfilter . "' " if $borcatfilter; + $strsth.=" AND biblioitems.itemtype = '" . $itemtypefilter . "' " if $itemtypefilter; + $strsth.=" AND borrowers.flags = '" . $borflagsfilter . "' " if $borflagsfilter; + $strsth.=" AND borrowers.branchcode = '" . $branchfilter . "' " if $branchfilter; + # restrict patrons (borrowers) to those matching the patron attribute filter(s), if any + my $bnlist = $have_pattr_filter_data ? join(',',keys %borrowernumber_to_attributes) : ''; + $strsth =~ s/WHERE 1=1/WHERE 1=1 AND borrowers.borrowernumber IN ($bnlist)/ if $bnlist; + $strsth =~ s/WHERE 1=1/WHERE 0=1/ if $have_pattr_filter_data && !$bnlist; # no match if no borrowers matched patron attrs + $strsth.=" ORDER BY " . ( + ($order eq "borrower" or $order eq "borrower desc") ? "$order, date_due" : + ($order eq "title" or $order eq "title desc") ? "$order, date_due, borrower" : + ($order eq "barcode" or $order eq "barcode desc") ? "items.$order, date_due, borrower" : + ($order eq "date_due desc") ? "date_due DESC, borrower" : + "date_due, borrower" # default sort order + ); + $template->param(sql=>$strsth); + my $sth=$dbh->prepare($strsth); + #warn "overdue.pl : query string ".$strsth; + $sth->execute(); + + my @overduedata; + while (my $data = $sth->fetchrow_hashref) { + + # most of the overdue report data is linked to the database schema, i.e. things like borrowernumber and phone + # but the patron attributes (patron_attr_value_loop) are unnormalised and varies dynamically from one db to the next + + my $pattrs = $borrowernumber_to_attributes{$data->{borrowernumber}} || {}; # patron attrs for this borrower + # $pattrs is a hash { attrcode => [ [value,displayvalue], [value,displayvalue]... ] } + + my @patron_attr_value_loop; # template array [ {value=>v1}, {value=>v2} ... } ] + for my $pattr_filter (grep { ! $_->{isclone} } @patron_attr_filter_loop) { + my @displayvalues = map { $_->[1] } @{ $pattrs->{$pattr_filter->{code}} }; # grab second value from each subarray + push @patron_attr_value_loop, { value => join(', ', sort { lc $a cmp lc $b } @displayvalues) }; + } + + push @overduedata, { + duedate => format_date($data->{date_due}), + borrowernumber => $data->{borrowernumber}, + barcode => $data->{barcode}, + itemnum => $data->{itemnumber}, + name => $data->{borrower}, + phone => $data->{phone}, + email => $data->{email}, + biblionumber => $data->{biblionumber}, + title => $data->{title}, + author => $data->{author}, + branchcode => $data->{branchcode}, + itemcallnumber => $data->{itemcallnumber}, + replacementprice => $data->{replacementprice}, + patron_attr_value_loop => \@patron_attr_value_loop, + }; + } + + my ($attrorder) = $order =~ /patron_attr_(.*)$/; + my $patrorder = ''; + my $sortorder = 'asc'; + if (defined $attrorder) { + ($sortorder, $patrorder) = split /_/, $attrorder, 2; + } + print STDERR ">>> order is $order, patrorder is $patrorder, sortorder is $sortorder\n" if $debug; + + if (my @attrtype = grep { $_->{'code'} eq $patrorder } @patron_attr_filter_loop) { # sort by patron attrs perhaps? + my $ordinal = $attrtype[0]{ordinal}; + print STDERR ">>> sort ordinal is $ordinal\n" if $debug; + + sub patronattr_sorter_asc { + lc $a->{patron_attr_value_loop}[$ordinal]{value} + cmp + lc $b->{patron_attr_value_loop}[$ordinal]{value} } + + sub patronattr_sorter_des { -patronattr_sorter_asc() } + + my $sorter = $sortorder eq 'desc' ? \&patronattr_sorter_des : \&patronattr_sorter_asc; + @overduedata = sort $sorter @overduedata; + } + + if ($op eq 'csv') { + binmode(STDOUT, ":utf8"); + my $csv = build_csv(\@overduedata); + print $input->header(-type => 'application/vnd.sun.xml.calc', + -encoding => 'utf-8', + -attachment=>"overdues.csv", + -filename=>"overdues.csv" ); + print $csv; + exit; + } + + # generate parameter list for CSV download link + my $new_cgi = CGI->new($input); + $new_cgi->delete('op'); + my $csv_param_string = $new_cgi->query_string(); + + $template->param( + csv_param_string => $csv_param_string, + todaysdate => format_date($todaysdate), + overdueloop => \@overduedata, + nnoverdue => scalar(@overduedata), + noverdue_is_plural => scalar(@overduedata) != 1, + noreport => $noreport, + isfiltered => $isfiltered, + borflag_gonenoaddress => $borflagsfilter eq 'gonenoaddress', + borflag_debarred => $borflagsfilter eq 'debarred', + borflag_lost => $borflagsfilter eq 'lost', + ); + +} output_html_with_http_headers $input, $cookie, $template->output; + + +sub build_csv { + my $overdues = shift; + + return "" if scalar(@$overdues) == 0; + + my @lines = (); + + # build header ... + my @keys = grep { $_ ne 'patron_attr_value_loop' } sort keys %{ $overdues->[0] }; + my $csv = Text::CSV_XS->new(); + $csv->combine(@keys); + push @lines, $csv->string(); + + # ... and rest of report + foreach my $overdue ( @{ $overdues } ) { + push @lines, $csv->string() if $csv->combine(map { $overdue->{$_} } @keys); + } + + return join("\n", @lines) . "\n"; +}