git.rot13.org Git - SQL2XLS/blob - sql2xls.cgi

   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 C<-->) 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 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 =head1 AUTHOR
  62
  63 Dobrica Pavlinusic, dpavlin@rot13.org, L<http://svn.rot13.org/index.cgi/SQL2XLS/>
  64
  65 =cut
  66
  67 use Spreadsheet::WriteExcel;
  68 use DBI;
  69 use CGI::Carp qw(fatalsToBrowser);
  70 use Encode qw/decode/;
  71 use Data::Dump qw/dump/;
  72
  73 our $dsn      = 'DBI:Pg:dbname=';
  74 our $database = 'template1';
  75 our $user     = 'dpavlin';
  76 our $passwd   = '';
  77 our $path     = 'sql_reports.xls';
  78
  79 our $db_encoding     = 'iso-8859-2';
  80 our $xls_date_format = 'dd.mm.yyyy';
  81
  82 our $debug = 1;
  83
  84 my $sql_dir = $ENV{SCRIPT_FILENAME} || '.';
  85 $sql_dir =~ s,/[^/]+$,,;
  86
  87 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
  93 require_config;
  94
  95 my $reports_path = $ENV{PATH_INFO} || '';
  96 $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 require_config;
 101
 102 warn "# reading SQL queries from $sql_dir\n" if $debug;
 103
 104 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 if ($ENV{GATEWAY_INTERFACE} && $ENV{GATEWAY_INTERFACE} =~ m/CGI/i) {
 110         # 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         $workbook = Spreadsheet::WriteExcel->new( $path );
 116         warn "Creating XLS file $path\n";
 117 }
 118
 119 my $date_format = $workbook->add_format(num_format => $xls_date_format);
 120
 121 my $dbh = DBI->connect($dsn . $database,$user,$passwd, { RaiseError => 1, AutoCommit => 0 }) || die $DBI::errstr;
 122
 123 sub _c {
 124         return shift unless $db_encoding;
 125         return decode( $db_encoding, shift );
 126 }
 127
 128 foreach my $sql_file (@sql_files) {
 129
 130         my $sheet_name = $sql_file;
 131         $sheet_name =~ s/\d+[_-]//;
 132         $sheet_name =~ s/_/ /g;
 133         $sheet_name =~ s/\.sql//;
 134
 135         # Add a worksheet
 136         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
 139         print STDERR "working on $sql_file\n" if ($debug);
 140
 141         open(SQL,"$sql_dir/$sql_file") || die "can't open sql file '$sql_dir/$sql_file': $!";
 142         my $comment = '';
 143         my $full_sql = "";
 144         while(<SQL>) {
 145                 chomp;
 146                 if (/^\\c\s+(\S+)/) {
 147                         $dbh->disconnect if $dbh;
 148                         print STDERR "## connect to $1\n" if $debug;
 149                         $dbh = DBI->connect($dsn . $1,$user,$passwd, { RaiseError => 1, AutoCommit => 0 }) || die $DBI::errstr;
 150                 } elsif (/^--(.+)/) {
 151                         $comment.=$1;
 152                 } else {
 153                         $full_sql.= ' ' . $_;
 154                 }
 155         }
 156         close(SQL);
 157
 158         $full_sql =~ s/\s\s+/ /gs;
 159         $full_sql .= ';' unless $full_sql =~ m/;\s*/s;
 160
 161         print STDERR "sql: $full_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                 $comment =~ s/^\s+//;
 172                 $comment =~ s/\s+$//;
 173
 174                 $worksheet->write($row, 0, _c($comment), $fmt_comment);
 175                 $row+=2;
 176         }
 177
 178         my $fmt_header = $workbook->addformat();    # Add a format
 179         $fmt_header->set_italic();
 180
 181         foreach my $sql ( split(/;/, $full_sql ) ) {
 182
 183                 warn "SQL: $sql\n" if $debug;
 184
 185                 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                         }
 215                         $row++;
 216                 }
 217
 218                 $row++; # separete queries by one row
 219         }
 220 }
 221
 222 $dbh->disconnect;
 223
 224 1;
 225
 226 __END__
 227