View | Details | Raw Unified | Return to bug 11679
Collapse All | Expand All

(-)a/koha-tmpl/intranet-tmpl/prog/en/modules/reports/guided_reports_start.tt (+1 lines)
Lines 814-819 canned reports and writing custom SQL reports.</p> Link Here
814
<select name="format" id="format">
814
<select name="format" id="format">
815
<option value="csv">Comma separated text</option>
815
<option value="csv">Comma separated text</option>
816
<option value="tab">Tab separated text</option>
816
<option value="tab">Tab separated text</option>
817
<option value="ods">Open Document Spreadsheet</option>
817
</select>
818
</select>
818
<input type="hidden" name="sql" value="[% sql |html %]" />
819
<input type="hidden" name="sql" value="[% sql |html %]" />
819
<input type="hidden" name="phase" value="Export" />
820
<input type="hidden" name="phase" value="Export" />
(-)a/reports/guided_reports.pl (-20 / +69 lines)
Lines 17-26 Link Here
17
# with Koha; if not, write to the Free Software Foundation, Inc.,
17
# with Koha; if not, write to the Free Software Foundation, Inc.,
18
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
18
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19
19
20
20
use Modern::Perl;
21
use CGI qw/-utf8/;
21
use CGI qw/-utf8/;
22
use Text::CSV;
22
use Text::CSV::Encoded;
23
use URI::Escape;
23
use URI::Escape;
24
use File::Temp;
25
use File::Basename qw( dirname );
24
use C4::Reports::Guided;
26
use C4::Reports::Guided;
25
use C4::Auth qw/:DEFAULT get_session/;
27
use C4::Auth qw/:DEFAULT get_session/;
26
use C4::Output;
28
use C4::Output;
Lines 764-800 elsif ($phase eq 'Run this report'){ Link Here
764
}
766
}
765
767
766
elsif ($phase eq 'Export'){
768
elsif ($phase eq 'Export'){
767
    binmode STDOUT, ':encoding(UTF-8)';
768
769
769
	# export results to tab separated text or CSV
770
	# export results to tab separated text or CSV
770
	my $sql    = $input->param('sql');  # FIXME: use sql from saved report ID#, not new user-supplied SQL!
771
	my $sql    = $input->param('sql');  # FIXME: use sql from saved report ID#, not new user-supplied SQL!
771
    my $format = $input->param('format');
772
    my $format = $input->param('format');
772
	my ($sth, $q_errors) = execute_query($sql);
773
	my ($sth, $q_errors) = execute_query($sql);
773
    unless ($q_errors and @$q_errors) {
774
    unless ($q_errors and @$q_errors) {
774
        print $input->header(       -type => 'application/octet-stream',
775
        my ( $type, $content );
775
                                    -attachment=>"reportresults.$format"
776
                            );
777
        if ($format eq 'tab') {
776
        if ($format eq 'tab') {
778
            print join("\t", header_cell_values($sth)), "\n";
777
            $type = 'application/octet-stream';
778
            $content .= join("\t", header_cell_values($sth)) . "\n";
779
            while (my $row = $sth->fetchrow_arrayref()) {
779
            while (my $row = $sth->fetchrow_arrayref()) {
780
                print join("\t", @$row), "\n";
780
                $content .= join("\t", @$row) . "\n";
781
            }
781
            }
782
        } else {
782
        } else {
783
            my $csv = Text::CSV->new({binary => 1});
783
            my $delimiter = C4::Context->preference('delimiter') || ',';
784
            $csv or die "Text::CSV->new({binary => 1}) FAILED: " . Text::CSV->error_diag();
784
            if ( $format eq 'csv' ) {
785
            if ($csv->combine(header_cell_values($sth))) {
785
                $type = 'application/csv';
786
                print $csv->string(), "\n";
786
                my $csv = Text::CSV::Encoded->new({ encoding_out => 'utf8', sep_char => $delimiter});
787
            } else {
787
                $csv or die "Text::CSV::Encoded->new({binary => 1}) FAILED: " . Text::CSV::Encoded->error_diag();
788
                push @$q_errors, { combine => 'HEADER ROW: ' . $csv->error_diag() } ;
788
                if ($csv->combine(header_cell_values($sth))) {
789
            }
789
                    $content .= $csv->string(). "\n";
790
            while (my $row = $sth->fetchrow_arrayref()) {
791
                if ($csv->combine(@$row)) {
792
                    print $csv->string(), "\n"; 
793
                } else {
790
                } else {
794
                    push @$q_errors, { combine => $csv->error_diag() } ;
791
                    push @$q_errors, { combine => 'HEADER ROW: ' . $csv->error_diag() } ;
792
                }
793
                while (my $row = $sth->fetchrow_arrayref()) {
794
                    if ($csv->combine(@$row)) {
795
                        $content .= $csv->string() . "\n";
796
                    } else {
797
                        push @$q_errors, { combine => $csv->error_diag() } ;
798
                    }
795
                }
799
                }
796
            }
800
            }
801
            elsif ( $format eq 'ods' ) {
802
                $type = 'application/vnd.oasis.opendocument.spreadsheet';
803
                my $ods_fh = File::Temp->new( UNLINK => 0 );
804
                my $ods_filepath = $ods_fh->filename;
805
806
                use OpenOffice::OODoc;
807
                my $tmpdir = dirname $ods_filepath;
808
                odfWorkingDirectory( $tmpdir );
809
                my $container = odfContainer( $ods_filepath, create => 'spreadsheet' );
810
                my $doc = odfDocument (
811
                    container => $container,
812
                    part      => 'content'
813
                );
814
                my $table = $doc->getTable(0);
815
                my @headers = header_cell_values( $sth );
816
                my $rows = $sth->fetchall_arrayref();
817
                my ( $nb_rows, $nb_cols ) = ( scalar(@$rows), scalar(@{$rows->[0]}) );
818
                $doc->expandTable( $table, $nb_rows, $nb_cols );
819
820
                my $row = $doc->getRow( $table, 0 );
821
                my $j = 0;
822
                for my $header ( @headers ) {
823
                    $doc->cellValue( $row, $j, $header );
824
                    $j++;
825
                }
826
                for ( my $i = 1; $i < $nb_rows +1 ; $i++ ) {
827
                    $row = $doc->getRow( $table, $i );
828
                    for ( my $j = 0 ; $j < $nb_cols ; $j++ ) {
829
                        # FIXME Bug 11944
830
                        my $value = Encode::encode( 'UTF8', $rows->[$i - 1][$j] );
831
                        $doc->cellValue( $row, $j, $value );
832
                    }
833
                }
834
                $doc->save();
835
                binmode(STDOUT);
836
                open $ods_fh, '<', $ods_filepath;
837
                $content .= $_ while <$ods_fh>;
838
                unlink $ods_filepath;
839
            }
797
        }
840
        }
841
        print $input->header(
842
            -type => $type,
843
            -attachment=>"reportresults.$format"
844
        );
845
        print $content;
846
798
        foreach my $err (@$q_errors, @errors) {
847
        foreach my $err (@$q_errors, @errors) {
799
            print "# ERROR: " . (map {$_ . ": " . $err->{$_}} keys %$err) . "\n";
848
            print "# ERROR: " . (map {$_ . ": " . $err->{$_}} keys %$err) . "\n";
800
        }   # here we print all the non-fatal errors at the end.  Not super smooth, but better than nothing.
849
        }   # here we print all the non-fatal errors at the end.  Not super smooth, but better than nothing.
Lines 852-857 sub header_cell_values { Link Here
852
    my $sth = shift or return ();
901
    my $sth = shift or return ();
853
    my @cols;
902
    my @cols;
854
    foreach my $c (@{$sth->{NAME}}) {
903
    foreach my $c (@{$sth->{NAME}}) {
904
        # TODO in Bug 11944
855
        #FIXME apparently DBI still needs a utf8 fix for this?
905
        #FIXME apparently DBI still needs a utf8 fix for this?
856
        utf8::decode($c);
906
        utf8::decode($c);
857
        push @cols, $c;
907
        push @cols, $c;
858
- 

Return to bug 11679