1 |
#!/usr/bin/perl |
2 |
|
3 |
use warnings; |
4 |
use strict; |
5 |
|
6 |
# sql.pl - covert SQL files to json |
7 |
# |
8 |
# 10/25/08 00:06:01 CEST Dobrica Pavlinusic <dpavlin@rot13.org> |
9 |
|
10 |
use DBI; |
11 |
use JSON; |
12 |
use Data::Dump qw/dump/; |
13 |
|
14 |
my $dsn = 'DBI:Pg:dbname=new'; |
15 |
my $debug = 0; |
16 |
|
17 |
my $comment; |
18 |
my $sql; |
19 |
|
20 |
while(<>) { |
21 |
if (/^\\c\s*(.+)/ ) { |
22 |
my $database = $1; |
23 |
$dsn =~ s/=.*$/=$database/; |
24 |
} elsif ( /^--(.+)/ ) { |
25 |
$comment .= "$1\n"; |
26 |
} else { |
27 |
$sql .= $_; |
28 |
} |
29 |
} |
30 |
|
31 |
warn "# dsn = $dsn"; |
32 |
my $dbh = DBI->connect( $dsn, '', '', { RaiseError => 1 } ) || die $DBI::errstr; |
33 |
$dbh->do( qq{ set client_encoding='utf-8' } ); |
34 |
|
35 |
warn "# sql $sql"; |
36 |
my $sth = $dbh->prepare( $sql ); |
37 |
$sth->execute(); |
38 |
|
39 |
my $json; |
40 |
# I would love to use $sth->{TYPE} to get types from database, but it's just |
41 |
# not verbose enough to be useful for us, so we are using _n suffix |
42 |
|
43 |
my $rename_cols; |
44 |
|
45 |
foreach my $col ( @{ $sth->{NAME} } ) { |
46 |
warn "## check type of $col" if $debug; |
47 |
my $old_name = $col; |
48 |
if ( $col =~ s/_valueType_(\w+)//i ) { |
49 |
$json->{properties}->{$col} = { valueType => $1 }; |
50 |
$rename_cols->{ $old_name } = $col; |
51 |
} |
52 |
} |
53 |
|
54 |
warn "## rename_cols ", dump( $rename_cols ); |
55 |
|
56 |
while ( my $row = $sth->fetchrow_hashref ) { |
57 |
$row->{ $rename_cols->{ $_ } } = delete $row->{ $_ } foreach keys %$rename_cols; |
58 |
push @{ $json->{items} }, $row; |
59 |
} |
60 |
|
61 |
print to_json( $json ); |
62 |
# we have to call dump *AFTER* to_json because it screws types |
63 |
warn "# json = ",dump( $json ) if $debug; |