Bug 14926: Format the date according to the dateformat syspref
[koha.git] / reports / guided_reports.pl
index b9c49ad..0cee490 100755 (executable)
@@ -4,30 +4,36 @@
 #
 # 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;
+use Text::CSV::Encoded;
+use Encode qw( decode );
 use URI::Escape;
+use File::Temp;
+use File::Basename qw( dirname );
 use C4::Reports::Guided;
 use C4::Auth qw/:DEFAULT get_session/;
 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
 
@@ -55,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,
@@ -72,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');
 }
 
@@ -85,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' ) {
 
@@ -105,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,
     );
 }
 
@@ -190,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) {
@@ -213,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,
@@ -229,7 +233,6 @@ elsif ( $phase eq 'Update SQL'){
                     group => $group,
                     subgroup => $subgroup,
                     notes => $notes,
-                    cache_expiry => $cache_expiry,
                     public => $public,
                 } );
             $template->param(
@@ -237,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,
+            );
         }
     }
 }
@@ -310,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,
@@ -317,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' ) {
@@ -371,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 );
@@ -553,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( {
@@ -574,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,
@@ -643,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");
@@ -692,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 };
@@ -721,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);
@@ -742,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,
@@ -751,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,
@@ -764,37 +798,89 @@ elsif ($phase eq 'Run this report'){
 }
 
 elsif ($phase eq 'Export'){
-    binmode STDOUT, ':encoding(UTF-8)';
 
        # 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) {
-        print $input->header(       -type => 'application/octet-stream',
-                                    -attachment=>"reportresults.$format"
-                            );
+        my ( $type, $content );
         if ($format eq 'tab') {
-            print join("\t", header_cell_values($sth)), "\n";
+            $type = 'application/octet-stream';
+            $content .= join("\t", header_cell_values($sth)) . "\n";
             while (my $row = $sth->fetchrow_arrayref()) {
-                print join("\t", @$row), "\n";
+                $content .= join("\t", @$row) . "\n";
             }
         } else {
-            my $csv = Text::CSV->new({binary => 1});
-            $csv or die "Text::CSV->new({binary => 1}) FAILED: " . Text::CSV->error_diag();
-            if ($csv->combine(header_cell_values($sth))) {
-                print $csv->string(), "\n";
-            } else {
-                push @$q_errors, { combine => 'HEADER ROW: ' . $csv->error_diag() } ;
-            }
-            while (my $row = $sth->fetchrow_arrayref()) {
-                if ($csv->combine(@$row)) {
-                    print $csv->string(), "\n"; 
+            my $delimiter = C4::Context->preference('delimiter') || ',';
+            if ( $format eq 'csv' ) {
+                $type = 'application/csv';
+                my $csv = Text::CSV::Encoded->new({ encoding_out => 'utf8', sep_char => $delimiter});
+                $csv or die "Text::CSV::Encoded->new({binary => 1}) FAILED: " . Text::CSV::Encoded->error_diag();
+                if ($csv->combine(header_cell_values($sth))) {
+                    $content .= $csv->string(). "\n";
                 } else {
-                    push @$q_errors, { combine => $csv->error_diag() } ;
+                    push @$q_errors, { combine => 'HEADER ROW: ' . $csv->error_diag() } ;
+                }
+                while (my $row = $sth->fetchrow_arrayref()) {
+                    if ($csv->combine(@$row)) {
+                        $content .= $csv->string() . "\n";
+                    } else {
+                        push @$q_errors, { combine => $csv->error_diag() } ;
+                    }
+                }
+            }
+            elsif ( $format eq 'ods' ) {
+                $type = 'application/vnd.oasis.opendocument.spreadsheet';
+                my $ods_fh = File::Temp->new( UNLINK => 0 );
+                my $ods_filepath = $ods_fh->filename;
+
+                use OpenOffice::OODoc;
+                my $tmpdir = dirname $ods_filepath;
+                odfWorkingDirectory( $tmpdir );
+                my $container = odfContainer( $ods_filepath, create => 'spreadsheet' );
+                my $doc = odfDocument (
+                    container => $container,
+                    part      => 'content'
+                );
+                my $table = $doc->getTable(0);
+                my @headers = header_cell_values( $sth );
+                my $rows = $sth->fetchall_arrayref();
+                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;
+                for my $header ( @headers ) {
+                    $doc->cellValue( $row, $j, $header );
+                    $j++;
                 }
+                my $i = 1;
+                for ( @$rows ) {
+                    $row = $doc->getRow( $table, $i );
+                    for ( my $j = 0 ; $j < $nb_cols ; $j++ ) {
+                        my $value = Encode::encode( 'UTF8', $rows->[$i - 1][$j] );
+                        $doc->cellValue( $row, $j, $value );
+                    }
+                    $i++;
+                }
+                $doc->save();
+                binmode(STDOUT);
+                open $ods_fh, '<', $ods_filepath;
+                $content .= $_ while <$ods_fh>;
+                unlink $ods_filepath;
             }
         }
+        print $input->header(
+            -type => $type,
+            -attachment=> $reportfilename
+        );
+        print $content;
+
         foreach my $err (@$q_errors, @errors) {
             print "# ERROR: " . (map {$_ . ": " . $err->{$_}} keys %$err) . "\n";
         }   # here we print all the non-fatal errors at the end.  Not super smooth, but better than nothing.
@@ -850,13 +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}}) {
-        #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