/[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 15 by dpavlin, Mon Nov 3 21:39:44 2008 UTC revision 21 by dpavlin, Mon Nov 3 23:19:40 2008 UTC
# Line 70  use CGI::Carp qw(fatalsToBrowser); Line 70  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';
# Line 85  our $debug = 1; Line 84  our $debug = 1;
84  my $sql_dir = $ENV{SCRIPT_FILENAME} || '.';  my $sql_dir = $ENV{SCRIPT_FILENAME} || '.';
85  $sql_dir =~ s,/[^/]+$,,;  $sql_dir =~ s,/[^/]+$,,;
86    
87  my $config_path = $1 if "$sql_dir/config.pl" =~ m/^(.+)$/; # untaint  sub require_config {
88  warn "# using $config_path\n";          my $config_path = $1 if "$sql_dir/config.pl" =~ m/^(.+)$/; # untaint
89  require $config_path if -e $config_path;          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};  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;
101    
102  warn "# reading SQL queries from $sql_dir\n" if $debug;  warn "# reading SQL queries from $sql_dir\n" if $debug;
103    
104  opendir(DIR, $sql_dir) || die "can't opendir $sql_dir: $!";  opendir(DIR, $sql_dir) || die "can't opendir $sql_dir: $!";
# Line 116  my $date_format = $workbook->add_format( Line 121  my $date_format = $workbook->add_format(
121  my $dbh = DBI->connect($dsn . $database,$user,$passwd, { RaiseError => 1, AutoCommit => 0 }) || die $DBI::errstr;  my $dbh = DBI->connect($dsn . $database,$user,$passwd, { RaiseError => 1, AutoCommit => 0 }) || die $DBI::errstr;
122    
123  sub _c {  sub _c {
124            return shift unless $db_encoding;
125          return decode( $db_encoding, shift );          return decode( $db_encoding, shift );
126  }  }
127    
128  foreach my $sql_file (@sql_files) {  foreach my $sql_file (@sql_files) {
129    
130          my $sheet_name = $sql_file;          my $sheet_name = $sql_file;
131          $sheet_name =~ s/\d+_//;          $sheet_name =~ s/\d+[_-]//;
132          $sheet_name =~ s/_/ /g;          $sheet_name =~ s/_/ /g;
133          $sheet_name =~ s/\.sql//;          $sheet_name =~ s/\.sql//;
134    
# Line 134  foreach my $sql_file (@sql_files) { Line 140  foreach my $sql_file (@sql_files) {
140    
141          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': $!";
142          my $comment = '';          my $comment = '';
143          my $sql = "";          my $full_sql = "";
144          while(<SQL>) {          while(<SQL>) {
145                  chomp;                  chomp;
146                  if (/^\\c\s+(\S+)/) {                  if (/^\\c\s+(\S+)/) {
# Line 144  foreach my $sql_file (@sql_files) { Line 150  foreach my $sql_file (@sql_files) {
150                  } elsif (/^--(.+)/) {                  } elsif (/^--(.+)/) {
151                          $comment.=$1;                          $comment.=$1;
152                  } else {                  } else {
153                          $sql.= ' ' . $_;                          $full_sql.= ' ' . $_;
154                  }                  }
155          }          }
156          close(SQL);          close(SQL);
157    
158          $sql =~ s/\s\s+/ /gs;          $full_sql =~ s/\s\s+/ /gs;
159            $full_sql .= ';' unless $full_sql =~ m/;\s*/s;
160    
161          print STDERR "sql: $sql\ncomment: $comment\n" if ($debug);          print STDERR "sql: $full_sql\ncomment: $comment\n" if ($debug);
162    
163          my $row = 0;          my $row = 0;
164    
# Line 168  foreach my $sql_file (@sql_files) { Line 175  foreach my $sql_file (@sql_files) {
175                  $row+=2;                  $row+=2;
176          }          }
177    
         my $sth = $dbh->prepare($sql);  
         $sth->execute();  
   
178          my $fmt_header = $workbook->addformat();    # Add a format          my $fmt_header = $workbook->addformat();    # Add a format
179          $fmt_header->set_italic();          $fmt_header->set_italic();
180    
181          for(my $col=0; $col<=$#{ $sth->{NAME} }; $col++) {          foreach my $sql ( split(/;/, $full_sql ) ) {
                 $worksheet->write($row, $col, ${ $sth->{NAME} }[$col], $fmt_header);  
         }  
         $row++;  
182    
183          my @types = map { $dbh->type_info($_) ? $dbh->type_info($_)->{TYPE_NAME} : '?' } @{ $sth->{TYPE} };                  warn "SQL: $sql\n" if $debug;
184    
185          while (my @row = $sth->fetchrow_array() ) {                  my $sth = $dbh->prepare($sql);
186                  for(my $col=0; $col<=$#row; $col++) {                  $sth->execute();
187                          my $data = $row[$col];  
188                          if ( $types[$col] =~ m/^date/i ) {                  next unless $sth->{NAME}; # $sth->rows doesn't work for insert into with MySQL
189                                  $data .= 'T' if $data =~ m/^\d\d\d\d-\d\d-\d\d$/;  
190                                  $data =~ s/^(\d\d\d\d-\d\d-\d\d)\s(\d\d:\S+)$/$1T$2/;                  my @types = eval {
191                                  warn "## $data\n";                          map { $dbh->type_info($_) ? $dbh->type_info($_)->{TYPE_NAME} : '?' } @{ $sth->{TYPE} };
192                                  $worksheet->write_date_time( $row, $col, $data, $date_format );                  };
193                          } else {  
194                                  $worksheet->write($row, $col, _c( $data ) );                  for(my $col=0; $col<=$#{ $sth->{NAME} }; $col++) {
195                          }                          $worksheet->write($row, $col, ${ $sth->{NAME} }[$col], $fmt_header);
196                  }                  }
197                  $row++;                  $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;  $dbh->disconnect;
Legend:
Removed from v.15  
changed lines
  Added in v.21
  ViewVC Help
Powered by ViewVC 1.1.26