viewvc.cgi/SQL2XLS/sql2xlsx.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/;

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

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/_/ /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" if $debug;

                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;

1;

__END__

1	dpavlin	13	#!/usr/bin/perl -T
2	dpavlin	5	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	dpavlin	14	Each file in current directory which ends in C<*.sql> will
12	dpavlin	5	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	dpavlin	14	Comments in sql files (lines beginning with C<-->) will be placed
17	dpavlin	5	in first line in bold.
18
19			To specify database on which SQL query is executed
20	dpavlin	14	C<\c database> syntax is supported.
21	dpavlin	5
22			You can also run script from command line, and it will produce
23	dpavlin	14	C<sql_reports.xls> file.
24	dpavlin	5
25	dpavlin	13	If run within directory, it will use files in it to produce file.
26
27			When called as CGI, directory name can be appended to name of script
28			to produce report for any sub-directory within directory where
29			C<sql2xls.cgi> is installed.
30
31	dpavlin	12	=head1 INSTALLATION
32
33			Only required file is this script C<< sql2xls.cgi >>
34
35			If your server is configured to execute C<.cgi> files, you can
36			drop this script anywhere, but you can also add something like
37
38			ScriptAlias /xls-reports /srv/SQL2XLS/sql2xls.cgi
39
40			in Apache's virtual host configuration to get nice URLs
41
42	dpavlin	14	To configure default database, user, password and other settings create
43			C<config.pl> file in same directory in which C<sql2xls.cgi> is with something
44			like this:
45
46			$dsn = 'DBI:mysql:dbname=';
47			$database = 'database';
48			$user = 'user';
49			$passwd = 'password';
50			$path = 'sql_reports.xls';
51
52			$db_encoding = 'utf-8';
53			$xls_date_format = 'dd.mm.yyyy';
54
55			$debug = 1;
56
57			=head1 SECURITY
58
59			There is none. Use apache auth modules if you need it.
60
61	dpavlin	5	=head1 AUTHOR
62
63	dpavlin	14	Dobrica Pavlinusic, dpavlin@rot13.org, L<http://svn.rot13.org/index.cgi/SQL2XLS/>
64	dpavlin	5
65			=cut
66
67	dpavlin	1	use Spreadsheet::WriteExcel;
68			use DBI;
69			use CGI::Carp qw(fatalsToBrowser);
70	dpavlin	2	use Encode qw/decode/;
71	dpavlin	3	use Data::Dump qw/dump/;
72	dpavlin	1
73	dpavlin	10	our $dsn = 'DBI:Pg:dbname=';
74			our $database = 'template1';
75			our $user = 'dpavlin';
76			our $passwd = '';
77			our $path = 'sql_reports.xls';
78	dpavlin	2
79	dpavlin	10	our $db_encoding = 'iso-8859-2';
80			our $xls_date_format = 'dd.mm.yyyy';
81	dpavlin	3
82	dpavlin	10	our $debug = 1;
83	dpavlin	1
84	dpavlin	13	my $sql_dir = $ENV{SCRIPT_FILENAME} \|\| '.';
85	dpavlin	1	$sql_dir =~ s,/[^/]+$,,;
86
87	dpavlin	18	sub require_config {
88			my $config_path = $1 if "$sql_dir/config.pl" =~ m/^(.+)$/; # untaint
89			warn "# using $config_path\n";
90			require $config_path if -e $config_path;
91			}
92	dpavlin	13
93	dpavlin	18	require_config;
94
95	dpavlin	21	my $reports_path = $ENV{PATH_INFO} \|\| '';
96	dpavlin	13	$reports_path =~ s/\.\.//g; # some protection against path exploits
97			$reports_path \|\|= shift @ARGV; # for CLI invocation
98			$sql_dir .= "/$reports_path" if -e "$sql_dir/$reports_path";
99
100	dpavlin	18	require_config;
101
102	dpavlin	13	warn "# reading SQL queries from $sql_dir\n" if $debug;
103
104	dpavlin	1	opendir(DIR, $sql_dir) \|\| die "can't opendir $sql_dir: $!";
105			my @sql_files = sort grep { /\.sql$/i && -f "$sql_dir/$_" } readdir(DIR);
106			closedir DIR;
107
108			my $workbook;
109	dpavlin	5	if ($ENV{GATEWAY_INTERFACE} && $ENV{GATEWAY_INTERFACE} =~ m/CGI/i) {
110	dpavlin	1	# use as cgi script
111			print "Content-type: application/vnd.ms-excel\n\n";
112			$workbook = Spreadsheet::WriteExcel->new("-");
113			} else {
114			# Create a new Excel workbook
115	dpavlin	5	$workbook = Spreadsheet::WriteExcel->new( $path );
116			warn "Creating XLS file $path\n";
117	dpavlin	1	}
118
119	dpavlin	3	my $date_format = $workbook->add_format(num_format => $xls_date_format);
120
121	dpavlin	22	our $dbh;
122			sub use_database {
123			$dbh->disconnect if $dbh;
124			my $database = shift \|\| return;
125			print STDERR "## connect to $database\n" if $debug;
126			$dbh = DBI->connect($dsn . $database,$user,$passwd, { RaiseError => 1, AutoCommit => 0 }) \|\| die $DBI::errstr;
127			$dbh->do( qq{ set names '$db_encoding'; } ) if $db_encoding && $dsn =~ m{mysql};
128			}
129	dpavlin	1
130	dpavlin	22	use_database( $database );
131
132	dpavlin	2	sub _c {
133	dpavlin	16	return shift unless $db_encoding;
134	dpavlin	3	return decode( $db_encoding, shift );
135	dpavlin	2	}
136
137	dpavlin	1	foreach my $sql_file (@sql_files) {
138
139			my $sheet_name = $sql_file;
140	dpavlin	20	$sheet_name =~ s/\d+[_-]//;
141	dpavlin	1	$sheet_name =~ s/_/ /g;
142			$sheet_name =~ s/\.sql//;
143
144			# Add a worksheet
145	dpavlin	11	warn "# clipping sheet name '$sheet_name' to 31 char limit\n" if length $sheet_name > 31;
146			my $worksheet = $workbook->addworksheet( substr($sheet_name,0,31) );
147	dpavlin	1
148	dpavlin	6	print STDERR "working on $sql_file\n" if ($debug);
149	dpavlin	1
150	dpavlin	13	open(SQL,"$sql_dir/$sql_file") \|\| die "can't open sql file '$sql_dir/$sql_file': $!";
151	dpavlin	7	my $comment = '';
152	dpavlin	21	my $full_sql = "";
153	dpavlin	1	while(<SQL>) {
154			chomp;
155	dpavlin	4	if (/^\\c\s+(\S+)/) {
156	dpavlin	22	use_database( $1 );
157	dpavlin	4	} elsif (/^--(.+)/) {
158	dpavlin	1	$comment.=$1;
159			} else {
160	dpavlin	21	$full_sql.= ' ' . $_;
161	dpavlin	1	}
162			}
163			close(SQL);
164
165	dpavlin	21	$full_sql =~ s/\s\s+/ /gs;
166			$full_sql .= ';' unless $full_sql =~ m/;\s*/s;
167	dpavlin	4
168	dpavlin	21	print STDERR "sql: $full_sql\ncomment: $comment\n" if ($debug);
169	dpavlin	1
170			my $row = 0;
171
172			if ($comment) {
173
174			# Add and define a format
175			my $fmt_comment = $workbook->addformat(); # Add a format
176			$fmt_comment->set_bold();
177
178	dpavlin	8	$comment =~ s/^\s+//;
179			$comment =~ s/\s+$//;
180
181	dpavlin	2	$worksheet->write($row, 0, _c($comment), $fmt_comment);
182	dpavlin	1	$row+=2;
183			}
184
185			my $fmt_header = $workbook->addformat(); # Add a format
186			$fmt_header->set_italic();
187
188	dpavlin	21	foreach my $sql ( split(/;/, $full_sql ) ) {
189	dpavlin	1
190	dpavlin	21	warn "SQL: $sql\n" if $debug;
191	dpavlin	3
192	dpavlin	21	my $sth = $dbh->prepare($sql);
193			$sth->execute();
194
195			next unless $sth->{NAME}; # $sth->rows doesn't work for insert into with MySQL
196
197			my @types = eval {
198			map { $dbh->type_info($_) ? $dbh->type_info($_)->{TYPE_NAME} : '?' } @{ $sth->{TYPE} };
199			};
200
201			for(my $col=0; $col<=$#{ $sth->{NAME} }; $col++) {
202			$worksheet->write($row, $col, ${ $sth->{NAME} }[$col], $fmt_header);
203			}
204			$row++;
205
206			while (my @row = $sth->fetchrow_array() ) {
207			for(my $col=0; $col<=$#row; $col++) {
208			my $data = $row[$col];
209			next unless defined $data;
210			if ( $types[$col] && $types[$col] =~ m/^date/i ) {
211			$data .= 'T' if $data =~ m/^\d\d\d\d-\d\d-\d\d$/;
212			$data =~ s/^(\d\d\d\d-\d\d-\d\d)\s(\d\d:\d\d:\d\d)$/$1T$2/;
213			warn "## by type datetime $data\n" if $debug;
214			$worksheet->write_date_time( $row, $col, $data, $date_format );
215			} elsif ( $data =~ s/^(\d\d\d\d-\d\d-\d\d)[\sT](\d\d:\d\d:\d\d)$/$1T$2/ ) {
216			warn "## heuristic date time: $1T$2\n" if $debug;
217			$worksheet->write_date_time( $row, $col, "$1T$2", $date_format );
218			} else {
219			$worksheet->write($row, $col, _c( $data ) );
220			}
221	dpavlin	3	}
222	dpavlin	21	$row++;
223	dpavlin	1	}
224	dpavlin	21
225			$row++; # separete queries by one row
226	dpavlin	1	}
227			}
228
229			$dbh->disconnect;
230
231			1;
232
233			__END__
234