File Coverage

blib/lib/App/RecordStream/Operation/todb.pm
Criterion Covered Total %
statement 16 16 100.0
branch n/a
condition n/a
subroutine 6 6 100.0
pod n/a
total 22 22 100.0


line stmt bran cond sub pod time code
1             package App::RecordStream::Operation::todb;
2              
3             our $VERSION = "4.0.24";
4              
5 1     1   308 use strict;
  1         2  
  1         23  
6 1     1   5 use warnings;
  1         2  
  1         27  
7              
8 1     1   4 use base qw(App::RecordStream::Operation);
  1         2  
  1         55  
9              
10 1     1   5 use App::RecordStream::OptionalRequire 'DBI';
  1         2  
  1         7  
11 1     1   5 use App::RecordStream::OptionalRequire 'Tie::IxHash';
  1         2  
  1         4  
12 1     1   4 BEGIN { App::RecordStream::OptionalRequire::require_done() }
13              
14             use Data::Dumper;
15             use App::RecordStream::DBHandle;
16             use App::RecordStream::Record;
17              
18             sub init {
19             my $this = shift;
20             my $args = shift;
21              
22             my ($drop_table, $table_name, $debug);
23              
24             my %fields_hash;
25             tie %fields_hash, 'Tie::IxHash';
26              
27             my $fields = \%fields_hash;
28              
29             my $spec = {
30             'drop' => \$drop_table,
31             'table=s' => \$table_name,
32             'debug' => \$debug,
33             'key|k|fields|f=s' => sub { shift; add_field($fields, shift) },
34             };
35              
36             $this->parse_options($args, $spec, ['pass_through']);
37              
38             $table_name = 'recs' unless $table_name;
39              
40             $this->{'TABLE_NAME'} = $table_name;
41             $this->{'DEBUG'} = $debug;
42             $this->{'FIELDS'} = $fields;
43              
44             $this->{'DBH'} = App::RecordStream::DBHandle::get_dbh($args);
45              
46             if ( $drop_table ) {
47             my $dbh = $this->{'DBH'};
48             eval {
49             $this->dbh_do( "DROP TABLE ".$dbh->quote_identifier($table_name));
50             };
51             }
52              
53             $this->{'FIRST'} = 1;
54             }
55              
56              
57             sub accept_record {
58             my $this = shift;
59             my $record = shift;
60              
61             if ( $this->{'FIRST'} ) {
62             $this->add_fields($record);
63             $this->create_table();
64             $this->{'FIRST'} = 0;
65             }
66              
67             $this->add_row($record);
68              
69             return 1;
70             }
71              
72             sub add_fields {
73             my $this = shift;
74             my $record = shift;
75             my $fields = $this->{'FIELDS'};
76              
77             return if ( scalar keys %$fields > 0 );
78              
79             foreach my $key ( $record->keys() ) {
80             $fields->{$key} = 0;
81             }
82             }
83              
84             sub add_row {
85             my $this = shift;
86             my $record = shift;
87              
88             my $dbh = $this->{'DBH'};
89             my $name = $this->{'TABLE_NAME'};
90             my $fields = $this->{'FIELDS'};
91              
92             $name = $dbh->quote_identifier($name);
93              
94             my @keys = keys %$fields;
95              
96             my $columns_string = join(',', map {$dbh->quote_identifier($_);} @keys);
97              
98             my $values = '';
99              
100             foreach my $key (@keys) {
101             my $value = ${$record->guess_key_from_spec($key)};
102             $value = '' if !defined($value);
103             $value = substr($value, 0, 255) if ( ! $fields->{$key} );
104             $values .= $dbh->quote($value) . ",";
105             }
106              
107             chop $values;
108              
109             my $sql = "INSERT INTO $name ($columns_string) VALUES ($values)";
110             $this->dbh_do($sql);
111             }
112              
113             sub create_table {
114             my $this = shift;
115              
116             my $dbh = $this->{'DBH'};
117             my $name = $this->{'TABLE_NAME'};
118             my $fields = $this->{'FIELDS'};
119              
120             $name = $dbh->quote_identifier($name);
121              
122             my $increment_name = 'AUTO_INCREMENT';
123             my $db_type = $dbh->get_info( 17 ); # SQL_DBMS_NAME
124             $increment_name = 'AUTOINCREMENT' if ( $db_type eq 'SQLite' );
125              
126             my $sql = "CREATE TABLE $name ( id INTEGER PRIMARY KEY $increment_name, ";
127              
128             foreach my $name (keys %$fields) {
129             my $type = $fields->{$name} || 'VARCHAR(255)';
130             $name = $dbh->quote_identifier($name);
131             $sql .= " $name $type,";
132             }
133              
134             chop $sql;
135             $sql .= " )";
136              
137             eval {
138             $this->dbh_do($sql);
139             };
140             }
141              
142             sub add_help_types {
143             my $this = shift;
144             $this->use_help_type('keyspecs');
145             }
146              
147             sub usage {
148             my $this = shift;
149              
150             my $options = [
151             ['drop', 'Drop the table before running create / insert commands.'],
152             ['table', 'Name of the table to work with defaults to \'recs\''],
153             ['debug', 'Print all the executed SQL'],
154             ['key', 'Can either be a name value pair or just a name. Name value pairs should be fieldName=SQL Type. If any fields are specified, they will be the only fields put into the db. May be specified multiple times, may also be comma separated. Type defaults to VARCHAR(255) Keys may be key specs, see \'--help-keyspecs\' for more'],
155             ];
156              
157             my $args_string = $this->options_string($options);
158              
159             my $usage = <
160             __FORMAT_TEXT__
161             Recs to DB will dump a stream of input records into a database you specify.
162             The record fields you want inserted should have the same keys as the column
163             names in the database, and the records should be key-value pairs.
164              
165             This script will attempt to create the table, if it is not already present.
166             __FORMAT_TEXT__
167              
168             $args_string
169              
170             USAGE
171              
172             return $usage . App::RecordStream::DBHandle::usage() . <
173             Examples:
174             # Just put all the records into the recs table
175             recs-todb --type sqlite --dbfile testDb --table recs
176              
177             # Just put description, status, and user into the table, make the records
178             # the only thing in the DB
179             recs-todb --dbfile testDb --drop --key status,description=TEXT --key user
180             EXAMPLES
181             }
182              
183             sub add_field {
184             my $hash = shift;
185             my $arg = shift;
186              
187             my @specs;
188              
189             push @specs, split(',', $arg);
190              
191             foreach my $spec ( @specs ) {
192             my ($field,$sql_spec) = split('=', $spec);
193             $hash->{$field} = $sql_spec;
194             }
195             }
196              
197             sub dbh_do {
198             my $this = shift;
199             my $sql = shift;
200             my $dbh = $this->{'DBH'};
201              
202             if ( $this->{'DEBUG'} ) {
203             print "Running: $sql\n";
204             }
205              
206             $dbh->do($sql);
207             }
208              
209             1;