/[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

Annotation of /sql2xlsx.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 27 - (hide 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 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 27 use Excel::Writer::XLSX;
68 dpavlin 1 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 dpavlin 27 our $path = 'sql_reports.xlsx';
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 27 our $debug = $ENV{DEBUG} || 0;
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 24 warn "SQL queries from $sql_dir\n";
103 dpavlin 13
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 dpavlin 27 $workbook = Excel::Writer::XLSX->new("-");
113 dpavlin 1 } else {
114     # Create a new Excel workbook
115 dpavlin 27 $path =~ s{\.xls$}{\.xlsx};
116     $workbook = Excel::Writer::XLSX->new( $path );
117 dpavlin 5 warn "Creating XLS file $path\n";
118 dpavlin 1 }
119    
120 dpavlin 3 my $date_format = $workbook->add_format(num_format => $xls_date_format);
121    
122 dpavlin 22 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 dpavlin 23 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 dpavlin 22 }
138 dpavlin 1
139 dpavlin 22 use_database( $database );
140    
141 dpavlin 2 sub _c {
142 dpavlin 16 return shift unless $db_encoding;
143 dpavlin 3 return decode( $db_encoding, shift );
144 dpavlin 2 }
145    
146 dpavlin 1 foreach my $sql_file (@sql_files) {
147    
148     my $sheet_name = $sql_file;
149 dpavlin 20 $sheet_name =~ s/\d+[_-]//;
150 dpavlin 1 $sheet_name =~ s/_/ /g;
151     $sheet_name =~ s/\.sql//;
152    
153     # Add a worksheet
154 dpavlin 11 warn "# clipping sheet name '$sheet_name' to 31 char limit\n" if length $sheet_name > 31;
155 dpavlin 27 my $worksheet = $workbook->add_worksheet( substr($sheet_name,0,31) );
156 dpavlin 1
157 dpavlin 6 print STDERR "working on $sql_file\n" if ($debug);
158 dpavlin 1
159 dpavlin 13 open(SQL,"$sql_dir/$sql_file") || die "can't open sql file '$sql_dir/$sql_file': $!";
160 dpavlin 7 my $comment = '';
161 dpavlin 21 my $full_sql = "";
162 dpavlin 1 while(<SQL>) {
163     chomp;
164 dpavlin 4 if (/^\\c\s+(\S+)/) {
165 dpavlin 22 use_database( $1 );
166 dpavlin 4 } elsif (/^--(.+)/) {
167 dpavlin 1 $comment.=$1;
168     } else {
169 dpavlin 21 $full_sql.= ' ' . $_;
170 dpavlin 1 }
171     }
172     close(SQL);
173    
174 dpavlin 21 $full_sql =~ s/\s\s+/ /gs;
175     $full_sql .= ';' unless $full_sql =~ m/;\s*/s;
176 dpavlin 4
177 dpavlin 21 print STDERR "sql: $full_sql\ncomment: $comment\n" if ($debug);
178 dpavlin 1
179     my $row = 0;
180    
181     if ($comment) {
182    
183     # Add and define a format
184 dpavlin 27 my $fmt_comment = $workbook->add_format(); # Add a format
185 dpavlin 1 $fmt_comment->set_bold();
186    
187 dpavlin 8 $comment =~ s/^\s+//;
188     $comment =~ s/\s+$//;
189    
190 dpavlin 2 $worksheet->write($row, 0, _c($comment), $fmt_comment);
191 dpavlin 1 $row+=2;
192     }
193    
194 dpavlin 27 my $fmt_header = $workbook->add_format(); # Add a format
195 dpavlin 1 $fmt_header->set_italic();
196    
197 dpavlin 21 foreach my $sql ( split(/;/, $full_sql ) ) {
198 dpavlin 1
199 dpavlin 24 warn "SQL: $sql\n";
200 dpavlin 3
201 dpavlin 21 my $sth = $dbh->prepare($sql);
202     $sth->execute();
203    
204 dpavlin 25 next unless $sth->{NAME} && $sth->rows > 0; # $sth->rows alone doesn't work for insert into with MySQL
205 dpavlin 21
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 dpavlin 3 }
231 dpavlin 21 $row++;
232 dpavlin 1 }
233 dpavlin 21
234     $row++; # separete queries by one row
235 dpavlin 27 warn "# row $row\n";
236 dpavlin 1 }
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