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