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

sql2xls.cgi revision 19 by dpavlin, Mon Nov 3 22:29:05 2008 UTC sql2xlsx.cgi revision 27 by dpavlin, Tue Dec 28 13:56:16 2010 UTC
# Line 64  Dobrica Pavlinusic, dpavlin@rot13.org, L Line 64  Dobrica Pavlinusic, dpavlin@rot13.org, L
64    
65  =cut  =cut
66    
67  use Spreadsheet::WriteExcel;  use Excel::Writer::XLSX;
68  use DBI;  use DBI;
69  use CGI::Carp qw(fatalsToBrowser);  use CGI::Carp qw(fatalsToBrowser);
70  use Encode qw/decode/;  use Encode qw/decode/;
71  use Data::Dump qw/dump/;  use Data::Dump qw/dump/;
72    
 # edit following to set defaults  
73  our $dsn      = 'DBI:Pg:dbname=';  our $dsn      = 'DBI:Pg:dbname=';
74  our $database = 'template1';  our $database = 'template1';
75  our $user     = 'dpavlin';  our $user     = 'dpavlin';
76  our $passwd   = '';  our $passwd   = '';
77  our $path     = 'sql_reports.xls';  our $path     = 'sql_reports.xlsx';
78    
79  our $db_encoding     = 'iso-8859-2';  our $db_encoding     = 'iso-8859-2';
80  our $xls_date_format = 'dd.mm.yyyy';  our $xls_date_format = 'dd.mm.yyyy';
81    
82  our $debug = 1;  our $debug = $ENV{DEBUG} || 0;
83    
84  my $sql_dir = $ENV{SCRIPT_FILENAME} || '.';  my $sql_dir = $ENV{SCRIPT_FILENAME} || '.';
85  $sql_dir =~ s,/[^/]+$,,;  $sql_dir =~ s,/[^/]+$,,;
# Line 93  sub require_config { Line 92  sub require_config {
92    
93  require_config;  require_config;
94    
95  my $reports_path = $ENV{PATH_INFO};  my $reports_path = $ENV{PATH_INFO} || '';
96  $reports_path =~ s/\.\.//g; # some protection against path exploits  $reports_path =~ s/\.\.//g; # some protection against path exploits
97  $reports_path ||= shift @ARGV; # for CLI invocation  $reports_path ||= shift @ARGV; # for CLI invocation
98  $sql_dir .= "/$reports_path" if -e "$sql_dir/$reports_path";  $sql_dir .= "/$reports_path" if -e "$sql_dir/$reports_path";
99    
100  require_config;  require_config;
101    
102  warn "# reading SQL queries from $sql_dir\n" if $debug;  warn "SQL queries from $sql_dir\n";
103    
104  opendir(DIR, $sql_dir) || die "can't opendir $sql_dir: $!";  opendir(DIR, $sql_dir) || die "can't opendir $sql_dir: $!";
105  my @sql_files = sort grep { /\.sql$/i && -f "$sql_dir/$_" } readdir(DIR);  my @sql_files = sort grep { /\.sql$/i && -f "$sql_dir/$_" } readdir(DIR);
# Line 110  my $workbook; Line 109  my $workbook;
109  if ($ENV{GATEWAY_INTERFACE} && $ENV{GATEWAY_INTERFACE} =~ m/CGI/i) {  if ($ENV{GATEWAY_INTERFACE} && $ENV{GATEWAY_INTERFACE} =~ m/CGI/i) {
110          # use as cgi script          # use as cgi script
111          print "Content-type: application/vnd.ms-excel\n\n";          print "Content-type: application/vnd.ms-excel\n\n";
112          $workbook = Spreadsheet::WriteExcel->new("-");          $workbook = Excel::Writer::XLSX->new("-");
113  } else {  } else {
114          # Create a new Excel workbook          # Create a new Excel workbook
115          $workbook = Spreadsheet::WriteExcel->new( $path );          $path =~ s{\.xls$}{\.xlsx};
116            $workbook = Excel::Writer::XLSX->new( $path );
117          warn "Creating XLS file $path\n";          warn "Creating XLS file $path\n";
118  }  }
119    
120  my $date_format = $workbook->add_format(num_format => $xls_date_format);  my $date_format = $workbook->add_format(num_format => $xls_date_format);
121    
122  my $dbh = DBI->connect($dsn . $database,$user,$passwd, { RaiseError => 1, AutoCommit => 0 }) || die $DBI::errstr;  our $dbh;
123    sub use_database {
124            $dbh->disconnect if $dbh;
125            my $database = shift || return;
126            print STDERR "## connect to $database\n" if $debug;
127            $dbh = DBI->connect($dsn . $database,$user,$passwd, { RaiseError => 1, AutoCommit => 0 }) || die $DBI::errstr;
128            if ( $db_encoding ) {
129                    if ( $dsn =~ m{Pg} ) {
130                            $dbh->do( qq{ set client_encoding = '$db_encoding'; } );
131                    } elsif ( $dsn =~ m{mysql} ) {
132                            $dbh->do( qq{ set names '$db_encoding'; } );
133                    } else {
134                            warn "Don't know how to set encoding to $db_encoding for $dsn";
135                    }
136            }
137    }
138    
139    use_database( $database );
140    
141  sub _c {  sub _c {
142          return shift unless $db_encoding;          return shift unless $db_encoding;
# Line 129  sub _c { Line 146  sub _c {
146  foreach my $sql_file (@sql_files) {  foreach my $sql_file (@sql_files) {
147    
148          my $sheet_name = $sql_file;          my $sheet_name = $sql_file;
149          $sheet_name =~ s/\d+_//;          $sheet_name =~ s/\d+[_-]//;
150          $sheet_name =~ s/_/ /g;          $sheet_name =~ s/_/ /g;
151          $sheet_name =~ s/\.sql//;          $sheet_name =~ s/\.sql//;
152    
153          # Add a worksheet          # Add a worksheet
154          warn "# clipping sheet name '$sheet_name' to 31 char limit\n" if length $sheet_name > 31;          warn "# clipping sheet name '$sheet_name' to 31 char limit\n" if length $sheet_name > 31;
155          my $worksheet = $workbook->addworksheet( substr($sheet_name,0,31) );          my $worksheet = $workbook->add_worksheet( substr($sheet_name,0,31) );
156    
157          print STDERR "working on $sql_file\n" if ($debug);          print STDERR "working on $sql_file\n" if ($debug);
158    
159          open(SQL,"$sql_dir/$sql_file") || die "can't open sql file '$sql_dir/$sql_file': $!";          open(SQL,"$sql_dir/$sql_file") || die "can't open sql file '$sql_dir/$sql_file': $!";
160          my $comment = '';          my $comment = '';
161          my $sql = "";          my $full_sql = "";
162          while(<SQL>) {          while(<SQL>) {
163                  chomp;                  chomp;
164                  if (/^\\c\s+(\S+)/) {                  if (/^\\c\s+(\S+)/) {
165                          $dbh->disconnect if $dbh;                          use_database( $1 );
                         print STDERR "## connect to $1\n" if $debug;  
                         $dbh = DBI->connect($dsn . $1,$user,$passwd, { RaiseError => 1, AutoCommit => 0 }) || die $DBI::errstr;  
166                  } elsif (/^--(.+)/) {                  } elsif (/^--(.+)/) {
167                          $comment.=$1;                          $comment.=$1;
168                  } else {                  } else {
169                          $sql.= ' ' . $_;                          $full_sql.= ' ' . $_;
170                  }                  }
171          }          }
172          close(SQL);          close(SQL);
173    
174          $sql =~ s/\s\s+/ /gs;          $full_sql =~ s/\s\s+/ /gs;
175            $full_sql .= ';' unless $full_sql =~ m/;\s*/s;
176    
177          print STDERR "sql: $sql\ncomment: $comment\n" if ($debug);          print STDERR "sql: $full_sql\ncomment: $comment\n" if ($debug);
178    
179          my $row = 0;          my $row = 0;
180    
181          if ($comment) {          if ($comment) {
182    
183                  #  Add and define a format                  #  Add and define a format
184                  my $fmt_comment = $workbook->addformat();    # Add a format                  my $fmt_comment = $workbook->add_format();    # Add a format
185                  $fmt_comment->set_bold();                  $fmt_comment->set_bold();
186    
187                  $comment =~ s/^\s+//;                  $comment =~ s/^\s+//;
# Line 175  foreach my $sql_file (@sql_files) { Line 191  foreach my $sql_file (@sql_files) {
191                  $row+=2;                  $row+=2;
192          }          }
193    
194          my $sth = $dbh->prepare($sql);          my $fmt_header = $workbook->add_format();    # Add a format
         $sth->execute();  
   
         my $fmt_header = $workbook->addformat();    # Add a format  
195          $fmt_header->set_italic();          $fmt_header->set_italic();
196    
197          for(my $col=0; $col<=$#{ $sth->{NAME} }; $col++) {          foreach my $sql ( split(/;/, $full_sql ) ) {
                 $worksheet->write($row, $col, ${ $sth->{NAME} }[$col], $fmt_header);  
         }  
         $row++;  
198    
199          my @types = map { $dbh->type_info($_) ? $dbh->type_info($_)->{TYPE_NAME} : '?' } @{ $sth->{TYPE} };                  warn "SQL: $sql\n";
200    
201          while (my @row = $sth->fetchrow_array() ) {                  my $sth = $dbh->prepare($sql);
202                  for(my $col=0; $col<=$#row; $col++) {                  $sth->execute();
203                          my $data = $row[$col];  
204                          if ( $types[$col] =~ m/^date/i ) {                  next unless $sth->{NAME} && $sth->rows > 0; # $sth->rows alone doesn't work for insert into with MySQL
205                                  $data .= 'T' if $data =~ m/^\d\d\d\d-\d\d-\d\d$/;  
206                                  $data =~ s/^(\d\d\d\d-\d\d-\d\d)\s(\d\d:\d\d:\d\d)$/$1T$2/;                  my @types = eval {
207                                  warn "## by type datetime $data\n";                          map { $dbh->type_info($_) ? $dbh->type_info($_)->{TYPE_NAME} : '?' } @{ $sth->{TYPE} };
208                                  $worksheet->write_date_time( $row, $col, $data, $date_format );                  };
209                          } elsif ( $data =~ s/^(\d\d\d\d-\d\d-\d\d)[\sT](\d\d:\d\d:\d\d)$/$1T$2/ ) {  
210                                  warn "## heuristic date time: $1T$2\n";                  for(my $col=0; $col<=$#{ $sth->{NAME} }; $col++) {
211                                  $worksheet->write_date_time( $row, $col, "$1T$2", $date_format );                          $worksheet->write($row, $col, ${ $sth->{NAME} }[$col], $fmt_header);
                         } else {  
                                 $worksheet->write($row, $col, _c( $data ) );  
                         }  
212                  }                  }
213                  $row++;                  $row++;
         }  
214    
215                    while (my @row = $sth->fetchrow_array() ) {
216                            for(my $col=0; $col<=$#row; $col++) {
217                                    my $data = $row[$col];
218                                    next unless defined $data;
219                                    if ( $types[$col] && $types[$col] =~ m/^date/i ) {
220                                            $data .= 'T' if $data =~ m/^\d\d\d\d-\d\d-\d\d$/;
221                                            $data =~ s/^(\d\d\d\d-\d\d-\d\d)\s(\d\d:\d\d:\d\d)$/$1T$2/;
222                                            warn "## by type datetime $data\n" if $debug;
223                                            $worksheet->write_date_time( $row, $col, $data, $date_format );
224                                    } elsif ( $data =~ s/^(\d\d\d\d-\d\d-\d\d)[\sT](\d\d:\d\d:\d\d)$/$1T$2/ ) {
225                                            warn "## heuristic date time: $1T$2\n" if $debug;
226                                            $worksheet->write_date_time( $row, $col, "$1T$2", $date_format );
227                                    } else {
228                                            $worksheet->write($row, $col, _c( $data ) );
229                                    }
230                            }
231                            $row++;
232                    }
233    
234                    $row++; # separete queries by one row
235                    warn "# row $row\n";
236            }
237  }  }
238    
239  $dbh->disconnect;  $dbh->disconnect;
Legend:
Removed from v.19  
changed lines
  Added in v.27
  ViewVC Help
Powered by ViewVC 1.1.26