/[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 20 - (hide annotations)
Mon Nov 3 22:31:47 2008 UTC (15 years, 4 months ago) by dpavlin
File size: 5673 byte(s)
strip \d+[-_] from beginning of SQL file before creating sheet name
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 5 # edit following to set defaults
74 dpavlin 10 our $dsn = 'DBI:Pg:dbname=';
75     our $database = 'template1';
76     our $user = 'dpavlin';
77     our $passwd = '';
78     our $path = 'sql_reports.xls';
79 dpavlin 2
80 dpavlin 10 our $db_encoding = 'iso-8859-2';
81     our $xls_date_format = 'dd.mm.yyyy';
82 dpavlin 3
83 dpavlin 10 our $debug = 1;
84 dpavlin 1
85 dpavlin 13 my $sql_dir = $ENV{SCRIPT_FILENAME} || '.';
86 dpavlin 1 $sql_dir =~ s,/[^/]+$,,;
87    
88 dpavlin 18 sub require_config {
89     my $config_path = $1 if "$sql_dir/config.pl" =~ m/^(.+)$/; # untaint
90     warn "# using $config_path\n";
91     require $config_path if -e $config_path;
92     }
93 dpavlin 13
94 dpavlin 18 require_config;
95    
96 dpavlin 13 my $reports_path = $ENV{PATH_INFO};
97     $reports_path =~ s/\.\.//g; # some protection against path exploits
98     $reports_path ||= shift @ARGV; # for CLI invocation
99     $sql_dir .= "/$reports_path" if -e "$sql_dir/$reports_path";
100    
101 dpavlin 18 require_config;
102    
103 dpavlin 13 warn "# reading SQL queries from $sql_dir\n" if $debug;
104    
105 dpavlin 1 opendir(DIR, $sql_dir) || die "can't opendir $sql_dir: $!";
106     my @sql_files = sort grep { /\.sql$/i && -f "$sql_dir/$_" } readdir(DIR);
107     closedir DIR;
108    
109     my $workbook;
110 dpavlin 5 if ($ENV{GATEWAY_INTERFACE} && $ENV{GATEWAY_INTERFACE} =~ m/CGI/i) {
111 dpavlin 1 # use as cgi script
112     print "Content-type: application/vnd.ms-excel\n\n";
113     $workbook = Spreadsheet::WriteExcel->new("-");
114     } else {
115     # Create a new Excel workbook
116 dpavlin 5 $workbook = Spreadsheet::WriteExcel->new( $path );
117     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 5 my $dbh = DBI->connect($dsn . $database,$user,$passwd, { RaiseError => 1, AutoCommit => 0 }) || die $DBI::errstr;
123 dpavlin 1
124 dpavlin 2 sub _c {
125 dpavlin 16 return shift unless $db_encoding;
126 dpavlin 3 return decode( $db_encoding, shift );
127 dpavlin 2 }
128    
129 dpavlin 1 foreach my $sql_file (@sql_files) {
130    
131     my $sheet_name = $sql_file;
132 dpavlin 20 $sheet_name =~ s/\d+[_-]//;
133 dpavlin 1 $sheet_name =~ s/_/ /g;
134     $sheet_name =~ s/\.sql//;
135    
136     # Add a worksheet
137 dpavlin 11 warn "# clipping sheet name '$sheet_name' to 31 char limit\n" if length $sheet_name > 31;
138     my $worksheet = $workbook->addworksheet( substr($sheet_name,0,31) );
139 dpavlin 1
140 dpavlin 6 print STDERR "working on $sql_file\n" if ($debug);
141 dpavlin 1
142 dpavlin 13 open(SQL,"$sql_dir/$sql_file") || die "can't open sql file '$sql_dir/$sql_file': $!";
143 dpavlin 7 my $comment = '';
144 dpavlin 1 my $sql = "";
145     while(<SQL>) {
146     chomp;
147 dpavlin 4 if (/^\\c\s+(\S+)/) {
148 dpavlin 6 $dbh->disconnect if $dbh;
149     print STDERR "## connect to $1\n" if $debug;
150 dpavlin 5 $dbh = DBI->connect($dsn . $1,$user,$passwd, { RaiseError => 1, AutoCommit => 0 }) || die $DBI::errstr;
151 dpavlin 4 } elsif (/^--(.+)/) {
152 dpavlin 1 $comment.=$1;
153     } else {
154 dpavlin 4 $sql.= ' ' . $_;
155 dpavlin 1 }
156     }
157     close(SQL);
158    
159 dpavlin 4 $sql =~ s/\s\s+/ /gs;
160    
161 dpavlin 1 print STDERR "sql: $sql\ncomment: $comment\n" if ($debug);
162    
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 dpavlin 5 my $sth = $dbh->prepare($sql);
179     $sth->execute();
180 dpavlin 1
181     my $fmt_header = $workbook->addformat(); # Add a format
182     $fmt_header->set_italic();
183    
184     for(my $col=0; $col<=$#{ $sth->{NAME} }; $col++) {
185     $worksheet->write($row, $col, ${ $sth->{NAME} }[$col], $fmt_header);
186     }
187     $row++;
188    
189 dpavlin 6 my @types = map { $dbh->type_info($_) ? $dbh->type_info($_)->{TYPE_NAME} : '?' } @{ $sth->{TYPE} };
190 dpavlin 3
191 dpavlin 1 while (my @row = $sth->fetchrow_array() ) {
192     for(my $col=0; $col<=$#row; $col++) {
193 dpavlin 3 my $data = $row[$col];
194     if ( $types[$col] =~ m/^date/i ) {
195     $data .= 'T' if $data =~ m/^\d\d\d\d-\d\d-\d\d$/;
196 dpavlin 19 $data =~ s/^(\d\d\d\d-\d\d-\d\d)\s(\d\d:\d\d:\d\d)$/$1T$2/;
197     warn "## by type datetime $data\n";
198 dpavlin 3 $worksheet->write_date_time( $row, $col, $data, $date_format );
199 dpavlin 19 } elsif ( $data =~ s/^(\d\d\d\d-\d\d-\d\d)[\sT](\d\d:\d\d:\d\d)$/$1T$2/ ) {
200     warn "## heuristic date time: $1T$2\n";
201     $worksheet->write_date_time( $row, $col, "$1T$2", $date_format );
202 dpavlin 3 } else {
203     $worksheet->write($row, $col, _c( $data ) );
204     }
205 dpavlin 1 }
206     $row++;
207     }
208    
209     }
210    
211     $dbh->disconnect;
212    
213     1;
214    
215     __END__
216    

Properties

Name Value
svn:executable *

  ViewVC Help
Powered by ViewVC 1.1.26