36 |
use Data::Dump qw/dump/; |
use Data::Dump qw/dump/; |
37 |
|
|
38 |
# edit following to set defaults |
# edit following to set defaults |
39 |
my $dsn = 'DBI:Pg:dbname='; |
our $dsn = 'DBI:Pg:dbname='; |
40 |
my $database = 'template1'; |
our $database = 'template1'; |
41 |
my $user = 'dpavlin'; |
our $user = 'dpavlin'; |
42 |
my $passwd = ''; |
our $passwd = ''; |
43 |
my $path = 'sql_reports.xls'; |
our $path = 'sql_reports.xls'; |
44 |
|
|
45 |
my $db_encoding = 'iso-8859-2'; |
our $db_encoding = 'iso-8859-2'; |
46 |
my $xls_date_format = 'dd.mm.yyyy'; |
our $xls_date_format = 'dd.mm.yyyy'; |
47 |
|
|
48 |
my $debug = 1; |
our $debug = 1; |
49 |
|
|
50 |
my $sql_dir = path_translated || '.'; |
my $sql_dir = path_translated || '.'; |
51 |
$sql_dir =~ s,/[^/]+$,,; |
$sql_dir =~ s,/[^/]+$,,; |
54 |
my @sql_files = sort grep { /\.sql$/i && -f "$sql_dir/$_" } readdir(DIR); |
my @sql_files = sort grep { /\.sql$/i && -f "$sql_dir/$_" } readdir(DIR); |
55 |
closedir DIR; |
closedir DIR; |
56 |
|
|
57 |
|
my $config_path = "$sql_dir/config.pl"; |
58 |
|
warn "# using $config_path\n"; |
59 |
|
require $config_path if -e $config_path; |
60 |
|
|
61 |
my $workbook; |
my $workbook; |
62 |
if ($ENV{GATEWAY_INTERFACE} && $ENV{GATEWAY_INTERFACE} =~ m/CGI/i) { |
if ($ENV{GATEWAY_INTERFACE} && $ENV{GATEWAY_INTERFACE} =~ m/CGI/i) { |
63 |
# use as cgi script |
# use as cgi script |
85 |
$sheet_name =~ s/\.sql//; |
$sheet_name =~ s/\.sql//; |
86 |
|
|
87 |
# Add a worksheet |
# Add a worksheet |
88 |
my $worksheet = $workbook->addworksheet($sheet_name); |
warn "# clipping sheet name '$sheet_name' to 31 char limit\n" if length $sheet_name > 31; |
89 |
|
my $worksheet = $workbook->addworksheet( substr($sheet_name,0,31) ); |
90 |
|
|
91 |
print STDERR "working on $sql_file...\n" if ($debug); |
print STDERR "working on $sql_file\n" if ($debug); |
92 |
|
|
93 |
open(SQL,$sql_file) || die "can't open sql file '$sql_file': $!"; |
open(SQL,$sql_file) || die "can't open sql file '$sql_file': $!"; |
94 |
my $comment; |
my $comment = ''; |
95 |
my $sql = ""; |
my $sql = ""; |
96 |
while(<SQL>) { |
while(<SQL>) { |
97 |
chomp; |
chomp; |
98 |
if (/^\\c\s+(\S+)/) { |
if (/^\\c\s+(\S+)/) { |
99 |
warn "## connect to $1\n" if $debug; |
$dbh->disconnect if $dbh; |
100 |
|
print STDERR "## connect to $1\n" if $debug; |
101 |
$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; |
102 |
} elsif (/^--(.+)/) { |
} elsif (/^--(.+)/) { |
103 |
$comment.=$1; |
$comment.=$1; |
119 |
my $fmt_comment = $workbook->addformat(); # Add a format |
my $fmt_comment = $workbook->addformat(); # Add a format |
120 |
$fmt_comment->set_bold(); |
$fmt_comment->set_bold(); |
121 |
|
|
122 |
|
$comment =~ s/^\s+//; |
123 |
|
$comment =~ s/\s+$//; |
124 |
|
|
125 |
$worksheet->write($row, 0, _c($comment), $fmt_comment); |
$worksheet->write($row, 0, _c($comment), $fmt_comment); |
126 |
$row+=2; |
$row+=2; |
127 |
} |
} |
137 |
} |
} |
138 |
$row++; |
$row++; |
139 |
|
|
140 |
my @types = map { scalar $dbh->type_info($_)->{TYPE_NAME} } @{ $sth->{TYPE} }; |
my @types = map { $dbh->type_info($_) ? $dbh->type_info($_)->{TYPE_NAME} : '?' } @{ $sth->{TYPE} }; |
141 |
|
|
142 |
while (my @row = $sth->fetchrow_array() ) { |
while (my @row = $sth->fetchrow_array() ) { |
143 |
for(my $col=0; $col<=$#row; $col++) { |
for(my $col=0; $col<=$#row; $col++) { |