/[SQL2XLS]/sql2xlsx.cgi
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Contents of /sql2xlsx.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 27 - (show annotations)
Tue Dec 28 13:56:16 2010 UTC (13 years, 3 months ago) by dpavlin
File size: 6361 byte(s)
initial port to Excel::Writer::XLSX

Which doesn't seem to work as-is yet!

1 #!/usr/bin/perl -T
2 use warnings;
3 use strict;
4
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 C<-->) 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 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 =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 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 =head1 AUTHOR
62
63 Dobrica Pavlinusic, dpavlin@rot13.org, L<http://svn.rot13.org/index.cgi/SQL2XLS/>
64
65 =cut
66
67 use Excel::Writer::XLSX;
68 use DBI;
69 use CGI::Carp qw(fatalsToBrowser);
70 use Encode qw/decode/;
71 use Data::Dump qw/dump/;
72
73 our $dsn = 'DBI:Pg:dbname=';
74 our $database = 'template1';
75 our $user = 'dpavlin';
76 our $passwd = '';
77 our $path = 'sql_reports.xlsx';
78
79 our $db_encoding = 'iso-8859-2';
80 our $xls_date_format = 'dd.mm.yyyy';
81
82 our $debug = $ENV{DEBUG} || 0;
83
84 my $sql_dir = $ENV{SCRIPT_FILENAME} || '.';
85 $sql_dir =~ s,/[^/]+$,,;
86
87 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
93 require_config;
94
95 my $reports_path = $ENV{PATH_INFO} || '';
96 $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 require_config;
101
102 warn "SQL queries from $sql_dir\n";
103
104 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 if ($ENV{GATEWAY_INTERFACE} && $ENV{GATEWAY_INTERFACE} =~ m/CGI/i) {
110 # use as cgi script
111 print "Content-type: application/vnd.ms-excel\n\n";
112 $workbook = Excel::Writer::XLSX->new("-");
113 } else {
114 # Create a new Excel workbook
115 $path =~ s{\.xls$}{\.xlsx};
116 $workbook = Excel::Writer::XLSX->new( $path );
117 warn "Creating XLS file $path\n";
118 }
119
120 my $date_format = $workbook->add_format(num_format => $xls_date_format);
121
122 our $dbh;
123 sub use_database {
124 $dbh->disconnect if $dbh;
125 my $database = shift || return;
126 print STDERR "## connect to $database\n" if $debug;
127 $dbh = DBI->connect($dsn . $database,$user,$passwd, { RaiseError => 1, AutoCommit => 0 }) || die $DBI::errstr;
128 if ( $db_encoding ) {
129 if ( $dsn =~ m{Pg} ) {
130 $dbh->do( qq{ set client_encoding = '$db_encoding'; } );
131 } elsif ( $dsn =~ m{mysql} ) {
132 $dbh->do( qq{ set names '$db_encoding'; } );
133 } else {
134 warn "Don't know how to set encoding to $db_encoding for $dsn";
135 }
136 }
137 }
138
139 use_database( $database );
140
141 sub _c {
142 return shift unless $db_encoding;
143 return decode( $db_encoding, shift );
144 }
145
146 foreach my $sql_file (@sql_files) {
147
148 my $sheet_name = $sql_file;
149 $sheet_name =~ s/\d+[_-]//;
150 $sheet_name =~ s/_/ /g;
151 $sheet_name =~ s/\.sql//;
152
153 # Add a worksheet
154 warn "# clipping sheet name '$sheet_name' to 31 char limit\n" if length $sheet_name > 31;
155 my $worksheet = $workbook->add_worksheet( substr($sheet_name,0,31) );
156
157 print STDERR "working on $sql_file\n" if ($debug);
158
159 open(SQL,"$sql_dir/$sql_file") || die "can't open sql file '$sql_dir/$sql_file': $!";
160 my $comment = '';
161 my $full_sql = "";
162 while(<SQL>) {
163 chomp;
164 if (/^\\c\s+(\S+)/) {
165 use_database( $1 );
166 } elsif (/^--(.+)/) {
167 $comment.=$1;
168 } else {
169 $full_sql.= ' ' . $_;
170 }
171 }
172 close(SQL);
173
174 $full_sql =~ s/\s\s+/ /gs;
175 $full_sql .= ';' unless $full_sql =~ m/;\s*/s;
176
177 print STDERR "sql: $full_sql\ncomment: $comment\n" if ($debug);
178
179 my $row = 0;
180
181 if ($comment) {
182
183 # Add and define a format
184 my $fmt_comment = $workbook->add_format(); # Add a format
185 $fmt_comment->set_bold();
186
187 $comment =~ s/^\s+//;
188 $comment =~ s/\s+$//;
189
190 $worksheet->write($row, 0, _c($comment), $fmt_comment);
191 $row+=2;
192 }
193
194 my $fmt_header = $workbook->add_format(); # Add a format
195 $fmt_header->set_italic();
196
197 foreach my $sql ( split(/;/, $full_sql ) ) {
198
199 warn "SQL: $sql\n";
200
201 my $sth = $dbh->prepare($sql);
202 $sth->execute();
203
204 next unless $sth->{NAME} && $sth->rows > 0; # $sth->rows alone doesn't work for insert into with MySQL
205
206 my @types = eval {
207 map { $dbh->type_info($_) ? $dbh->type_info($_)->{TYPE_NAME} : '?' } @{ $sth->{TYPE} };
208 };
209
210 for(my $col=0; $col<=$#{ $sth->{NAME} }; $col++) {
211 $worksheet->write($row, $col, ${ $sth->{NAME} }[$col], $fmt_header);
212 }
213 $row++;
214
215 while (my @row = $sth->fetchrow_array() ) {
216 for(my $col=0; $col<=$#row; $col++) {
217 my $data = $row[$col];
218 next unless defined $data;
219 if ( $types[$col] && $types[$col] =~ m/^date/i ) {
220 $data .= 'T' if $data =~ m/^\d\d\d\d-\d\d-\d\d$/;
221 $data =~ s/^(\d\d\d\d-\d\d-\d\d)\s(\d\d:\d\d:\d\d)$/$1T$2/;
222 warn "## by type datetime $data\n" if $debug;
223 $worksheet->write_date_time( $row, $col, $data, $date_format );
224 } elsif ( $data =~ s/^(\d\d\d\d-\d\d-\d\d)[\sT](\d\d:\d\d:\d\d)$/$1T$2/ ) {
225 warn "## heuristic date time: $1T$2\n" if $debug;
226 $worksheet->write_date_time( $row, $col, "$1T$2", $date_format );
227 } else {
228 $worksheet->write($row, $col, _c( $data ) );
229 }
230 }
231 $row++;
232 }
233
234 $row++; # separete queries by one row
235 warn "# row $row\n";
236 }
237 }
238
239 $dbh->disconnect;
240
241 1;
242
243 __END__
244

Properties

Name Value
svn:executable *
svn:mergeinfo

  ViewVC Help
Powered by ViewVC 1.1.26