File Coverage

blib/lib/ETL/Yertl/Command/ysql.pm
Criterion Covered Total %
statement 157 180 87.2
branch 71 88 80.6
condition 16 20 80.0
subroutine 12 12 100.0
pod 0 5 0.0
total 256 305 83.9


line stmt bran cond sub pod time code
1             package ETL::Yertl::Command::ysql;
2             our $VERSION = '0.035';
3             # ABSTRACT: Read and write documents with a SQL database
4              
5 1     1   6 use ETL::Yertl;
  1         2  
  1         11  
6 1     1   327 use ETL::Yertl::Util qw( load_module );
  1         2  
  1         44  
7 1     1   7 use Getopt::Long qw( GetOptionsFromArray :config pass_through );
  1         1  
  1         4  
8 1     1   396 use File::HomeDir;
  1         3928  
  1         52  
9 1     1   6 use Path::Tiny qw( tempfile );
  1         1  
  1         33  
10 1     1   472 use SQL::Abstract;
  1         8227  
  1         903  
11              
12             sub main {
13 39     39 0 109 my $class = shift;
14              
15 39         80 eval { require DBI; };
  39         286  
16 39 50       124 if ( $@ ) {
17 0         0 die "Can't load ysql: Can't load DBI. Make sure the DBI module is installed.\n";
18             }
19              
20 39         62 my %opt;
21 39 50       175 if ( ref $_[-1] eq 'HASH' ) {
22 39         67 %opt = %{ pop @_ };
  39         120  
23             }
24              
25 39         120 my @args = @_;
26 39         168 GetOptionsFromArray( \@args, \%opt,
27             'config',
28             'drivers',
29             'driver|t=s',
30             'database|db=s',
31             'host|h=s',
32             'port|p=s',
33             'user|u=s',
34             'password|pass=s',
35             'save=s',
36             'edit|e=s',
37             'select=s',
38             'count=s',
39             'insert=s',
40             'delete=s',
41             'where=s',
42             'order|order-by|sort=s',
43             );
44             #; use Data::Dumper;
45             #; say Dumper \@args;
46             #; say Dumper \%opt;
47              
48 39         47025 my $out_fmt = load_module( format => 'default' )->new;
49              
50 39 100       190 if ( $opt{config} ) {
    100          
51 16         50 my $db_key = shift @args;
52              
53 16 100       47 if ( !$db_key ) {
54 1         3 my $out_fmt = load_module( format => 'yaml' )->new;
55 1         4 print $out_fmt->write( config() );
56 1         10 return 0;
57             }
58              
59             # Get the existing config first
60 15         49 my $db_conf = db_config( $db_key );
61              
62 15 100 100     91 if ( !@args && !grep { defined } @opt{qw( dsn driver database host port user password )} ) {
  70         137  
63 3 100       19 die "Database key '$db_key' does not exist" unless keys %$db_conf;
64 2         8 my $out_fmt = load_module( format => 'yaml' )->new;
65 2         8 print $out_fmt->write( $db_conf );
66 2         17 return 0;
67             }
68              
69             #; use Data::Dumper;
70             #; say "Got from options: " . Dumper $db_conf;
71             #; say "Left in \@args: " . Dumper \@args;
72              
73 12         41 for my $key ( qw{ driver database host port user password } ) {
74 72 100       177 next if !$opt{ $key };
75 17         41 $db_conf->{ $key } = $opt{ $key };
76             }
77              
78             # Set via DSN
79 12 100 100     68 if ( my $dsn = $opt{dsn} || shift( @args ) ) {
80 7         37 delete $db_conf->{ $_ } for qw( driver database host port );
81 7         75 my ( undef, $driver, undef, undef, $driver_dsn ) = DBI->parse_dsn( $dsn );
82 7         211 $db_conf->{ driver } = $driver;
83              
84             # The driver_dsn part is up to the driver, but we can make some guesses
85 7 100       49 if ( $driver_dsn !~ /[=:;@]/ ) {
    50          
    50          
86 5         17 $db_conf->{ database } = $driver_dsn;
87             }
88             elsif ( $driver_dsn =~ /^(\w+)\@([\w.]+)(?:\:(\d+))?$/ ) {
89 0         0 $db_conf->{ database } = $1;
90 0         0 $db_conf->{ host } = $2;
91 0         0 $db_conf->{ port } = $3;
92             }
93             elsif ( my @parts = split /\;/, $driver_dsn ) {
94 2         8 for my $part ( @parts ) {
95 5         23 my ( $part_key, $part_value ) = split /=/, $part;
96 5 50       16 if ( $part_key eq 'dbname' ) {
97 0         0 $part_key = 'database';
98             }
99 5         18 $db_conf->{ $part_key } = $part_value;
100             }
101             }
102             else {
103 0         0 die "Unknown driver DSN: $driver_dsn";
104             }
105             }
106              
107             # Check if the driver is installed
108 12         33 my $driver = $db_conf->{driver};
109 12 100       83 if ( !grep { /^$driver$/ } DBI->available_drivers ) {
  84         3949  
110 6         39 my @possible = grep { /^$driver$/i } DBI->available_drivers;
  42         1633  
111 6 100       31 my $suggest = @possible ? " Did you mean: $possible[0]" : '';
112 6         353 warn "Driver '$driver' does not exist." . $suggest . "\n";
113             }
114              
115             # Write back the config
116 12         56 db_config( $db_key => $db_conf );
117              
118             }
119             elsif ( $opt{drivers} ) {
120 1         9 my $ignore = join "|", qw( ExampleP Sponge File );
121 1         19 say join "\n", grep { !/^(?:$ignore)$/ } DBI->available_drivers;
  7         623  
122              
123             }
124             else {
125 22 50       74 if ( $opt{ edit } ) {
126 0         0 my $db_key = shift @args;
127 0         0 my $db_conf = db_config( $db_key );
128 0         0 my $query = $db_conf->{query}{ $opt{edit} };
129 0         0 my $tmp = tempfile;
130 0         0 $tmp->spew( $query );
131 0         0 system $ENV{EDITOR}, "$tmp";
132 0         0 $db_conf->{query}{ $opt{edit} } = $tmp->slurp;
133 0         0 db_config( $db_key => $db_conf );
134 0         0 return 0;
135             }
136              
137 22 100       75 if ( $opt{ save } ) {
138 2         7 my $db_key = shift @args;
139 2         10 my $db_conf = db_config( $db_key );
140 2         8 $db_conf->{query}{ $opt{save} } = shift @args;
141 2         7 db_config( $db_key => $db_conf );
142 2         15 return 0;
143             }
144              
145 20 100       62 my $db_key = !$opt{dsn} ? shift @args : undef;
146 20 100 100     65 if ( !$db_key && !$opt{dsn} ) {
147 1         10 die "Must specify a database!\n";
148             }
149              
150 19 100       99 my @dbi_args = $opt{dsn} ? ( $opt{dsn}, undef, undef ) : dbi_args( $db_key );
151 19 50       79 if ( !@dbi_args ) {
152 0         0 die "Unknown database '$db_key'\n";
153             }
154              
155 19         187 my $dbh = DBI->connect( @dbi_args, { PrintError => 0 } );
156 19 100       7531 if ( !$dbh ) {
157 1     1   9 no warnings 'once';
  1         4  
  1         1270  
158 1 50       17 die sprintf qq{Could not connect to database "\%s"\%s: \%s\n},
159             $dbi_args[0],
160             $dbi_args[1] ? qq{ (user: "$dbi_args[1]")} : '',
161             $DBI::errstr;
162             }
163              
164 18         144 my $sql = SQL::Abstract->new;
165              
166             # Insert helper requires special handling, as the query may change
167             # with every document inserted.
168 18 100       993 if ( $opt{insert} ) {
169 2 50 33     30 if ( !-t *STDIN && !-z *STDIN ) {
170 2         8 my $in_fmt = load_module( format => 'default' )->new( input => \*STDIN );
171              
172 2         7 my $query;
173             my @bind_args;
174 2         0 my $sth;
175 2         8 for my $doc ( $in_fmt->read ) {
176 3 100       16 if ( grep { ref } values %$doc ) {
  9         24  
177 1         9 die q{Can't insert complex data structures using '--insert'. Please use SQL with '$' placeholders instead}."\n";
178             }
179              
180 2         14 my ( $new_query, @bind_args ) = $sql->insert( $opt{insert}, $doc );
181 2 100 66     783 if ( !$query || $new_query ne $query ) {
182 1         2 $query = $new_query;
183 1 50       8 $sth = $dbh->prepare( $query )
184             or die "SQL error in prepare: " . $dbh->errstr . "\n";
185             }
186              
187 2 50       15194 $sth->execute( @bind_args )
188             or die "SQL error in execute: " . $dbh->errstr . "\n";
189 2         94 while ( my $doc = $sth->fetchrow_hashref ) {
190 0         0 print $out_fmt->write( $doc );
191             }
192             }
193              
194             }
195             else {
196 0         0 my ( $query, @bind_args ) = $sql->insert( $opt{insert}, \@args );
197 0 0       0 my $sth = $dbh->prepare( $query )
198             or die "SQL error in prepare: " . $dbh->errstr . "\n";
199              
200 0 0       0 $sth->execute( @bind_args )
201             or die "SQL error in execute: " . $dbh->errstr . "\n";
202 0         0 while ( my $doc = $sth->fetchrow_hashref ) {
203 0         0 print $out_fmt->write( $doc );
204             }
205             }
206 1         14 return 0;
207             }
208              
209             # Other queries that do not require special handling
210 16         28 my $query;
211 16 100       74 if ( $opt{select} ) {
    100          
    100          
212 4         22 $query = $sql->select( $opt{select}, '*', $opt{where}, $opt{order} );
213             }
214             elsif ( $opt{count} ) {
215 2         10 $query = $sql->select( $opt{count}, 'COUNT(*) AS value', $opt{where} );
216             }
217             elsif ( $opt{delete} ) {
218 2         11 $query = $sql->delete( $opt{delete}, $opt{where} );
219             }
220             else {
221 8         21 $query = shift @args;
222              
223             # Check for saved query
224 8 100       27 if ( $db_key ) {
225 7         26 my $db_conf = db_config( $db_key );
226 7 100       35 if ( $db_conf->{query}{ $query } ) {
227 2         6 $query = $db_conf->{query}{ $query };
228             }
229             }
230             }
231              
232             # Resolve interpolations with placeholders
233 16         1464 my @fields = $query =~ m/\$(\.[.\w]+)/g;
234 16         53 $query =~ s/\$\.[\w.]+/?/g;
235              
236 16 100       114 my $sth = $dbh->prepare( $query )
237             or die "SQL error in prepare: " . $dbh->errstr . "\n";
238              
239 14 100 66     4117 if ( !-t *STDIN && !-z *STDIN ) {
240 2         12 my $in_fmt = load_module( format => 'default' )->new( input => \*STDIN );
241              
242 2         9 for my $doc ( $in_fmt->read ) {
243 4 50       19 $sth->execute( map { select_doc( $_, $doc ) } @fields )
  12         35  
244             or die "SQL error in execute: " . $dbh->errstr . "\n";
245 4         143 while ( my $doc = $sth->fetchrow_hashref ) {
246 0         0 print $out_fmt->write( $doc );
247             }
248             }
249              
250             }
251             else {
252 12 100       16595 $sth->execute( @args )
253             or die "SQL error in execute: " . $dbh->errstr . "\n";
254 11         340 while ( my $doc = $sth->fetchrow_hashref ) {
255 14         68 print $out_fmt->write( $doc );
256             }
257             }
258              
259 13         264 return 0;
260             }
261             }
262              
263             sub config {
264 39     39 0 224 my $conf_file = path( File::HomeDir->my_home, '.yertl', 'ysql.yml' );
265 39         2579 my $config = {};
266 39 100       147 if ( $conf_file->exists ) {
267 33         399 my $yaml = load_module( format => 'yaml' )->new( input => $conf_file->openr );
268 33         130 ( $config ) = $yaml->read;
269             }
270 39         334 return $config;
271             }
272              
273             sub db_config {
274 38     38 0 102 my ( $db_key, $config ) = @_;
275 38 100       99 if ( $config ) {
276 14         115 my $conf_file = path( File::HomeDir->my_home, '.yertl', 'ysql.yml' );
277 14 100       891 if ( !$conf_file->exists ) {
278 6         78 $conf_file->touchpath;
279             }
280 14         2612 my $all_config = config();
281 14         53 $all_config->{ $db_key } = $config;
282 14         48 my $yaml = load_module( format => 'yaml' )->new;
283 14         54 $conf_file->spew( $yaml->write( $all_config ) );
284 14         6036 return;
285             }
286 24   100     89 return config()->{ $db_key } || {};
287             }
288              
289             sub select_doc {
290 12     12 0 31 my ( $select, $doc ) = @_;
291 12         57 $select =~ s/^[.]//; # select must start with .
292 12         41 my @parts = split /[.]/, $select;
293 12         25 for my $part ( @parts ) {
294 14         40 $doc = $doc->{ $part };
295             }
296 12         34645 return $doc;
297             }
298              
299             sub dbi_args {
300 17     17 0 54 my ( $db_name ) = @_;
301 17         122 my $conf_file = path( File::HomeDir->my_home, '.yertl', 'ysql.yml' );
302 17 50       1365 if ( $conf_file->exists ) {
303 17         246 my $yaml = load_module( format => 'yaml' )->new( input => $conf_file->openr );
304 17         88 my ( $config ) = $yaml->read;
305 17         62 my $db_config = $config->{ $db_name };
306              
307             my $driver_dsn =
308             join ";",
309 17         81 map { join "=", $_, $db_config->{ $_ } }
310 17         51 grep { $db_config->{ $_ } }
  51         111  
311             qw( database host port )
312             ;
313              
314             return (
315             sprintf( 'dbi:%s:%s', $db_config->{driver}, $driver_dsn ),
316             $db_config->{user},
317             $db_config->{password},
318 17         321 );
319             }
320             }
321              
322             1;
323              
324             __END__