viewvc.cgi/SQL2XLS/sql2xls.cgi

#!/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(<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__

1	dpavlin	5	#!/usr/bin/perl
2			use warnings;
3			use strict;
4	dpavlin	1
5	dpavlin	5	=head1 NAME
6
7			sql2xls.pl - convert sql queries on file system to Excel file
8
9			=head1 USAGE
10
11			Each file in current directory which ends in C<< *.sql >> will
12			be converted to Excel sheet. If you want to have specific order, you can
13			prefix filenames with numbers which will be striped when creating sheet
14			names.
15
16			Comments in sql files (lines beginning with --) will be placed
17			in first line in bold.
18
19			To specify database on which SQL query is executed
20			C<< \c database >> syntax is supported.
21
22			You can also run script from command line, and it will produce
23			C<< sql_reports.xls >> file.
24
25	dpavlin	12	=head1 INSTALLATION
26
27			Only required file is this script C<< sql2xls.cgi >>
28
29			If your server is configured to execute C<.cgi> files, you can
30			drop this script anywhere, but you can also add something like
31
32			ScriptAlias /xls-reports /srv/SQL2XLS/sql2xls.cgi
33
34			in Apache's virtual host configuration to get nice URLs
35
36	dpavlin	5	=head1 AUTHOR
37
38			Dobrica Pavlinusic, dpavlin@rot13.org
39
40			=cut
41
42	dpavlin	1	use Spreadsheet::WriteExcel;
43			use DBI;
44			use CGI::Carp qw(fatalsToBrowser);
45			use CGI qw(path_translated);
46	dpavlin	2	use Encode qw/decode/;
47	dpavlin	3	use Data::Dump qw/dump/;
48	dpavlin	1
49	dpavlin	5	# edit following to set defaults
50	dpavlin	10	our $dsn = 'DBI:Pg:dbname=';
51			our $database = 'template1';
52			our $user = 'dpavlin';
53			our $passwd = '';
54			our $path = 'sql_reports.xls';
55	dpavlin	2
56	dpavlin	10	our $db_encoding = 'iso-8859-2';
57			our $xls_date_format = 'dd.mm.yyyy';
58	dpavlin	3
59	dpavlin	10	our $debug = 1;
60	dpavlin	1
61			my $sql_dir = path_translated \|\| '.';
62			$sql_dir =~ s,/[^/]+$,,;
63
64			opendir(DIR, $sql_dir) \|\| die "can't opendir $sql_dir: $!";
65			my @sql_files = sort grep { /\.sql$/i && -f "$sql_dir/$_" } readdir(DIR);
66			closedir DIR;
67
68	dpavlin	10	my $config_path = "$sql_dir/config.pl";
69			warn "# using $config_path\n";
70			require $config_path if -e $config_path;
71
72	dpavlin	1	my $workbook;
73	dpavlin	5	if ($ENV{GATEWAY_INTERFACE} && $ENV{GATEWAY_INTERFACE} =~ m/CGI/i) {
74	dpavlin	1	# use as cgi script
75			print "Content-type: application/vnd.ms-excel\n\n";
76			$workbook = Spreadsheet::WriteExcel->new("-");
77			} else {
78			# Create a new Excel workbook
79	dpavlin	5	$workbook = Spreadsheet::WriteExcel->new( $path );
80			warn "Creating XLS file $path\n";
81	dpavlin	1	}
82
83	dpavlin	3	my $date_format = $workbook->add_format(num_format => $xls_date_format);
84
85	dpavlin	5	my $dbh = DBI->connect($dsn . $database,$user,$passwd, { RaiseError => 1, AutoCommit => 0 }) \|\| die $DBI::errstr;
86	dpavlin	1
87	dpavlin	2	sub _c {
88	dpavlin	3	return decode( $db_encoding, shift );
89	dpavlin	2	}
90
91	dpavlin	1	foreach my $sql_file (@sql_files) {
92
93			my $sheet_name = $sql_file;
94			$sheet_name =~ s/\d+_//;
95			$sheet_name =~ s/_/ /g;
96			$sheet_name =~ s/\.sql//;
97
98			# Add a worksheet
99	dpavlin	11	warn "# clipping sheet name '$sheet_name' to 31 char limit\n" if length $sheet_name > 31;
100			my $worksheet = $workbook->addworksheet( substr($sheet_name,0,31) );
101	dpavlin	1
102	dpavlin	6	print STDERR "working on $sql_file\n" if ($debug);
103	dpavlin	1
104			open(SQL,$sql_file) \|\| die "can't open sql file '$sql_file': $!";
105	dpavlin	7	my $comment = '';
106	dpavlin	1	my $sql = "";
107			while(<SQL>) {
108			chomp;
109	dpavlin	4	if (/^\\c\s+(\S+)/) {
110	dpavlin	6	$dbh->disconnect if $dbh;
111			print STDERR "## connect to $1\n" if $debug;
112	dpavlin	5	$dbh = DBI->connect($dsn . $1,$user,$passwd, { RaiseError => 1, AutoCommit => 0 }) \|\| die $DBI::errstr;
113	dpavlin	4	} elsif (/^--(.+)/) {
114	dpavlin	1	$comment.=$1;
115			} else {
116	dpavlin	4	$sql.= ' ' . $_;
117	dpavlin	1	}
118			}
119			close(SQL);
120
121	dpavlin	4	$sql =~ s/\s\s+/ /gs;
122
123	dpavlin	1	print STDERR "sql: $sql\ncomment: $comment\n" if ($debug);
124
125			my $row = 0;
126
127			if ($comment) {
128
129			# Add and define a format
130			my $fmt_comment = $workbook->addformat(); # Add a format
131			$fmt_comment->set_bold();
132
133	dpavlin	8	$comment =~ s/^\s+//;
134			$comment =~ s/\s+$//;
135
136	dpavlin	2	$worksheet->write($row, 0, _c($comment), $fmt_comment);
137	dpavlin	1	$row+=2;
138			}
139
140	dpavlin	5	my $sth = $dbh->prepare($sql);
141			$sth->execute();
142	dpavlin	1
143			my $fmt_header = $workbook->addformat(); # Add a format
144			$fmt_header->set_italic();
145
146			for(my $col=0; $col<=$#{ $sth->{NAME} }; $col++) {
147			$worksheet->write($row, $col, ${ $sth->{NAME} }[$col], $fmt_header);
148			}
149			$row++;
150
151	dpavlin	6	my @types = map { $dbh->type_info($_) ? $dbh->type_info($_)->{TYPE_NAME} : '?' } @{ $sth->{TYPE} };
152	dpavlin	3
153	dpavlin	1	while (my @row = $sth->fetchrow_array() ) {
154			for(my $col=0; $col<=$#row; $col++) {
155	dpavlin	3	my $data = $row[$col];
156			if ( $types[$col] =~ m/^date/i ) {
157			$data .= 'T' if $data =~ m/^\d\d\d\d-\d\d-\d\d$/;
158	dpavlin	4	$data =~ s/^(\d\d\d\d-\d\d-\d\d)\s(\d\d:\S+)$/$1T$2/;
159			warn "## $data\n";
160	dpavlin	3	$worksheet->write_date_time( $row, $col, $data, $date_format );
161			} else {
162			$worksheet->write($row, $col, _c( $data ) );
163			}
164	dpavlin	1	}
165			$row++;
166			}
167
168			}
169
170			$dbh->disconnect;
171
172			1;
173
174			__END__
175