/[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 21 - (hide annotations)
Mon Nov 3 23:19:40 2008 UTC (15 years, 4 months ago) by dpavlin
File size: 6025 byte(s)
support multiple SQL queries in one file, for example
to use create temporary time to speedup reporting

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

Properties

Name Value
svn:executable *

  ViewVC Help
Powered by ViewVC 1.1.26