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

Diff of /sql2xlsx.cgi

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 5 by dpavlin, Mon Nov 3 18:31:58 2008 UTC revision 12 by dpavlin, Mon Nov 3 20:15:09 2008 UTC
# Line 22  C<< \c database >> syntax is supported. Line 22  C<< \c database >> syntax is supported.
22  You can also run script from command line, and it will produce  You can also run script from command line, and it will produce
23  C<< sql_reports.xls >> file.  C<< sql_reports.xls >> file.
24    
25    =head1 INSTALLATION
26    
27    Only required file is this script C<< sql2xls.cgi >>
28    
29    If your server is configured to execute C<.cgi> files, you can
30    drop this script anywhere, but you can also add something like
31    
32       ScriptAlias /xls-reports /srv/SQL2XLS/sql2xls.cgi
33    
34    in Apache's virtual host configuration to get nice URLs
35    
36  =head1 AUTHOR  =head1 AUTHOR
37    
38  Dobrica Pavlinusic, dpavlin@rot13.org  Dobrica Pavlinusic, dpavlin@rot13.org
# Line 36  use Encode qw/decode/; Line 47  use Encode qw/decode/;
47  use Data::Dump qw/dump/;  use Data::Dump qw/dump/;
48    
49  # edit following to set defaults  # edit following to set defaults
50  my $dsn      = 'DBI:Pg:dbname=';  our $dsn      = 'DBI:Pg:dbname=';
51  my $database = 'template1';  our $database = 'template1';
52  my $user     = 'dpavlin';  our $user     = 'dpavlin';
53  my $passwd   = '';  our $passwd   = '';
54  my $path     = 'sql_reports.xls';  our $path     = 'sql_reports.xls';
55    
56  my $db_encoding     = 'iso-8859-2';  our $db_encoding     = 'iso-8859-2';
57  my $xls_date_format = 'dd.mm.yyyy';  our $xls_date_format = 'dd.mm.yyyy';
58    
59  my $debug = 1;  our $debug = 1;
60    
61  my $sql_dir = path_translated || '.';  my $sql_dir = path_translated || '.';
62  $sql_dir =~ s,/[^/]+$,,;  $sql_dir =~ s,/[^/]+$,,;
# Line 54  opendir(DIR, $sql_dir) || die "can't ope Line 65  opendir(DIR, $sql_dir) || die "can't ope
65  my @sql_files = sort grep { /\.sql$/i && -f "$sql_dir/$_" } readdir(DIR);  my @sql_files = sort grep { /\.sql$/i && -f "$sql_dir/$_" } readdir(DIR);
66  closedir DIR;  closedir DIR;
67    
68    my $config_path = "$sql_dir/config.pl";
69    warn "# using $config_path\n";
70    require $config_path if -e $config_path;
71    
72  my $workbook;  my $workbook;
73  if ($ENV{GATEWAY_INTERFACE} && $ENV{GATEWAY_INTERFACE} =~ m/CGI/i) {  if ($ENV{GATEWAY_INTERFACE} && $ENV{GATEWAY_INTERFACE} =~ m/CGI/i) {
74          # use as cgi script          # use as cgi script
# Line 81  foreach my $sql_file (@sql_files) { Line 96  foreach my $sql_file (@sql_files) {
96          $sheet_name =~ s/\.sql//;          $sheet_name =~ s/\.sql//;
97    
98          # Add a worksheet          # Add a worksheet
99          my $worksheet = $workbook->addworksheet($sheet_name);          warn "# clipping sheet name '$sheet_name' to 31 char limit\n" if length $sheet_name > 31;
100            my $worksheet = $workbook->addworksheet( substr($sheet_name,0,31) );
101    
102          print STDERR "working on $sql_file...\n" if ($debug);          print STDERR "working on $sql_file\n" if ($debug);
103    
104          open(SQL,$sql_file) || die "can't open sql file '$sql_file': $!";          open(SQL,$sql_file) || die "can't open sql file '$sql_file': $!";
105          my $comment;          my $comment = '';
106          my $sql = "";          my $sql = "";
107          while(<SQL>) {          while(<SQL>) {
108                  chomp;                  chomp;
109                  if (/^\\c\s+(\S+)/) {                  if (/^\\c\s+(\S+)/) {
110                          warn "## connect to $1\n" if $debug;                          $dbh->disconnect if $dbh;
111                            print STDERR "## connect to $1\n" if $debug;
112                          $dbh = DBI->connect($dsn . $1,$user,$passwd, { RaiseError => 1, AutoCommit => 0 }) || die $DBI::errstr;                          $dbh = DBI->connect($dsn . $1,$user,$passwd, { RaiseError => 1, AutoCommit => 0 }) || die $DBI::errstr;
113                  } elsif (/^--(.+)/) {                  } elsif (/^--(.+)/) {
114                          $comment.=$1;                          $comment.=$1;
# Line 113  foreach my $sql_file (@sql_files) { Line 130  foreach my $sql_file (@sql_files) {
130                  my $fmt_comment = $workbook->addformat();    # Add a format                  my $fmt_comment = $workbook->addformat();    # Add a format
131                  $fmt_comment->set_bold();                  $fmt_comment->set_bold();
132    
133                    $comment =~ s/^\s+//;
134                    $comment =~ s/\s+$//;
135    
136                  $worksheet->write($row, 0, _c($comment), $fmt_comment);                  $worksheet->write($row, 0, _c($comment), $fmt_comment);
137                  $row+=2;                  $row+=2;
138          }          }
# Line 128  foreach my $sql_file (@sql_files) { Line 148  foreach my $sql_file (@sql_files) {
148          }          }
149          $row++;          $row++;
150    
151          my @types = map { scalar $dbh->type_info($_)->{TYPE_NAME} } @{ $sth->{TYPE} };          my @types = map { $dbh->type_info($_) ? $dbh->type_info($_)->{TYPE_NAME} : '?' } @{ $sth->{TYPE} };
152    
153          while (my @row = $sth->fetchrow_array() ) {          while (my @row = $sth->fetchrow_array() ) {
154                  for(my $col=0; $col<=$#row; $col++) {                  for(my $col=0; $col<=$#row; $col++) {
Legend:
Removed from v.5  
changed lines
  Added in v.12
  ViewVC Help
Powered by ViewVC 1.1.26