[SQL2XLS] / sql2xls.cgi

#!/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/;

# 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 = $ENV{SCRIPT_FILENAME} || '.';
$sql_dir =~ s,/[^/]+$,,;

my $config_path = $1 if "$sql_dir/config.pl" =~ m/^(.+)$/; # untaint
warn "# using $config_path\n";
require $config_path if -e $config_path;

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

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;

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 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 $sql = "";
        while(<SQL>) {
                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__