--- sql2xls.cgi 2008/11/03 18:31:58 5 +++ sql2xls.cgi 2008/11/06 10:37:17 22 @@ -1,4 +1,4 @@ -#!/usr/bin/perl +#!/usr/bin/perl -T use warnings; use strict; @@ -8,48 +8,99 @@ =head1 USAGE -Each file in current directory which ends in C<< *.sql >> will +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 --) will be placed +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. +C<\c database> syntax is supported. You can also run script from command line, and it will produce -C<< sql_reports.xls >> file. +C 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 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 file in same directory in which C 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 +Dobrica Pavlinusic, dpavlin@rot13.org, L =cut use Spreadsheet::WriteExcel; use DBI; use CGI::Carp qw(fatalsToBrowser); -use CGI qw(path_translated); use Encode qw/decode/; use Data::Dump qw/dump/; -# edit following to set defaults -my $dsn = 'DBI:Pg:dbname='; -my $database = 'template1'; -my $user = 'dpavlin'; -my $passwd = ''; -my $path = 'sql_reports.xls'; +our $dsn = 'DBI:Pg:dbname='; +our $database = 'template1'; +our $user = 'dpavlin'; +our $passwd = ''; +our $path = 'sql_reports.xls'; -my $db_encoding = 'iso-8859-2'; -my $xls_date_format = 'dd.mm.yyyy'; +our $db_encoding = 'iso-8859-2'; +our $xls_date_format = 'dd.mm.yyyy'; -my $debug = 1; +our $debug = 1; -my $sql_dir = path_translated || '.'; +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 "# reading SQL queries from $sql_dir\n" if $debug; + opendir(DIR, $sql_dir) || die "can't opendir $sql_dir: $!"; my @sql_files = sort grep { /\.sql$/i && -f "$sql_dir/$_" } readdir(DIR); closedir DIR; @@ -67,43 +118,54 @@ my $date_format = $workbook->add_format(num_format => $xls_date_format); -my $dbh = DBI->connect($dsn . $database,$user,$passwd, { RaiseError => 1, AutoCommit => 0 }) || die $DBI::errstr; +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; + $dbh->do( qq{ set names '$db_encoding'; } ) if $db_encoding && $dsn =~ m{mysql}; +} + +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/\d+[_-]//; $sheet_name =~ s/_/ /g; $sheet_name =~ s/\.sql//; # Add a worksheet - my $worksheet = $workbook->addworksheet($sheet_name); + 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); + print STDERR "working on $sql_file\n" if ($debug); - open(SQL,$sql_file) || die "can't open sql file '$sql_file': $!"; - my $comment; - my $sql = ""; + open(SQL,"$sql_dir/$sql_file") || die "can't open sql file '$sql_dir/$sql_file': $!"; + my $comment = ''; + my $full_sql = ""; while() { chomp; if (/^\\c\s+(\S+)/) { - warn "## connect to $1\n" if $debug; - $dbh = DBI->connect($dsn . $1,$user,$passwd, { RaiseError => 1, AutoCommit => 0 }) || die $DBI::errstr; + use_database( $1 ); } elsif (/^--(.+)/) { $comment.=$1; } else { - $sql.= ' ' . $_; + $full_sql.= ' ' . $_; } } close(SQL); - $sql =~ s/\s\s+/ /gs; + $full_sql =~ s/\s\s+/ /gs; + $full_sql .= ';' unless $full_sql =~ m/;\s*/s; - print STDERR "sql: $sql\ncomment: $comment\n" if ($debug); + print STDERR "sql: $full_sql\ncomment: $comment\n" if ($debug); my $row = 0; @@ -113,38 +175,55 @@ 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 $sth = $dbh->prepare($sql); - $sth->execute(); - my $fmt_header = $workbook->addformat(); # Add a format $fmt_header->set_italic(); - for(my $col=0; $col<=$#{ $sth->{NAME} }; $col++) { - $worksheet->write($row, $col, ${ $sth->{NAME} }[$col], $fmt_header); - } - $row++; + foreach my $sql ( split(/;/, $full_sql ) ) { - my @types = map { scalar $dbh->type_info($_)->{TYPE_NAME} } @{ $sth->{TYPE} }; + warn "SQL: $sql\n" if $debug; - while (my @row = $sth->fetchrow_array() ) { - for(my $col=0; $col<=$#row; $col++) { - my $data = $row[$col]; - if ( $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:\S+)$/$1T$2/; - warn "## $data\n"; - $worksheet->write_date_time( $row, $col, $data, $date_format ); - } else { - $worksheet->write($row, $col, _c( $data ) ); - } + my $sth = $dbh->prepare($sql); + $sth->execute(); + + next unless $sth->{NAME}; # $sth->rows 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;