Bug 18898 - Some permissions for Reports can be bypassed
[koha.git] / reports / issues_avg_stats.pl
index f0f1dd5..5c35de7 100755 (executable)
@@ -5,30 +5,31 @@
 #
 # 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 2 of the License, or (at your option) any later
-# version.
+# 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.
+# 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, write to the Free Software Foundation, Inc.,
-# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+# You should have received a copy of the GNU General Public License
+# along with Koha; if not, see <http://www.gnu.org/licenses>.
 
 use strict;
 #use warnings; FIXME - Bug 2505
 use C4::Auth;
-use CGI;
+use CGI qw ( -utf8 );
 use C4::Context;
-use C4::Branch; # GetBranches
 use C4::Output;
 use C4::Koha;
 use C4::Circulation;
 use C4::Reports;
-use C4::Dates qw/format_date format_date_in_iso/;
+use Koha::DateUtils;
+use Koha::ItemTypes;
+use Koha::Patron::Categories;
 use Date::Calc qw(Delta_Days);
 
 =head1 NAME
@@ -37,25 +38,30 @@ plugin that shows a stats on borrowers
 
 =head1 DESCRIPTION
 
-=over 2
-
 =cut
 
 my $input = new CGI;
 my $do_it=$input->param('do_it');
-my $fullreportname = "reports/issues_avg_stats.tmpl";
+my $fullreportname = "reports/issues_avg_stats.tt";
 my $line = $input->param("Line");
 my $column = $input->param("Column");
-my @filters = $input->param("Filter");
-$filters[0]=format_date_in_iso($filters[0]);
-$filters[1]=format_date_in_iso($filters[1]);
-$filters[2]=format_date_in_iso($filters[2]);
-$filters[3]=format_date_in_iso($filters[3]);
+my @filters = $input->multi_param("Filter");
+$filters[0] = eval { output_pref( { dt => dt_from_string( $filters[0]), dateonly => 1, dateformat => 'iso' } ); }
+    if ( $filters[0] );
+$filters[1] = eval { output_pref( { dt => dt_from_string( $filters[1]), dateonly => 1, dateformat => 'iso' } ); }
+    if ( $filters[1] );
+$filters[2] = eval { output_pref( { dt => dt_from_string( $filters[2]), dateonly => 1, dateformat => 'iso' } ); }
+    if ( $filters[2] );
+$filters[3] = eval { output_pref( { dt => dt_from_string( $filters[3]), dateonly => 1, dateformat => 'iso' } ); }
+    if ( $filters[3] );
+
+
 my $podsp = $input->param("IssueDisplay");
 my $rodsp = $input->param("ReturnDisplay");
 my $calc = $input->param("Cellvalue");
 my $output = $input->param("output");
 my $basename = $input->param("basename");
