/[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 13 - (hide annotations)
Mon Nov 3 20:32:44 2008 UTC (15 years, 4 months ago) by dpavlin
Original Path: sql2xls.cgi
File size: 4836 byte(s)
implement sub-reports which are simply directories and SQL queries,
each generating single XLS file
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     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 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 5 =head1 AUTHOR
43    
44     Dobrica Pavlinusic, dpavlin@rot13.org
45    
46     =cut
47    
48 dpavlin 1 use Spreadsheet::WriteExcel;
49     use DBI;
50     use CGI::Carp qw(fatalsToBrowser);
51 dpavlin 2 use Encode qw/decode/;
52 dpavlin 3 use Data::Dump qw/dump/;
53 dpavlin 1
54 dpavlin 5 # edit following to set defaults
55 dpavlin 10 our $dsn = 'DBI:Pg:dbname=';
56     our $database = 'template1';
57     our $user = 'dpavlin';
58     our $passwd = '';
59     our $path = 'sql_reports.xls';
60 dpavlin 2
61 dpavlin 10 our $db_encoding = 'iso-8859-2';
62     our $xls_date_format = 'dd.mm.yyyy';
63 dpavlin 3
64 dpavlin 10 our $debug = 1;
65 dpavlin 1
66 dpavlin 13 my $sql_dir = $ENV{SCRIPT_FILENAME} || '.';
67 dpavlin 1 $sql_dir =~ s,/[^/]+$,,;
68    
69 dpavlin 13 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 dpavlin 1 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 dpavlin 5 if ($ENV{GATEWAY_INTERFACE} && $ENV{GATEWAY_INTERFACE} =~ m/CGI/i) {
86 dpavlin 1 # 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 dpavlin 5 $workbook = Spreadsheet::WriteExcel->new( $path );
92     warn "Creating XLS file $path\n";
93 dpavlin 1 }
94    
95 dpavlin 3 my $date_format = $workbook->add_format(num_format => $xls_date_format);
96    
97 dpavlin 5 my $dbh = DBI->connect($dsn . $database,$user,$passwd, { RaiseError => 1, AutoCommit => 0 }) || die $DBI::errstr;
98 dpavlin 1
99 dpavlin 2 sub _c {
100 dpavlin 3 return decode( $db_encoding, shift );
101 dpavlin 2 }
102    
103 dpavlin 1 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 dpavlin 11 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 dpavlin 1
114 dpavlin 6 print STDERR "working on $sql_file\n" if ($debug);
115 dpavlin 1
116 dpavlin 13 open(SQL,"$sql_dir/$sql_file") || die "can't open sql file '$sql_dir/$sql_file': $!";
117 dpavlin 7 my $comment = '';
118 dpavlin 1 my $sql = "";
119     while(<SQL>) {
120     chomp;
121 dpavlin 4 if (/^\\c\s+(\S+)/) {
122 dpavlin 6 $dbh->disconnect if $dbh;
123     print STDERR "## connect to $1\n" if $debug;
124 dpavlin 5 $dbh = DBI->connect($dsn . $1,$user,$passwd, { RaiseError => 1, AutoCommit => 0 }) || die $DBI::errstr;
125 dpavlin 4 } elsif (/^--(.+)/) {
126 dpavlin 1 $comment.=$1;
127     } else {
128 dpavlin 4 $sql.= ' ' . $_;
129 dpavlin 1 }
130     }
131     close(SQL);
132    
133 dpavlin 4 $sql =~ s/\s\s+/ /gs;
134    
135 dpavlin 1 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 dpavlin 8 $comment =~ s/^\s+//;
146     $comment =~ s/\s+$//;
147    
148 dpavlin 2 $worksheet->write($row, 0, _c($comment), $fmt_comment);
149 dpavlin 1 $row+=2;
150     }
151    
152 dpavlin 5 my $sth = $dbh->prepare($sql);
153     $sth->execute();
154 dpavlin 1
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 dpavlin 6 my @types = map { $dbh->type_info($_) ? $dbh->type_info($_)->{TYPE_NAME} : '?' } @{ $sth->{TYPE} };
164 dpavlin 3
165 dpavlin 1 while (my @row = $sth->fetchrow_array() ) {
166     for(my $col=0; $col<=$#row; $col++) {
167 dpavlin 3 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 dpavlin 4 $data =~ s/^(\d\d\d\d-\d\d-\d\d)\s(\d\d:\S+)$/$1T$2/;
171     warn "## $data\n";
172 dpavlin 3 $worksheet->write_date_time( $row, $col, $data, $date_format );
173     } else {
174     $worksheet->write($row, $col, _c( $data ) );
175     }
176 dpavlin 1 }
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