|
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 |
- |
|
|