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

Contents of /sql2xls.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 13 - (show annotations)
Mon Nov 3 20:32:44 2008 UTC (15 years, 4 months ago) by dpavlin
File size: 4836 byte(s)
implement sub-reports which are simply directories and SQL queries,
each generating single XLS file
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 --) 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 =head1 AUTHOR
43
44 Dobrica Pavlinusic, dpavlin@rot13.org
45
46 =cut
47
48 use Spreadsheet::WriteExcel;
49 use DBI;
50 use CGI::Carp qw(fatalsToBrowser);
51 use Encode qw/decode/;
52 use Data::Dump qw/dump/;
53
54 # edit following to set defaults
55 our $dsn = 'DBI:Pg:dbname=';
56 our $database = 'template1';
57 our $user = 'dpavlin';
58 our $passwd = '';
59 our $path = 'sql_reports.xls';
60
61 our $db_encoding = 'iso-8859-2';
62 our $xls_date_format = 'dd.mm.yyyy';
63
64 our $debug = 1;
65
66 my $sql_dir = $ENV{SCRIPT_FILENAME} || '.';
67 $sql_dir =~ s,/[^/]+$,,;
68
69 my $config_path = "$sql_dir/config.pl";
70 warn "# using $config_path\n";
71 require $config_path if -e $config_path;
72
73 my $reports_path = $ENV{PATH_INFO};
74 $reports_path =~ s/\.\.//g; # some protection against path exploits
75 $reports_path ||= shift @ARGV; # for CLI invocation
76 $sql_dir .= "/$reports_path" if -e "$sql_dir/$reports_path";
77
78 warn "# reading SQL queries from $sql_dir\n" if $debug;
79
80 opendir(DIR, $sql_dir) || die "can't opendir $sql_dir: $!";
81 my @sql_files = sort grep { /\.sql$/i && -f "$sql_dir/$_" } readdir(DIR);
82 closedir DIR;
83
84 my $workbook;
85 if ($ENV{GATEWAY_INTERFACE} && $ENV{GATEWAY_INTERFACE} =~ m/CGI/i) {
86 # use as cgi script
87 print "Content-type: application/vnd.ms-excel\n\n";
88 $workbook = Spreadsheet::WriteExcel->new("-");
89 } else {
90 # Create a new Excel workbook
91 $workbook = Spreadsheet::WriteExcel->new( $path );
92 warn "Creating XLS file $path\n";
93 }
94
95 my $date_format = $workbook->add_format(num_format => $xls_date_format);
96
97 my $dbh = DBI->connect($dsn . $database,$user,$passwd, { RaiseError => 1, AutoCommit => 0 }) || die $DBI::errstr;
98
99 sub _c {
100 return decode( $db_encoding, shift );
101 }
102
103 foreach my $sql_file (@sql_files) {
104
105 my $sheet_name = $sql_file;
106 $sheet_name =~ s/\d+_//;
107 $sheet_name =~ s/_/ /g;
108 $sheet_name =~ s/\.sql//;
109
110 # Add a worksheet
111 warn "# clipping sheet name '$sheet_name' to 31 char limit\n" if length $sheet_name > 31;
112 my $worksheet = $workbook->addworksheet( substr($sheet_name,0,31) );
113
114 print STDERR "working on $sql_file\n" if ($debug);
115
116 open(SQL,"$sql_dir/$sql_file") || die "can't open sql file '$sql_dir/$sql_file': $!";
117 my $comment = '';
118 my $sql = "";
119 while(<SQL>) {
120 chomp;
121 if (/^\\c\s+(\S+)/) {
122 $dbh->disconnect if $dbh;
123 print STDERR "## connect to $1\n" if $debug;
124 $dbh = DBI->connect($dsn . $1,$user,$passwd, { RaiseError => 1, AutoCommit => 0 }) || die $DBI::errstr;
125 } elsif (/^--(.+)/) {
126 $comment.=$1;
127 } else {
128 $sql.= ' ' . $_;
129 }
130 }
131 close(SQL);
132
133 $sql =~ s/\s\s+/ /gs;
134
135 print STDERR "sql: $sql\ncomment: $comment\n" if ($debug);
136
137 my $row = 0;
138
139 if ($comment) {
140
141 # Add and define a format
142 my $fmt_comment = $workbook->addformat(); # Add a format
143 $fmt_comment->set_bold();
144
145 $comment =~ s/^\s+//;
146 $comment =~ s/\s+$//;
147
148 $worksheet->write($row, 0, _c($comment), $fmt_comment);
149 $row+=2;
150 }
151
152 my $sth = $dbh->prepare($sql);
153 $sth->execute();
154
155 my $fmt_header = $workbook->addformat(); # Add a format
156 $fmt_header->set_italic();
157
158 for(my $col=0; $col<=$#{ $sth->{NAME} }; $col++) {
159 $worksheet->write($row, $col, ${ $sth->{NAME} }[$col], $fmt_header);
160 }
161 $row++;
162
163 my @types = map { $dbh->type_info($_) ? $dbh->type_info($_)->{TYPE_NAME} : '?' } @{ $sth->{TYPE} };
164
165 while (my @row = $sth->fetchrow_array() ) {
166 for(my $col=0; $col<=$#row; $col++) {
167 my $data = $row[$col];
168 if ( $types[$col] =~ m/^date/i ) {
169 $data .= 'T' if $data =~ m/^\d\d\d\d-\d\d-\d\d$/;
170 $data =~ s/^(\d\d\d\d-\d\d-\d\d)\s(\d\d:\S+)$/$1T$2/;
171 warn "## $data\n";
172 $worksheet->write_date_time( $row, $col, $data, $date_format );
173 } else {
174 $worksheet->write($row, $col, _c( $data ) );
175 }
176 }
177 $row++;
178 }
179
180 }
181
182 $dbh->disconnect;
183
184 1;
185
186 __END__
187

Properties

Name Value
svn:executable *

  ViewVC Help
Powered by ViewVC 1.1.26