Bug 14926: Format the date according to the dateformat syspref
[koha.git] / reports / guided_reports.pl
index 71882af..0cee490 100755 (executable)
@@ -4,22 +4,23 @@
 #
 # 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 Modern::Perl;
 use CGI qw/-utf8/;
 use Text::CSV::Encoded;
+use Encode qw( decode );
 use URI::Escape;
 use File::Temp;
 use File::Basename qw( dirname );
@@ -29,7 +30,10 @@ use C4::Output;
 use C4::Dates qw/format_date/;
 use C4::Debug;
 use C4::Branch; # XXX subfield_is_koha_internal_p
-use C4::Koha qw/IsAuthorisedValueCategory/;
+use C4::Koha qw/IsAuthorisedValueCategory GetFrameworksLoop/;
+use C4::Context;
+use C4::Log;
+use Koha::DateUtils qw/dt_from_string output_pref/;
 
 =head1 NAME
 
@@ -57,7 +61,7 @@ elsif ( $phase eq 'Use saved' ) {
 
 my ( $template, $borrowernumber, $cookie ) = get_template_and_user(
     {
-        template_name   => "reports/guided_reports_start.tmpl",
+        template_name   => "reports/guided_reports_start.tt",
         query           => $input,
         type            => "intranet",
         authnotrequired => 0,
@@ -74,7 +78,7 @@ if ( $input->param("filter_set") ) {
     $session->param('report_filter', $filter) if $session;
     $template->param( 'filter_set' => 1 );
 }
-elsif ($session) {
+elsif ($session and not $input->param('clear_filters')) {
     $filter = $session->param('report_filter');
 }
 
@@ -87,12 +91,11 @@ if ( !$phase ) {
 elsif ( $phase eq 'Build new' ) {
     # build a new report
     $template->param( 'build1' => 1 );
-    my $areas = get_report_areas();
     $template->param(
-        'areas' => [map { id => $_->[0], name => $_->[1] }, @$areas],
-        'usecache' => $usecache,
+        'areas'        => get_report_areas(),
+        'usecache'     => $usecache,
         'cache_expiry' => 300,
-        'public' => '0',
+        'public'       => '0',
     );
 } elsif ( $phase eq 'Use saved' ) {
 
@@ -107,6 +110,7 @@ elsif ( $phase eq 'Build new' ) {
         'savedreports' => get_saved_reports($filter),
         'usecache' => $usecache,
         'groups_with_subgroups'=> groups_with_subgroups($group, $subgroup),
+        filters => $filter,
     );
 }
 
@@ -192,7 +196,7 @@ elsif ( $phase eq 'Update SQL'){
         push @errors, {sqlerr => $1};
     }
     elsif ($sql !~ /^(SELECT)/i) {
-        push @errors, {queryerr => 1};
+        push @errors, {queryerr => "No SELECT"};
     }
 
     if (@errors) {
@@ -215,8 +219,6 @@ elsif ( $phase eq 'Update SQL'){
                 'group' => $group,
                 'subgroup' => $subgroup,
                 'notes' => $notes,
-                'cache_expiry' => $cache_expiry,
-                'cache_expiry_units' => $cache_expiry_units,
                 'public' => $public,
                 'problematic_authvals' => $problematic_authvals,
                 'warn_authval_problem' => 1,
@@ -231,7 +233,6 @@ elsif ( $phase eq 'Update SQL'){
                     group => $group,
                     subgroup => $subgroup,
                     notes => $notes,
-                    cache_expiry => $cache_expiry,
                     public => $public,
                 } );
             $template->param(
@@ -239,6 +240,13 @@ elsif ( $phase eq 'Update SQL'){
                 'reportname'            => $reportname,
                 'id'                    => $id,
             );
+            logaction( "REPORTS", "MODIFY", $id, "$reportname | $sql" ) if C4::Context->preference("ReportsLog");
+        }
+        if ( $usecache ) {
+            $template->param(
+                cache_expiry => $cache_expiry,
+                cache_expiry_units => $cache_expiry_units,
+            );
         }
     }
 }
@@ -312,6 +320,7 @@ elsif ( $phase eq 'Choose these columns' ) {
     my $type    = $input->param('type');
     my @columns = $input->param('columns');
     my $column  = join( ',', @columns );
+
     $template->param(
         'build4' => 1,
         'area'   => $area,
@@ -319,10 +328,15 @@ elsif ( $phase eq 'Choose these columns' ) {
         'column' => $column,
         definitions => get_from_dictionary($area),
         criteria    => get_criteria($area,$input),
-        'cache_expiry' => $input->param('cache_expiry'),
-        'cache_expiry_units' => $input->param('cache_expiry_units'),
         'public' => $input->param('public'),
     );
+    if ( $usecache ) {
+        $template->param(
+            cache_expiry => $input->param('cache_expiry'),
+            cache_expiry_units => $input->param('cache_expiry_units'),
+        );
+    }
+
 }
 
 elsif ( $phase eq 'Choose these criteria' ) {
@@ -373,10 +387,14 @@ elsif ( $phase eq 'Choose these criteria' ) {
         'column'         => $column,
         'definition'     => $definition,
         'criteriastring' => $query_criteria,
-        'cache_expiry' => $input->param('cache_expiry'),
-        'cache_expiry_units' => $input->param('cache_expiry_units'),
         'public' => $input->param('public'),
     );
+    if ( $usecache ) {
+        $template->param(
+            cache_expiry => $input->param('cache_expiry'),
+            cache_expiry_units => $input->param('cache_expiry_units'),
+        );
+    }
 
     # get columns
     my @columns = split( ',', $column );
@@ -555,13 +573,17 @@ elsif ( $phase eq 'Save Report' ) {
                 'reportname' => $name,
                 'type' => $type,
                 'notes' => $notes,
-                'cache_expiry' => $cache_expiry,
-                'cache_expiry_units' => $cache_expiry_units,
                 'public' => $public,
                 'problematic_authvals' => $problematic_authvals,
                 'warn_authval_problem' => 1,
                 'phase_save' => 1
             );
+            if ( $usecache ) {
+                $template->param(
+                    cache_expiry => $cache_expiry,
+                    cache_expiry_units => $cache_expiry_units,
+                );
+            }
         } else {
             # No params problem found or asked to save anyway
             my $id = save_report( {
@@ -576,6 +598,7 @@ elsif ( $phase eq 'Save Report' ) {
                     cache_expiry   => $cache_expiry,
                     public         => $public,
                 } );
+                logaction( "REPORTS", "ADD", $id, "$name | $sql" ) if C4::Context->preference("ReportsLog");
             $template->param(
                 'save_successful' => 1,
                 'reportname'      => $name,
@@ -645,6 +668,16 @@ elsif ($phase eq 'Run this report'){
                             $authorised_lib{$itemtype} = $description;
                         }
                     }
+                    elsif ( $authorised_value eq "biblio_framework" ) {
+                        my $frameworks = GetFrameworksLoop();
+                        my $default_source = '';
+                        push @authorised_values,$default_source;
+                        $authorised_lib{$default_source} = 'Default';
+                        foreach my $framework (@$frameworks) {
+                            push @authorised_values, $framework->{value};
+                            $authorised_lib{$framework->{value}} = $framework->{description};
+                        }
+                    }
                     elsif ( $authorised_value eq "cn_source" ) {
                         my $class_sources = GetClassSources();
                         my $default_source = C4::Context->preference("DefaultClassificationSource");
@@ -694,17 +727,12 @@ elsif ($phase eq 'Run this report'){
                     }
                     $labelid = $text;
                     $labelid =~ s/\W//g;
-                    $input =CGI::scrolling_list(      # FIXME: factor out scrolling_list
-                        -name     => "sql_params",
-                        -id       => "sql_params_".$labelid,
-                        -values   => \@authorised_values,
-#                     -default  => $value,
-                        -labels   => \%authorised_lib,
-                        -override => 1,
-                        -size     => 1,
-                        -multiple => 0,
-                        -tabindex => 1,
-                    );
+                    $input = {
+                        name    => "sql_params",
+                        id      => "sql_params_".$labelid,
+                        values  => \@authorised_values,
+                        labels  => \%authorised_lib,
+                    };
                 }
 
                 push @tmpl_parameters, {'entry' => $text, 'input' => $input, 'labelid' => $labelid };
@@ -723,9 +751,13 @@ elsif ($phase eq 'Run this report'){
             my @split = split /<<|>>/,$sql;
             my @tmpl_parameters;
             for(my $i=0;$i<$#split/2;$i++) {
-                my $quoted = C4::Context->dbh->quote($sql_params[$i]);
+                my $quoted = $sql_params[$i];
                 # if there are special regexp chars, we must \ them
                 $split[$i*2+1] =~ s/(\||\?|\.|\*|\(|\)|\%)/\\$1/g;
+                if ($split[$i*2+1] =~ /\|\s*date\s*$/) {
+                    $quoted = output_pref({ dt => dt_from_string($quoted), dateformat => 'iso', dateonly => 1 }) if $quoted;
+                }
+                $quoted = C4::Context->dbh->quote($quoted);
                 $sql =~ s/<<$split[$i*2+1]>>/$quoted/;
             }
             my ($sth, $errors) = execute_query($sql, $offset, $limit);
@@ -744,7 +776,7 @@ elsif ($phase eq 'Run this report'){
             my $totpages = int($total/$limit) + (($total % $limit) > 0 ? 1 : 0);
             my $url = "/cgi-bin/koha/reports/guided_reports.pl?reports=$report_id&amp;phase=Run%20this%20report&amp;limit=$limit";
             if (@sql_params) {
-                $url = join('&amp;sql_params=', $url, map { URI::Escape::uri_escape($_) } @sql_params);
+                $url = join('&amp;sql_params=', $url, map { URI::Escape::uri_escape_utf8($_) } @sql_params);
             }
             $template->param(
                 'results' => \@rows,
@@ -753,7 +785,7 @@ elsif ($phase eq 'Run this report'){
                 'execute' => 1,
                 'name'    => $name,
                 'notes'   => $notes,
-                'errors'  => $errors,
+                'errors'  => defined($errors) ? [ $errors ] : undef,
                 'pagination_bar'  => pagination_bar($url, $totpages, $input->param('page')),
                 'unlimited_total' => $total,
                 'sql_params'      => \@sql_params,
@@ -770,6 +802,8 @@ elsif ($phase eq 'Export'){
        # export results to tab separated text or CSV
        my $sql    = $input->param('sql');  # FIXME: use sql from saved report ID#, not new user-supplied SQL!
     my $format = $input->param('format');
+    my $reportname = $input->param('reportname');
+    my $reportfilename = $reportname ? "$reportname-reportresults.$format" : "reportresults.$format" ;
        my ($sth, $q_errors) = execute_query($sql);
     unless ($q_errors and @$q_errors) {
         my ( $type, $content );
@@ -814,8 +848,10 @@ elsif ($phase eq 'Export'){
                 my $table = $doc->getTable(0);
                 my @headers = header_cell_values( $sth );
                 my $rows = $sth->fetchall_arrayref();
-                my ( $nb_rows, $nb_cols ) = ( scalar(@$rows), scalar(@{$rows->[0]}) );
-                $doc->expandTable( $table, $nb_rows, $nb_cols );
+                my ( $nb_rows, $nb_cols ) = ( 0, 0 );
+                $nb_rows = @$rows;
+                $nb_cols = @headers;
+                $doc->expandTable( $table, $nb_rows + 1, $nb_cols );
 
                 my $row = $doc->getRow( $table, 0 );
                 my $j = 0;
@@ -823,13 +859,14 @@ elsif ($phase eq 'Export'){
                     $doc->cellValue( $row, $j, $header );
                     $j++;
                 }
-                for ( my $i = 1; $i < $nb_rows +1 ; $i++ ) {
+                my $i = 1;
+                for ( @$rows ) {
                     $row = $doc->getRow( $table, $i );
                     for ( my $j = 0 ; $j < $nb_cols ; $j++ ) {
-                        # FIXME Bug 11944
                         my $value = Encode::encode( 'UTF8', $rows->[$i - 1][$j] );
                         $doc->cellValue( $row, $j, $value );
                     }
+                    $i++;
                 }
                 $doc->save();
                 binmode(STDOUT);
@@ -840,7 +877,7 @@ elsif ($phase eq 'Export'){
         }
         print $input->header(
             -type => $type,
-            -attachment=>"reportresults.$format"
+            -attachment=> $reportfilename
         );
         print $content;
 
@@ -899,14 +936,8 @@ elsif ($phase eq 'Save Compound'){
 # pass $sth, get back an array of names for the column headers
 sub header_cell_values {
     my $sth = shift or return ();
-    my @cols;
-    foreach my $c (@{$sth->{NAME}}) {
-        # TODO in Bug 11944
-        #FIXME apparently DBI still needs a utf8 fix for this?
-        utf8::decode($c);
-        push @cols, $c;
-    }
-    return @cols;
+    return '' unless ($sth->{NAME});
+    return @{$sth->{NAME}};
 }
 
 # pass $sth, get back a TMPL_LOOP-able set of names for the column headers