#!/usr/bin/perl # Copyright 2000-2002 Katipo Communications # # This file is part of Koha. # # Koha is free software; you can redistribute it and/or modify it # under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 3 of the License, or # (at your option) any later version. # # Koha is distributed in the hope that it will be useful, but # WITHOUT ANY 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, see . use Modern::Perl; use C4::Auth qw( get_template_and_user ); use CGI qw ( -utf8 ); use C4::Context; use C4::Output qw( output_html_with_http_headers ); use C4::Koha qw( GetAuthorisedValues ); use C4::Reports qw( GetDelimiterChoices ); use Koha::ItemTypes; =head1 NAME plugin that shows a stats on borrowers =head1 DESCRIPTION =cut my $input = CGI->new; my $do_it = $input->param('do_it'); my $fullreportname = "reports/cat_issues_top.tt"; my $limit; my $limit_input = $input->param("Limit"); my $column; my $column_input = $input->param("Criteria"); my @filters = $input->multi_param("Filter"); # Allowed values for the Criteria parameter, matching the report's own # select options in reports/cat_issues_top.tt. Criteria is used unquoted # as a SQL identifier, so it must be validated against a fixed set. my %allowed_fields = ( "branch" => 1, "categorycode" => 1, "itemtype" => 1, "Day" => 1, "Week" => 1, "Month" => 1, "Year" => 1, ); if ( $column_input && $allowed_fields{$column_input} ) { $column = $column_input; } # Limit is a numeric row count only if ( $limit_input && $limit_input =~ /^\d+$/ ) { $limit = $limit_input; } my $output = $input->param("output"); my $basename = $input->param("basename"); my ( $template, $borrowernumber, $cookie ) = get_template_and_user( { template_name => $fullreportname, query => $input, type => "intranet", flagsrequired => { reports => '*' }, } ); our $sep = C4::Context->csv_delimiter( scalar $input->param("sep") ); $template->param( do_it => $do_it, ); if ($do_it) { # Displaying results my $results = calculate( $limit, $column, \@filters ); if ( $output eq "screen" ) { # Printing results to screen $template->param( mainloop => $results, limit => $limit ); output_html_with_http_headers $input, $cookie, $template->output; exit; } else { # Printing to a csv file print $input->header( -type => 'application/vnd.sun.xml.calc', -encoding => 'utf-8', -attachment => "$basename.csv", -filename => "$basename.csv" ); my $cols = @$results[0]->{loopcol}; my $lines = @$results[0]->{looprow}; # header top-right print @$results[0]->{line} . "/" . @$results[0]->{column} . $sep; # Other header foreach my $col (@$cols) { print $col->{coltitle} . $sep; } print "Total\n"; # Table foreach my $line (@$lines) { my $x = $line->{loopcell}; print $line->{rowtitle} . $sep; foreach my $cell (@$x) { print $cell->{value} . $sep; print $cell->{count} // ''; } print "\n"; } exit; } # Displaying choices } else { my $dbh = C4::Context->dbh; my $CGIextChoice = ('CSV'); # FIXME translation my $CGIsepChoice = GetDelimiterChoices; #doctype my $itemtypes = Koha::ItemTypes->search_with_localization; #ccode my $ccodes = GetAuthorisedValues('CCODE'); my @ccodeloop; for my $thisccode (@$ccodes) { my %row = ( value => $thisccode->{authorised_value}, description => $thisccode->{lib}, ); push @ccodeloop, \%row; } @ccodeloop = sort { $a->{value} cmp $b->{value} } @ccodeloop; #shelvingloc my $shelvinglocs = GetAuthorisedValues('LOC'); my @shelvinglocloop; for my $thisloc (@$shelvinglocs) { my %row = ( value => $thisloc->{authorised_value}, description => $thisloc->{lib}, ); push @shelvinglocloop, \%row; } @shelvinglocloop = sort { $a->{value} cmp $b->{value} } @shelvinglocloop; my $patron_categories = Koha::Patron::Categories->search_with_library_limits( {}, { order_by => ['categorycode'] } ); $template->param( CGIextChoice => $CGIextChoice, CGIsepChoice => $CGIsepChoice, itemtypes => $itemtypes, ccodeloop => \@ccodeloop, shelvinglocloop => \@shelvinglocloop, patron_categories => $patron_categories, ); output_html_with_http_headers $input, $cookie, $template->output; } sub calculate { my ( $line, $column, $filters ) = @_; my @mainloop; my @loopcol; my @looprow; my %globalline; my $grantotal = 0; # extract parameters my $dbh = C4::Context->dbh; # Filters # Checking filters # my @loopfilter; for ( my $i = 0 ; $i <= 12 ; $i++ ) { my %cell; if ( @$filters[$i] ) { if ( ( $i == 1 ) and ( @$filters[ $i - 1 ] ) ) { $cell{err} = 1 if ( @$filters[$i] < @$filters[ $i - 1 ] ); } $cell{filter} .= @$filters[$i]; $cell{crit} .= "Issue From" if ( $i == 0 ); $cell{crit} .= "Issue To" if ( $i == 1 ); $cell{crit} .= "Return From" if ( $i == 2 ); $cell{crit} .= "Return To" if ( $i == 3 ); $cell{crit} .= "Branch" if ( $i == 4 ); $cell{crit} .= "Doc Type" if ( $i == 5 ); $cell{crit} .= "Call number" if ( $i == 6 ); $cell{crit} .= "Collection code" if ( $i == 7 ); $cell{crit} .= "Shelving location" if ( $i == 8 ); $cell{crit} .= "Bor Cat" if ( $i == 9 ); $cell{crit} .= "Day" if ( $i == 10 ); $cell{crit} .= "Month" if ( $i == 11 ); $cell{crit} .= "Year" if ( $i == 12 ); push @loopfilter, \%cell; } } my $colfield; my $colorder; if ($column) { $column = "old_issues." . $column if ( ( $column =~ /branchcode/ ) or ( $column =~ /issuedate/ ) ); if ( $column =~ /itemtype/ ) { $column = C4::Context->preference('item-level_itypes') ? "items.itype" : "biblioitems.itemtype"; } $column = "borrowers." . $column if $column =~ /categorycode/; my @colfilter; $colfilter[0] = @$filters[0] if ( $column =~ /issuedate/ ); $colfilter[1] = @$filters[1] if ( $column =~ /issuedate/ ); $colfilter[0] = @$filters[2] if ( $column =~ /returndate/ ); $colfilter[1] = @$filters[3] if ( $column =~ /returndate/ ); $colfilter[0] = @$filters[4] if ( $column =~ /branch/ ); $colfilter[0] = @$filters[5] if ( $column =~ /itemtype/ ); # These limits does not currently exist, maybe later? # $colfilter[0] = @$filters[6] if ($column =~ /ccode/ ) ; # $colfilter[0] = @$filters[7] if ($column =~ /location/ ) ; $colfilter[0] = @$filters[8] if ( $column =~ /category/ ); # This commented out row (sort2) was not removed when adding new filters for ccode, shelving location and call number # $colfilter[0] = @$filters[11] if ($column =~ /sort2/ ) ; $colfilter[0] = @$filters[9] if ( $column =~ /issuedate/ ); $colfilter[0] = @$filters[10] if ( $column =~ /issuedate/ ); $colfilter[0] = @$filters[11] if ( $column =~ /issuedate/ ); # loop cols. if ( $column eq "Day" ) { #Display by day $column = "old_issues.issuedate"; $colfield .= "dayname($column)"; $colorder .= "weekday($column)"; } elsif ( $column eq "Week" ) { #Display by Week $column = "old_issues.issuedate"; $colfield .= "week($column)"; $colorder .= "week($column)"; } elsif ( $column eq "Month" ) { #Display by Month $column = "old_issues.issuedate"; $colfield .= "monthname($column)"; $colorder .= "month($column)"; } elsif ( $column eq "Year" ) { #Display by Year $column = "old_issues.issuedate"; $colfield .= "Year($column)"; $colorder .= $column; } else { $colfield .= $column; $colorder .= $column; } my @bind2 = (); my $strsth2; $strsth2 .= "SELECT distinctrow $colfield FROM `old_issues` LEFT JOIN borrowers ON borrowers.borrowernumber=old_issues.borrowernumber LEFT JOIN items ON old_issues.itemnumber=items.itemnumber LEFT JOIN biblioitems ON biblioitems.biblioitemnumber=items.biblioitemnumber WHERE 1"; if ( ( $column =~ /issuedate/ ) or ( $column =~ /returndate/ ) ) { if ( $colfilter[1] and ( $colfilter[0] ) ) { $strsth2 .= " and $column between ? and ? "; push( @bind2, $colfilter[0], $colfilter[1] ); } elsif ( $colfilter[1] ) { $strsth2 .= " and $column < ? "; push( @bind2, $colfilter[1] ); } elsif ( $colfilter[0] ) { $strsth2 .= " and $column > ? "; push( @bind2, $colfilter[0] ); } } elsif ( $colfilter[0] ) { $colfilter[0] =~ s/\*/%/g; $strsth2 .= " and $column LIKE ? "; push( @bind2, $colfilter[0] ); } $strsth2 .= " group by $colfield"; $strsth2 .= " order by $colorder"; my $sth2 = $dbh->prepare($strsth2); $sth2->execute(@bind2); while ( my ($celvalue) = $sth2->fetchrow ) { my %cell; $cell{coltitle} = ( $celvalue ? $celvalue : "NULL" ); push @loopcol, \%cell; } } my $i = 0; # my @totalcol; my $highlighted = -1; #Initialization of cell values..... my @table; for ( my $i = 1 ; $i <= $line ; $i++ ) { foreach my $col (@loopcol) { $table[$i]->{ ( $col->{coltitle} ) ? $col->{coltitle} : "total" }->{'name'} = 0; } } # preparing calculation my $strcalc; # Processing average loanperiods $strcalc .= "SELECT biblio.title, COUNT(biblio.biblionumber) AS `RANK`, biblio.biblionumber AS ID"; $strcalc .= " , $colfield " if ($colfield); $strcalc .= " FROM `old_issues` LEFT JOIN items USING(itemnumber) LEFT JOIN biblio USING(biblionumber) LEFT JOIN biblioitems USING(biblionumber) LEFT JOIN borrowers USING(borrowernumber) WHERE 1"; my @bind3 = (); @$filters[0] =~ s/\*/%/g if ( @$filters[0] ); if ( @$filters[0] ) { $strcalc .= " AND old_issues.issuedate > ?"; push( @bind3, @$filters[0] ); } @$filters[1] =~ s/\*/%/g if ( @$filters[1] ); if ( @$filters[1] ) { $strcalc .= " AND old_issues.issuedate < ?"; push( @bind3, @$filters[1] ); } @$filters[2] =~ s/\*/%/g if ( @$filters[2] ); if ( @$filters[2] ) { $strcalc .= " AND old_issues.returndate > ?"; push( @bind3, @$filters[2] ); } @$filters[3] =~ s/\*/%/g if ( @$filters[3] ); if ( @$filters[3] ) { $strcalc .= " AND old_issues.returndate < ?"; push( @bind3, @$filters[3] ); } @$filters[4] =~ s/\*/%/g if ( @$filters[4] ); if ( @$filters[4] ) { $strcalc .= " AND old_issues.branchcode like ?"; push( @bind3, @$filters[4] ); } @$filters[5] =~ s/\*/%/g if ( @$filters[5] ); if ( @$filters[5] ) { if ( C4::Context->preference('item-level_itypes') ) { $strcalc .= " AND items.itype like ?"; } else { $strcalc .= " AND biblioitems.itemtype like ?"; } push( @bind3, @$filters[5] ); } @$filters[6] =~ s/\*/%/g if ( @$filters[6] ); if ( @$filters[6] ) { $strcalc .= " AND itemcallnumber like ?"; push( @bind3, @$filters[6] ); } @$filters[7] =~ s/\*/%/g if ( @$filters[7] ); if ( @$filters[7] ) { $strcalc .= " AND ccode like ?"; push( @bind3, @$filters[7] ); } @$filters[8] =~ s/\*/%/g if ( @$filters[8] ); if ( @$filters[8] ) { $strcalc .= " AND location like ?"; push( @bind3, @$filters[8] ); } @$filters[9] =~ s/\*/%/g if ( @$filters[9] ); if ( @$filters[9] ) { $strcalc .= " AND borrowers.categorycode like ?"; push( @bind3, @$filters[9] ); } @$filters[10] =~ s/\*/%/g if ( @$filters[10] ); if ( @$filters[10] ) { $strcalc .= " AND dayname(old_issues.issuedate) like ?"; push( @bind3, @$filters[10] ); } @$filters[11] =~ s/\*/%/g if ( @$filters[11] ); if ( @$filters[11] ) { $strcalc .= " AND monthname(old_issues.issuedate) like ?"; push( @bind3, @$filters[11] ); } @$filters[12] =~ s/\*/%/g if ( @$filters[12] ); if ( @$filters[12] ) { $strcalc .= " AND year(old_issues.issuedate) like ?"; push( @bind3, @$filters[12] ); } $strcalc .= " group by biblio.biblionumber, biblio.title"; $strcalc .= ", $colfield" if ($column); $strcalc .= " order by `RANK` DESC"; $strcalc .= ", $colfield " if ($colfield); my $dbcalc = $dbh->prepare($strcalc); $dbcalc->execute(@bind3); my %indice; while ( my @data = $dbcalc->fetchrow ) { my ( $row, $rank, $id, $col ) = @data; $col = "zzEMPTY" if ( !defined($col) ); $indice{$col} = 1 if ( not( $indice{$col} ) ); $table[ $indice{$col} ]->{$col}->{'name'} = $row; $table[ $indice{$col} ]->{$col}->{'count'} = $rank; $table[ $indice{$col} ]->{$col}->{'link'} = $id; $indice{$col}++; } push @loopcol, { coltitle => "Global" } if not($column); for ( $i = 1 ; $i <= $line ; $i++ ) { my @loopcell; #@loopcol ensures the order for columns is common with column titles # and the number matches the number of columns my $colcount = 0; foreach my $col (@loopcol) { my $value; my $count = 0; my $link; if (@loopcol) { $value = $table[$i]->{ ( ( $col->{coltitle} eq "NULL" ) or ( $col->{coltitle} eq "Global" ) ) ? "zzEMPTY" : $col->{coltitle} }->{'name'}; $count = $table[$i]->{ ( ( $col->{coltitle} eq "NULL" ) or ( $col->{coltitle} eq "Global" ) ) ? "zzEMPTY" : $col->{coltitle} }->{'count'}; $link = $table[$i]->{ ( ( $col->{coltitle} eq "NULL" ) or ( $col->{coltitle} eq "Global" ) ) ? "zzEMPTY" : $col->{coltitle} }->{'link'}; } else { $value = $table[$i]->{"zzEMPTY"}->{'name'}; $count = $table[$i]->{"zzEMPTY"}->{'count'}; $link = $table[$i]->{"zzEMPTY"}->{'link'}; } push @loopcell, { value => $value, count => $count, reference => $link }; } #my $total = $table[$i]->{totalrow}/$colcount if ($colcount>0); push @looprow, { 'rowtitle' => $i, 'loopcell' => \@loopcell, 'highlighted' => ( $highlighted > 0 ), }; $highlighted = -$highlighted; } # # the header of the table $globalline{loopfilter} = \@loopfilter; # the core of the table $globalline{looprow} = \@looprow; $globalline{loopcol} = \@loopcol; # # the foot (totals by borrower type) $globalline{total} = $grantotal; $globalline{line} = $line; $globalline{column} = $column; push @mainloop, \%globalline; return \@mainloop; } 1;