begin porting to Excel::Writer::XLSX
authorDobrica Pavlinusic <dpavlin@rot13.org>
Tue, 28 Dec 2010 13:35:57 +0000 (13:35 +0000)
committerDobrica Pavlinusic <dpavlin@rot13.org>
Tue, 28 Dec 2010 13:35:57 +0000 (13:35 +0000)
git-svn-id: svn://svn.rot13.org/SQL2XLS@26 2e857b76-582b-47e5-ad5c-b3ba0f0ee29b

sql2xlsx.cgi [new file with mode: 0755]

diff --git a/sql2xlsx.cgi b/sql2xlsx.cgi
new file mode 100755 (executable)
index 0000000..0de8e00
--- /dev/null
@@ -0,0 +1,242 @@
+#!/usr/bin/perl -T
+use warnings;
+use strict;
+
+=head1 NAME
+
+sql2xls.pl - convert sql queries on file system to Excel file
+
+=head1 USAGE
+
+Each file in current directory which ends in C<*.sql> will
+be converted to Excel sheet. If you want to have specific order, you can
+prefix filenames with numbers which will be striped when creating sheet
+names.
+
+Comments in sql files (lines beginning with C<-->) will be placed
+in first line in bold.
+
+To specify database on which SQL query is executed
+C<\c database> syntax is supported.
+
+You can also run script from command line, and it will produce
+C<sql_reports.xls> file.
+
+If run within directory, it will use files in it to produce file.
+
+When called as CGI, directory name can be appended to name of script
+to produce report for any sub-directory within directory where
+C<sql2xls.cgi> is installed.
+
+=head1 INSTALLATION
+
+Only required file is this script C<< sql2xls.cgi >>
+
+If your server is configured to execute C<.cgi> files, you can
+drop this script anywhere, but you can also add something like
+
+   ScriptAlias /xls-reports /srv/SQL2XLS/sql2xls.cgi
+
+in Apache's virtual host configuration to get nice URLs
+
+To configure default database, user, password and other settings create
+C<config.pl> file in same directory in which C<sql2xls.cgi> is with something
+like this:
+
+  $dsn      = 'DBI:mysql:dbname=';
+  $database = 'database';
+  $user     = 'user';
+  $passwd   = 'password';
+  $path     = 'sql_reports.xls';
+
+  $db_encoding     = 'utf-8';
+  $xls_date_format = 'dd.mm.yyyy';
+
+  $debug = 1;
+
+=head1 SECURITY
+
+There is none. Use apache auth modules if you need it.
+
+=head1 AUTHOR
+
+Dobrica Pavlinusic, dpavlin@rot13.org, L<http://svn.rot13.org/index.cgi/SQL2XLS/>
+
+=cut
+
+use Spreadsheet::WriteExcel;
+use DBI;
+use CGI::Carp qw(fatalsToBrowser);
+use Encode qw/decode/;
+use Data::Dump qw/dump/;
+
+our $dsn      = 'DBI:Pg:dbname=';
+our $database = 'template1';
+our $user     = 'dpavlin';
+our $passwd   = '';
+our $path     = 'sql_reports.xls';
+
+our $db_encoding     = 'iso-8859-2';
+our $xls_date_format = 'dd.mm.yyyy';
+
+our $debug = 1;
+
+my $sql_dir = $ENV{SCRIPT_FILENAME} || '.';
+$sql_dir =~ s,/[^/]+$,,;
+
+sub require_config {
+       my $config_path = $1 if "$sql_dir/config.pl" =~ m/^(.+)$/; # untaint
+       warn "# using $config_path\n";
+       require $config_path if -e $config_path;
+}
+
+require_config;
+
+my $reports_path = $ENV{PATH_INFO} || '';
+$reports_path =~ s/\.\.//g; # some protection against path exploits
+$reports_path ||= shift @ARGV; # for CLI invocation
+$sql_dir .= "/$reports_path" if -e "$sql_dir/$reports_path";
+
+require_config;
+
+warn "SQL queries from $sql_dir\n";
+
+opendir(DIR, $sql_dir) || die "can't opendir $sql_dir: $!";
+my @sql_files = sort grep { /\.sql$/i && -f "$sql_dir/$_" } readdir(DIR);
+closedir DIR;
+
+my $workbook;
+if ($ENV{GATEWAY_INTERFACE} && $ENV{GATEWAY_INTERFACE} =~ m/CGI/i) {
+       # use as cgi script
+       print "Content-type: application/vnd.ms-excel\n\n";
+       $workbook = Spreadsheet::WriteExcel->new("-");
+} else {
+       # Create a new Excel workbook
+       $workbook = Spreadsheet::WriteExcel->new( $path );
+       warn "Creating XLS file $path\n";
+}
+
+my $date_format = $workbook->add_format(num_format => $xls_date_format);
+
+our $dbh;
+sub use_database {
+       $dbh->disconnect if $dbh;
+       my $database = shift || return;
+       print STDERR "## connect to $database\n" if $debug;
+       $dbh = DBI->connect($dsn . $database,$user,$passwd, { RaiseError => 1, AutoCommit => 0 }) || die $DBI::errstr;
+       if ( $db_encoding ) {
+               if ( $dsn =~ m{Pg} ) {
+                       $dbh->do( qq{ set client_encoding = '$db_encoding'; } );
+               } elsif ( $dsn =~ m{mysql} ) {
+                       $dbh->do( qq{ set names '$db_encoding'; } );
+               } else {
+                       warn "Don't know how to set encoding to $db_encoding for $dsn";
+               }
+       }
+}
+
+use_database( $database );
+
+sub _c {
+       return shift unless $db_encoding;
+       return decode( $db_encoding, shift );
+}
+
+foreach my $sql_file (@sql_files) {
+
+       my $sheet_name = $sql_file;
+       $sheet_name =~ s/\d+[_-]//;
+       $sheet_name =~ s/_/ /g;
+       $sheet_name =~ s/\.sql//;
+
+       # Add a worksheet
+       warn "# clipping sheet name '$sheet_name' to 31 char limit\n" if length $sheet_name > 31;
+       my $worksheet = $workbook->addworksheet( substr($sheet_name,0,31) );
+
+       print STDERR "working on $sql_file\n" if ($debug);
+
+       open(SQL,"$sql_dir/$sql_file") || die "can't open sql file '$sql_dir/$sql_file': $!";
+       my $comment = '';
+       my $full_sql = "";
+       while(<SQL>) {
+               chomp;
+               if (/^\\c\s+(\S+)/) {
+                       use_database( $1 );
+               } elsif (/^--(.+)/) {
+                       $comment.=$1;
+               } else {
+                       $full_sql.= ' ' . $_;
+               }
+       }
+       close(SQL);
+
+       $full_sql =~ s/\s\s+/ /gs;
+       $full_sql .= ';' unless $full_sql =~ m/;\s*/s;
+
+       print STDERR "sql: $full_sql\ncomment: $comment\n" if ($debug);
+
+       my $row = 0;
+
+       if ($comment) {
+
+               #  Add and define a format
+               my $fmt_comment = $workbook->addformat();    # Add a format
+               $fmt_comment->set_bold();
+
+               $comment =~ s/^\s+//;
+               $comment =~ s/\s+$//;
+
+               $worksheet->write($row, 0, _c($comment), $fmt_comment);
+               $row+=2;
+       }
+
+       my $fmt_header = $workbook->addformat();    # Add a format
+       $fmt_header->set_italic();
+
+       foreach my $sql ( split(/;/, $full_sql ) ) {
+
+               warn "SQL: $sql\n";
+
+               my $sth = $dbh->prepare($sql);
+               $sth->execute();
+
+               next unless $sth->{NAME} && $sth->rows > 0; # $sth->rows alone doesn't work for insert into with MySQL
+
+               my @types = eval {
+                       map { $dbh->type_info($_) ? $dbh->type_info($_)->{TYPE_NAME} : '?' } @{ $sth->{TYPE} };
+               };
+
+               for(my $col=0; $col<=$#{ $sth->{NAME} }; $col++) {
+                       $worksheet->write($row, $col, ${ $sth->{NAME} }[$col], $fmt_header);
+               }
+               $row++;
+
+               while (my @row = $sth->fetchrow_array() ) {
+                       for(my $col=0; $col<=$#row; $col++) {
+                               my $data = $row[$col];
+                               next unless defined $data;
+                               if ( $types[$col] && $types[$col] =~ m/^date/i ) {
+                                       $data .= 'T' if $data =~ m/^\d\d\d\d-\d\d-\d\d$/;
+                                       $data =~ s/^(\d\d\d\d-\d\d-\d\d)\s(\d\d:\d\d:\d\d)$/$1T$2/;
+                                       warn "## by type datetime $data\n" if $debug;
+                                       $worksheet->write_date_time( $row, $col, $data, $date_format );
+                               } elsif ( $data =~ s/^(\d\d\d\d-\d\d-\d\d)[\sT](\d\d:\d\d:\d\d)$/$1T$2/ ) {
+                                       warn "## heuristic date time: $1T$2\n" if $debug;
+                                       $worksheet->write_date_time( $row, $col, "$1T$2", $date_format );
+                               } else {
+                                       $worksheet->write($row, $col, _c( $data ) );
+                               }
+                       }
+                       $row++;
+               }
+
+               $row++; # separete queries by one row
+       }
+}
+
+$dbh->disconnect;
+
+1;
+
+__END__
+