X-Git-Url: http://git.rot13.org/?a=blobdiff_plain;f=circ%2Foverdue.pl;h=b1b1be41658820fd2f99e966020c20dbb7552a86;hb=5dd3a9c157ef091729dbea78db9ace8c21b63338;hp=93f267fe2e945086b0acd6b9323392f491041363;hpb=9d0ab08a9b227640a33699f3467e84a7944e97e2;p=koha.git diff --git a/circ/overdue.pl b/circ/overdue.pl index 93f267fe2e..b1b1be4165 100755 --- a/circ/overdue.pl +++ b/circ/overdue.pl @@ -19,26 +19,28 @@ # Suite 330, Boston, MA 02111-1307 USA use strict; +use warnings; use C4::Context; use C4::Output; -use CGI; +use CGI qw(-oldstyle_urls); use C4::Auth; 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('borflags') || " "; -my $branchfilter = $input->param('branch'); -my $op = $input->param('op'); +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( { @@ -46,156 +48,334 @@ my ( $template, $loggedinuser, $cookie ) = get_template_and_user( query => $input, type => "intranet", authnotrequired => 0, - flagsrequired => { reports => 1, circulate => 1 }, + flagsrequired => { reports => 1, circulate => "circulate_remaining_permissions" }, debug => 1, } ); -my $dbh = C4::Context->dbh; +my $dbh = C4::Context->dbh; -# download the complete CSV -if ($op eq 'csv') { -warn "BRANCH : $branchfilter"; - my $csv = `../misc/cronjobs/overdue_notices.pl -csv -n`; # -library $branchfilter`; - print $input->header(-type => 'application/vnd.sun.xml.calc', - -encoding => 'utf-8', - -attachment=>"overdues.csv", - -filename=>"overdues.csv" ); - print $csv; - exit; -} my $req; $req = $dbh->prepare( "select categorycode, description from categories order by description"); $req->execute; my @borcatloop; while (my ($catcode, $description) =$req->fetchrow) { - my $selected = 1 if $catcode eq $borcatfilter; - my %row =(value => $catcode, - selected => $selected, - catname => $description, - ); - push @borcatloop, \%row; + 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) { - my $selected = 1 if $itemtype eq $itemtypefilter; - my %row =(value => $itemtype, - selected => $selected, + push @itemtypeloop, { + value => $itemtype, + selected => $itemtype eq $itemtypefilter ? 1 : 0, itemtypename => $description, - ); - push @itemtypeloop, \%row; + }; } my $onlymine=C4::Context->preference('IndependantBranches') && - C4::Context->userenv && - C4::Context->userenv->{flags}!=1 && + C4::Context->userenv && + C4::Context->userenv->{flags} % 2 !=1 && C4::Context->userenv->{branch}; -my $branches = GetBranches($onlymine); -my @branchloop; - -foreach my $thisbranch ( sort keys %$branches ) { - my %row = ( - value => $thisbranch, - branchname => $branches->{$thisbranch}->{'branchname'}, - selected => ($branches->{$thisbranch}->{'branchcode'} eq $branchfilter) - ); - push @branchloop, \%row; + +$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; + } } -$branchfilter=C4::Context->userenv->{'branch'} if ($onlymine && !$branchfilter); - -$template->param( branchloop => \@branchloop, - branchfilter => $branchfilter); -$template->param(borcatloop=> \@borcatloop, - itemtypeloop => \@itemtypeloop, - branchloop=> \@branchloop, - borname => $bornamefilter, - order => $order, - showall => $showall); - -my $duedate; -my $borrowernumber; -my $itemnum; -my $data1; -my $data2; -my $data3; -my $name; -my $phone; -my $email; -my $title; -my $author; - -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 - 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.= " && date_due<'".$todaysdate."' " unless ($showall); -$strsth.=" && (borrowers.firstname like '".$bornamefilter."%' or borrowers.surname like '".$bornamefilter."%' or borrowers.cardnumber like '".$bornamefilter."%')" if($bornamefilter) ; -$strsth.=" && borrowers.categorycode = '".$borcatfilter."' " if($borcatfilter) ; -$strsth.=" && biblioitems.itemtype = '".$itemtypefilter."' " if($itemtypefilter) ; -$strsth.=" && borrowers.flags = '".$borflagsfilter."' " if ($borflagsfilter ne " ") ; -$strsth.=" && borrowers.branchcode = '".$branchfilter."' " if($branchfilter) ; -if ($order eq "borrower"){ - $strsth.=" ORDER BY borrower,date_due " ; -} elsif ($order eq "title"){ - $strsth.=" ORDER BY title,date_due,borrower "; -} elsif ($order eq "barcode"){ - $strsth.=" ORDER BY items.barcode,date_due,borrower "; -}elsif ($order eq "borrower DESC"){ - $strsth.=" ORDER BY borrower desc,date_due " ; -} elsif ($order eq "title DESC"){ - $strsth.=" ORDER BY title desc,date_due,borrower "; -} elsif ($order eq "barcode DESC"){ - $strsth.=" ORDER BY items.barcode desc,date_due,borrower "; -} elsif ($order eq "date_due DESC"){ - $strsth.=" ORDER BY date_due DESC,borrower "; -} else { - $strsth.=" ORDER BY date_due,borrower "; +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($strsth); -#warn "overdue.pl : query string ".$strsth; + +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 @overduedata; -while (my $data=$sth->fetchrow_hashref) { - $duedate=$data->{'date_due'}; - $duedate = format_date($duedate); - $itemnum=$data->{'itemnumber'}; - - $name=$data->{'borrower'}; - $phone=$data->{'phone'}; - $email=$data->{'email'}; - - $title=$data->{'title'}; - $author=$data->{'author'}; - push (@overduedata, { - duedate => $duedate, - borrowernumber => $data->{borrowernumber}, - barcode => $data->{barcode}, - itemnum => $itemnum, - name => $name, - phone => $phone, - email => $email, - biblionumber => $data->{'biblionumber'}, - title => $title, - author => $author, - branchcode => $data->{'branchcode'} }); +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 => format_date($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"; +}