+
 #warn "calcul : ".$calc;
 my ($template, $borrowernumber, $cookie)
     = get_template_and_user({template_name => $fullreportname,
@@ -68,7 +74,6 @@ my ($template, $borrowernumber, $cookie)
 our $sep     = $input->param("sep");
 $sep = "\t" if ($sep eq 'tabulation');
 $template->param(do_it => $do_it,
-        DHTMLcalendar_dateformat => C4::Dates->DHTMLcalendar(),
     );
 if ($do_it) {
 # Displaying results
@@ -77,7 +82,7 @@ if ($do_it) {
 # Printing results to screen
         $template->param(mainloop => $results);
         output_html_with_http_headers $input, $cookie, $template->output;
-        exit(1);
+        exit;
     } else {
 # Printing to a csv file
         print $input->header(-type => 'application/vnd.sun.xml.calc',
@@ -110,115 +115,51 @@ if ($do_it) {
             print $sep.$col->{totalcol};
         }
         print $sep.@$results[0]->{total};
-        exit(1);
+        exit;
     }
 # Displaying choices
 } else {
+    my $patron_categories = Koha::Patron::Categories->search({}, {order_by => ['description']});
+
+    my $itemtypes = Koha::ItemTypes->search_with_localization;
+
     my $dbh = C4::Context->dbh;
-    my @values;
-    my %labels;
-    my %select;
-    my $req;
-    $req = $dbh->prepare("select distinctrow categorycode,description from categories order by description");
-    $req->execute;
-    my @select;
-    push @select,"";
-    $select{""}="";
-    while (my ($value, $desc) =$req->fetchrow) {
-        push @select, $value;
-        $select{$value}=$desc;
-    }
-    my $CGIBorCat=CGI::scrolling_list( -name     => 'Filter',
-                -id => 'borcat',
-                -values   => \@select,
-                -labels   => \%select,
-                -size     => 1,
-                -multiple => 0 );
-    
-    $req = $dbh->prepare( "select distinctrow itemtype,description from itemtypes order by description");
-    $req->execute;
-    undef @select;
-    undef %select;
-    push @select,"";
-    $select{""}="";
-    while (my ($value,$desc) =$req->fetchrow) {
-        push @select, $value;
-        $select{$value}=$desc;
-    }
-    my $CGIItemTypes=CGI::scrolling_list( -name     => 'Filter',
-                -id => 'itemtypes',
-                -values   => \@select,
-                -labels    => \%select,
-                -size     => 1,
-                -multiple => 0 );
-    
-    $req = $dbh->prepare("select distinctrow sort1 from borrowers where sort1 is not null order by sort1");
+    my $req = $dbh->prepare("select distinctrow sort1 from borrowers where sort1 is not null order by sort1");
     $req->execute;
-    undef @select;
-    push @select,"";
+    my @selects1;
     my $hassort1;
     while (my ($value) =$req->fetchrow) {
         $hassort1 =1 if ($value);
-        push @select, $value;
+        push @selects1, $value;
     }
-    my $branches=GetBranches();
-    my @select_branch;
-    my %select_branches;
-    push @select_branch,"";
-    $select_branches{""} = "";
-    foreach my $branch (keys %$branches) {
-        push @select_branch, $branch;
-        $select_branches{$branch} = $branches->{$branch}->{'branchname'};
-    }
-    my $CGIBranch=CGI::scrolling_list( -name     => 'Filter',
-                -id => 'branch',
-                -values   => \@select_branch,
-                -labels   => \%select_branches,
-                -size     => 1,
-                -multiple => 0 );
-    
-    my $CGISort1=CGI::scrolling_list( -name     => 'Filter',
-                -id => 'sort1',
-                -values   => \@select,
-                -size     => 1,
-                -multiple => 0 );
+    my $Sort1 = {
+        values   => \@selects1,
+    };
     
     $req = $dbh->prepare("select distinctrow sort2 from borrowers where sort2 is not null order by sort2");
     $req->execute;
-    undef @select;
-    push @select,"";
+    my @selects2;
     my $hassort2;
     my $hglghtsort2;
     while (my ($value) =$req->fetchrow) {
         $hassort2 =1 if ($value);
         $hglghtsort2= !($hassort1);
-        push @select, $value;
+        push @selects2, $value;
     }
-    my $CGISort2=CGI::scrolling_list( -name     => 'Filter',
-                -id => 'sort2',
-                -values   => \@select,
-                -size     => 1,
-                -multiple => 0 );
-    
-    my $CGIextChoice=CGI::scrolling_list(
-                -name     => 'MIME',
-                -id       => 'MIME',
-                -values   => ['CSV'], # FIXME translation
-                -size     => 1,
-                -multiple => 0 );
+    my $Sort2 = {
+        values   => \@selects2,
+    };
     
     my $CGIsepChoice=GetDelimiterChoices;
     
     $template->param(
-                    CGIBorCat => $CGIBorCat,
-                    CGIItemType => $CGIItemTypes,
-                    CGIBranch => $CGIBranch,
-                    hassort1=> $hassort1,
-                    hassort2=> $hassort2,
-                    HlghtSort2 => $hglghtsort2,
-                    CGISort1 => $CGISort1,
-                    CGISort2 => $CGISort2,
-                    CGIextChoice => $CGIextChoice,
+                    patron_categories => $patron_categories,
+                    itemtypes    => $itemtypes,
+                    hassort1     => $hassort1,
+                    hassort2     => $hassort2,
+                    HlghtSort2   => $hglghtsort2,
+                    Sort1        => $Sort1,
+                    Sort2        => $Sort2,
                     CGIsepChoice => $CGIsepChoice
                     );
 output_html_with_http_headers $input, $cookie, $template->output;
@@ -236,6 +177,7 @@ sub calculate {
     my @looprow;
     my %globalline;
     my $grantotal =0;
+    my $itype = C4::Context->preference('item-level_itypes') ? "items.itype" : "biblioitems.itemtype";
 # extract parameters
     my $dbh = C4::Context->dbh;
 
@@ -253,7 +195,8 @@ sub calculate {
             if ($i>=4) {
                 $cell{filter} .= @$filters[$i];
             } else {
-                $cell{filter} .= format_date(@$filters[$i]);
+                $cell{filter} .= eval { output_pref( { dt => dt_from_string( @$filters[$i] ), dateonly => 1 }); }
+                   if ( @$filters[$i] );
             }
             $cell{crit} .="Issue From" if ($i==0);
             $cell{crit} .="Issue To" if ($i==1);
@@ -282,8 +225,7 @@ sub calculate {
 #      warn "filtres ".@filters[2];
 #      warn "filtres ".@filters[3];
     $line = "old_issues.".$line if ($line=~/branchcode/) or ($line=~/timestamp/);
-    $line = "biblioitems.".$line if $line=~/itemtype/;
-    
+    if ( $line=~/itemtype/ ) { $line = $itype; }
     $linefilter[0] = @$filters[0] if ($line =~ /timestamp/ )  ;
     $linefilter[1] = @$filters[1] if ($line =~ /timestamp/ )  ;
     $linefilter[2] = @$filters[2] if ($line =~ /timestamp/ )  ;
@@ -293,15 +235,13 @@ sub calculate {
     $linefilter[2] = @$filters[6] if ($line =~ /returndate/ )  ;
     $linefilter[3] = @$filters[7] if ($line =~ /returndate/ )  ;
     $linefilter[0] = @$filters[8] if ($line =~ /category/ )  ;
-    $linefilter[0] = @$filters[9] if ($line =~ /itemtype/ )  ;
+    $linefilter[0] = @$filters[9] if ($line eq $itype);
     $linefilter[0] = @$filters[10] if ($line =~ /branch/ )  ;
-#      $linefilter[0] = @$filters[11] if ($line =~ /sort2/ ) ;
     $linefilter[0] = @$filters[11] if ($line =~ /sort1/ ) ;
     $linefilter[0] = @$filters[12] if ($line =~ /sort2/ ) ;
-#warn "filtre lignes".$linefilter[0]." ".$linefilter[1];
-# 
+
     $column = "old_issues.".$column if (($column=~/branchcode/) or ($column=~/timestamp/));
-    $column = "biblioitems.".$column if $column=~/itemtype/;
+    if ( $column=~/itemtype/ ) { $column = $itype; }
     my @colfilter ;
     $colfilter[0] = @$filters[0] if ($column =~ /timestamp/ )  ;
     $colfilter[1] = @$filters[1] if ($column =~ /timestamp/ )  ;
@@ -312,12 +252,10 @@ sub calculate {
     $colfilter[2] = @$filters[6] if ($column =~ /returndate/ )  ;
     $colfilter[3] = @$filters[7] if ($column =~ /returndate/ )  ;
     $colfilter[0] = @$filters[8] if ($column =~ /category/ )  ;
-    $colfilter[0] = @$filters[9] if ($column =~ /itemtype/ )  ;
+    $colfilter[0] = @$filters[9] if ($column eq $itype);
     $colfilter[0] = @$filters[10] if ($column =~ /branch/ )  ;
-#      $colfilter[0] = @$filters[11] if ($column =~ /sort2/ ) ;
     $colfilter[0] = @$filters[11] if ($column =~ /sort1/ ) ;
     $colfilter[0] = @$filters[12] if ($column =~ /sort2/ ) ;
-#warn "filtre col ".$colfilter[0]." ".$colfilter[1];
                                             
 # 1st, loop rows.                             
     my $linefield;
@@ -348,10 +286,6 @@ sub calculate {
                 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) 
-                LEFT JOIN issuingrules ON 
-                    (issuingrules.branchcode=old_issues.branchcode
-                    AND  issuingrules.itemtype=biblioitems.itemtype 
-                    AND  issuingrules.categorycode=borrowers.categorycode) 
                 WHERE 1";
     
     if (($line=~/timestamp/) or ($line=~/returndate/)){
@@ -378,7 +312,6 @@ sub calculate {
     my $sth = $dbh->prepare( $strsth );
     $sth->execute;
 
-    
     while ( my ($celvalue) = $sth->fetchrow) {
         my %cell;
         if ($celvalue) {
@@ -412,17 +345,13 @@ sub calculate {
         $colfield .= $column;
         $colorder .= $column;
     }  
-    
+
     my $strsth2;
     $strsth2 .= "SELECT distinctrow $colfield 
                   FROM `old_issues`
                   LEFT JOIN borrowers ON borrowers.borrowernumber=old_issues.borrowernumber
                   LEFT JOIN items  ON items.itemnumber=old_issues.itemnumber  
                   LEFT JOIN biblioitems ON (biblioitems.biblioitemnumber=items.biblioitemnumber) 
-                  LEFT JOIN issuingrules ON 
-                    (issuingrules.branchcode=old_issues.branchcode 
-                    AND  issuingrules.itemtype=biblioitems.itemtype 
-                    AND  issuingrules.categorycode=borrowers.categorycode) 
                   WHERE 1";
     
     if (($column=~/timestamp/) or ($column=~/returndate/)){
@@ -447,14 +376,8 @@ sub calculate {
     $strsth2 .=" ORDER BY $colorder";
     
     my $sth2 = $dbh->prepare( $strsth2 );
-    if (( @colfilter ) and ($colfilter[1])){
-        $sth2->execute("'".$colfilter[0]."'","'".$colfilter[1]."'");
-    } elsif ($colfilter[0]) {
-        $sth2->execute($colfilter[0]);
-    } else {
-        $sth2->execute;
-    }
-    
+
+    $sth2->execute;
 
     while (my ($celvalue) = $sth2->fetchrow) {
         my %cell;
@@ -489,7 +412,7 @@ sub calculate {
     
 # Processing average loanperiods
     $strcalc .= "SELECT $linefield, $colfield, ";
-    $strcalc .= " issuedate, returndate, old_issues.timestamp, COUNT(*), date_due, old_issues.renewals, issuelength FROM `old_issues`,borrowers,biblioitems LEFT JOIN items ON (biblioitems.biblioitemnumber=items.biblioitemnumber) LEFT JOIN issuingrules ON (issuingrules.branchcode=branchcode AND  issuingrules.itemtype=biblioitems.itemtype AND  issuingrules.categorycode=categorycode) WHERE old_issues.itemnumber=items.itemnumber AND old_issues.borrowernumber=borrowers.borrowernumber";
+    $strcalc .= " issuedate, returndate, COUNT(*) FROM `old_issues`,borrowers,biblioitems LEFT JOIN items ON (biblioitems.biblioitemnumber=items.biblioitemnumber) WHERE old_issues.itemnumber=items.itemnumber AND old_issues.borrowernumber=borrowers.borrowernumber";
 
     @$filters[0]=~ s/\*/%/g if (@$filters[0]);
     $strcalc .= " AND old_issues.timestamp > '" . @$filters[0] ."'" if ( @$filters[0] );
@@ -502,7 +425,7 @@ sub calculate {
     @$filters[8]=~ s/\*/%/g if (@$filters[8]);
     $strcalc .= " AND borrowers.categorycode like '" . @$filters[8] ."'" if ( @$filters[8] );
     @$filters[9]=~ s/\*/%/g if (@$filters[9]);
-    $strcalc .= " AND biblioitems.itemtype like '" . @$filters[9] ."'" if ( @$filters[9] );
+    $strcalc .= " AND $itype like '" . @$filters[9] ."'" if ( @$filters[9] );
     @$filters[10]=~ s/\*/%/g if (@$filters[10]);
     $strcalc .= " AND old_issues.branchcode like '" . @$filters[10] ."'" if ( @$filters[10] );
     @$filters[11]=~ s/\*/%/g if (@$filters[11]);
@@ -526,7 +449,7 @@ sub calculate {
     my $err;
     my $emptycol;
     my $weightrow;
-    
+
     while (my  @data = $dbcalc->fetchrow) {
         my ($row, $col, $issuedate, $returndate, $weight)=@data;
 #              warn "filling table $row / $col / $issuedate / $returndate /$weight";
@@ -554,8 +477,23 @@ sub calculate {
     # and the number matches the number of columns
         my $colcount=0;
         foreach my $col ( @loopcol ) {
-            my $value =$table{$row}->{(($col->{coltitle} eq "NULL")or ($col->{coltitle} eq ""))?"zzEMPTY":$col->{coltitle}} / $wgttable{$row}->{(($col->{coltitle} eq "NULL")or ($col->{coltitle} eq ""))?"zzEMPTY":$col->{coltitle}} if ($table{$row}->{(($col->{coltitle} eq "NULL")or ($col->{coltitle} eq ""))?"zzEMPTY":$col->{coltitle}});
-
+            my $value;
+            if ($table{$row}->{
+                    (        ( $col->{coltitle} eq 'NULL' )
+                          or ( $col->{coltitle} eq q{} )
+                      ) ? 'zzEMPTY' : $col->{coltitle}
+                }
+              ) {
+                $value = $table{$row}->{
+                    (        ( $col->{coltitle} eq 'NULL' )
+                          or ( $col->{coltitle} eq q{} )
+                      ) ? 'zzEMPTY' : $col->{coltitle}
+                  } / $wgttable{$row}->{
+                    (        ( $col->{coltitle} eq 'NULL' )
+                          or ( $col->{coltitle} eq q{} )
+                      ) ? 'zzEMPTY' : $col->{coltitle}
+                  };
+            }
             $table{$row}->{(($col->{coltitle} eq "NULL")or ($col->{coltitle} eq ""))?"zzEMPTY":$col->{coltitle}} = $value;
             $table{$row}->{totalrow}+=$value;
             #warn "row : $row col:$col  $cnttable{$row}->{(($col->{coltitle} eq \"NULL\")or ($col->{coltitle} eq \"\"))?\"zzEMPTY\":$col->{coltitle}}";
@@ -563,12 +501,16 @@ sub calculate {
             push @loopcell, {value => ($value)?sprintf("%.2f",$value):0  } ;
         }
         #warn "row : $row colcount:$colcount";
-        my $total = $table{$row}->{totalrow}/$colcount if ($colcount>0);
-        push @looprow,{ 'rowtitle' => ($row eq "zzEMPTY")?"NULL":$row,
-                        'loopcell' => \@loopcell,
-                        'hilighted' => ($hilighted >0),
-                        'totalrow' => ($total)?sprintf("%.2f",$total):0
-                    };
+        my $total;
+        if ( $colcount > 0 ) {
+            $total = $table{$row}->{totalrow} / $colcount;
+        }
+        push @looprow,
+          { 'rowtitle' => ( $row eq "zzEMPTY" ) ? "NULL" : $row,
+            'loopcell' => \@loopcell,
+            'hilighted' => ( $hilighted > 0 ),
+            'totalrow'  => ($total) ? sprintf( "%.2f", $total ) : 0
+          };
         $hilighted = -$hilighted;
     }
 #      
@@ -600,6 +542,7 @@ sub calculate {
     $globalline{column} = $column;
     push @mainloop,\%globalline;
     return \@mainloop;
+
 }
 
 1;