#!/usr/bin/perl 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 --) 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. =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 =head1 AUTHOR Dobrica Pavlinusic, dpavlin@rot13.org =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 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 = path_translated || '.'; $sql_dir =~ s,/[^/]+$,,; 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 $config_path = "$sql_dir/config.pl"; warn "# using $config_path\n"; require $config_path if -e $config_path; 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); my $dbh = DBI->connect($dsn . $database,$user,$passwd, { RaiseError => 1, AutoCommit => 0 }) || die $DBI::errstr; sub _c { 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_file) || die "can't open sql file '$sql_file': $!"; my $comment = ''; my $sql = ""; while() { chomp; if (/^\\c\s+(\S+)/) { $dbh->disconnect if $dbh; print STDERR "## connect to $1\n" if $debug; $dbh = DBI->connect($dsn . $1,$user,$passwd, { RaiseError => 1, AutoCommit => 0 }) || die $DBI::errstr; } elsif (/^--(.+)/) { $comment.=$1; } else { $sql.= ' ' . $_; } } close(SQL); $sql =~ s/\s\s+/ /gs; print STDERR "sql: $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 $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++; my @types = map { $dbh->type_info($_) ? $dbh->type_info($_)->{TYPE_NAME} : '?' } @{ $sth->{TYPE} }; 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 ) ); } } $row++; } } $dbh->disconnect; 1; __END__