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; |