/[SQL2XLS]/sql2xls.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 /sql2xls.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 23 - (hide annotations)
Thu Nov 6 10:49:02 2008 UTC (15 years, 4 months ago) by dpavlin
File size: 6308 byte(s)
support $db_encoding for Pg and mysql DBI drivers
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 dpavlin 23 if ( $db_encoding ) {
128     if ( $dsn =~ m{Pg} ) {
129     $dbh->do( qq{ set client_encoding = '$db_encoding'; } );
130     } elsif ( $dsn =~ m{mysql} ) {
131     $dbh->do( qq{ set names '$db_encoding'; } );
132     } else {
133     warn "Don't know how to set encoding to $db_encoding for $dsn";
134     }
135     }
136 dpavlin 22 }
137 dpavlin 1
138 dpavlin 22 use_database( $database );
139    
140 dpavlin 2 sub _c {
141 dpavlin 16 return shift unless $db_encoding;
142 dpavlin 3 return decode( $db_encoding, shift );
143 dpavlin 2 }
144    
145 dpavlin 1 foreach my $sql_file (@sql_files) {
146    
147     my $sheet_name = $sql_file;
148 dpavlin 20 $sheet_name =~ s/\d+[_-]//;
149 dpavlin 1 $sheet_name =~ s/_/ /g;
150     $sheet_name =~ s/\.sql//;
151    
152     # Add a worksheet
153 dpavlin 11 warn "# clipping sheet name '$sheet_name' to 31 char limit\n" if length $sheet_name > 31;
154     my $worksheet = $workbook->addworksheet( substr($sheet_name,0,31) );
155 dpavlin 1
156 dpavlin 6 print STDERR "working on $sql_file\n" if ($debug);
157 dpavlin 1
158 dpavlin 13 open(SQL,"$sql_dir/$sql_file") || die "can't open sql file '$sql_dir/$sql_file': $!";
159 dpavlin 7 my $comment = '';
160 dpavlin 21 my $full_sql = "";
161 dpavlin 1 while(<SQL>) {
162     chomp;
163 dpavlin 4 if (/^\\c\s+(\S+)/) {
164 dpavlin 22 use_database( $1 );
165 dpavlin 4 } elsif (/^--(.+)/) {
166 dpavlin 1 $comment.=$1;
167     } else {
168 dpavlin 21 $full_sql.= ' ' . $_;
169 dpavlin 1 }
170     }
171     close(SQL);
172    
173 dpavlin 21 $full_sql =~ s/\s\s+/ /gs;
174     $full_sql .= ';' unless $full_sql =~ m/;\s*/s;
175 dpavlin 4
176 dpavlin 21 print STDERR "sql: $full_sql\ncomment: $comment\n" if ($debug);
177 dpavlin 1
178     my $row = 0;
179    
180     if ($comment) {
181    
182     # Add and define a format
183     my $fmt_comment = $workbook->addformat(); # Add a format
184     $fmt_comment->set_bold();
185    
186 dpavlin 8 $comment =~ s/^\s+//;
187     $comment =~ s/\s+$//;
188    
189 dpavlin 2 $worksheet->write($row, 0, _c($comment), $fmt_comment);
190 dpavlin 1 $row+=2;
191     }
192    
193     my $fmt_header = $workbook->addformat(); # Add a format
194     $fmt_header->set_italic();
195    
196 dpavlin 21 foreach my $sql ( split(/;/, $full_sql ) ) {
197 dpavlin 1
198 dpavlin 21 warn "SQL: $sql\n" if $debug;
199 dpavlin 3
200 dpavlin 21 my $sth = $dbh->prepare($sql);
201     $sth->execute();
202    
203     next unless $sth->{NAME}; # $sth->rows doesn't work for insert into with MySQL
204    
205     my @types = eval {
206     map { $dbh->type_info($_) ? $dbh->type_info($_)->{TYPE_NAME} : '?' } @{ $sth->{TYPE} };
207     };
208    
209     for(my $col=0; $col<=$#{ $sth->{NAME} }; $col++) {
210     $worksheet->write($row, $col, ${ $sth->{NAME} }[$col], $fmt_header);
211     }
212     $row++;
213    
214     while (my @row = $sth->fetchrow_array() ) {
215     for(my $col=0; $col<=$#row; $col++) {
216     my $data = $row[$col];
217     next unless defined $data;
218     if ( $types[$col] && $types[$col] =~ m/^date/i ) {
219     $data .= 'T' if $data =~ m/^\d\d\d\d-\d\d-\d\d$/;
220     $data =~ s/^(\d\d\d\d-\d\d-\d\d)\s(\d\d:\d\d:\d\d)$/$1T$2/;
221     warn "## by type datetime $data\n" if $debug;
222     $worksheet->write_date_time( $row, $col, $data, $date_format );
223     } elsif ( $data =~ s/^(\d\d\d\d-\d\d-\d\d)[\sT](\d\d:\d\d:\d\d)$/$1T$2/ ) {
224     warn "## heuristic date time: $1T$2\n" if $debug;
225     $worksheet->write_date_time( $row, $col, "$1T$2", $date_format );
226     } else {
227     $worksheet->write($row, $col, _c( $data ) );
228     }
229 dpavlin 3 }
230 dpavlin 21 $row++;
231 dpavlin 1 }
232 dpavlin 21
233     $row++; # separete queries by one row
234 dpavlin 1 }
235     }
236    
237     $dbh->disconnect;
238    
239     1;
240    
241     __END__
242    

Properties

Name Value
svn:executable *

  ViewVC Help
Powered by ViewVC 1.1.26