1 |
dpavlin |
33 |
#!/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 |
dpavlin |
34 |
use Data::Dump qw/dump/; |
13 |
dpavlin |
33 |
|
14 |
|
|
my $dsn = 'DBI:Pg:dbname=new'; |
15 |
dpavlin |
34 |
my $debug = 0; |
16 |
dpavlin |
33 |
|
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 |
dpavlin |
34 |
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 |
dpavlin |
33 |
|
43 |
dpavlin |
34 |
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 |
dpavlin |
33 |
while ( my $row = $sth->fetchrow_hashref ) { |
57 |
dpavlin |
34 |
$row->{ $rename_cols->{ $_ } } = delete $row->{ $_ } foreach keys %$rename_cols; |
58 |
|
|
push @{ $json->{items} }, $row; |
59 |
dpavlin |
33 |
} |
60 |
|
|
|
61 |
dpavlin |
34 |
print to_json( $json ); |
62 |
|
|
# we have to call dump *AFTER* to_json because it screws types |
63 |
|
|
warn "# json = ",dump( $json ) if $debug; |