line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package DBIx::Raw; |
2
|
|
|
|
|
|
|
|
3
|
71
|
|
|
71
|
|
156831
|
use 5.008_005; |
|
71
|
|
|
|
|
276
|
|
4
|
|
|
|
|
|
|
our $VERSION = '0.21'; |
5
|
|
|
|
|
|
|
|
6
|
71
|
|
|
71
|
|
32184
|
use strictures 2; |
|
71
|
|
|
|
|
118757
|
|
|
71
|
|
|
|
|
2889
|
|
7
|
71
|
|
|
71
|
|
48880
|
use Moo; |
|
71
|
|
|
|
|
795684
|
|
|
71
|
|
|
|
|
417
|
|
8
|
71
|
|
|
71
|
|
142025
|
use Types::Standard qw/Bool HashRef InstanceOf Str/; |
|
71
|
|
|
|
|
5270906
|
|
|
71
|
|
|
|
|
814
|
|
9
|
71
|
|
|
71
|
|
193455
|
use DBI; |
|
71
|
|
|
|
|
1240450
|
|
|
71
|
|
|
|
|
5003
|
|
10
|
71
|
|
|
71
|
|
37191
|
use Config::Any; |
|
71
|
|
|
|
|
641177
|
|
|
71
|
|
|
|
|
2537
|
|
11
|
71
|
|
|
71
|
|
32868
|
use DBIx::Raw::Crypt; |
|
71
|
|
|
|
|
265
|
|
|
71
|
|
|
|
|
2249
|
|
12
|
71
|
|
|
71
|
|
589
|
use Carp; |
|
71
|
|
|
|
|
1109
|
|
|
71
|
|
|
|
|
4521
|
|
13
|
71
|
|
|
71
|
|
1018
|
use List::Util qw/first/; |
|
71
|
|
|
|
|
153
|
|
|
71
|
|
|
|
|
6360
|
|
14
|
71
|
|
|
71
|
|
32433
|
use Crypt::Mode::CBC::Easy; |
|
71
|
|
|
|
|
3397821
|
|
|
71
|
|
|
|
|
309483
|
|
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
#have an errors file to write to |
17
|
|
|
|
|
|
|
has 'dsn' => is => 'rw'; |
18
|
|
|
|
|
|
|
has 'user' => is => 'rw'; |
19
|
|
|
|
|
|
|
has 'password' => is => 'rw'; |
20
|
|
|
|
|
|
|
has 'conf' => is => 'rw'; |
21
|
|
|
|
|
|
|
has 'prev_conf' => ( |
22
|
|
|
|
|
|
|
is => 'rw', |
23
|
|
|
|
|
|
|
isa => Str, |
24
|
|
|
|
|
|
|
default => '', |
25
|
|
|
|
|
|
|
); |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
has 'crypt' => ( |
28
|
|
|
|
|
|
|
is => 'ro', |
29
|
|
|
|
|
|
|
isa => InstanceOf['Crypt::Mode::CBC::Easy'], |
30
|
|
|
|
|
|
|
lazy => 1, |
31
|
|
|
|
|
|
|
builder => sub { |
32
|
26
|
|
|
26
|
|
674
|
my ($self) = @_; |
33
|
26
|
|
|
|
|
717
|
return Crypt::Mode::CBC::Easy->new(key => $self->crypt_key); |
34
|
|
|
|
|
|
|
}, |
35
|
|
|
|
|
|
|
); |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
has 'crypt_key' => ( |
38
|
|
|
|
|
|
|
is => 'rw', |
39
|
|
|
|
|
|
|
isa => Str, |
40
|
|
|
|
|
|
|
lazy => 1, |
41
|
|
|
|
|
|
|
builder => sub { |
42
|
26
|
|
|
26
|
|
699
|
my $crypt_key_hex = 'aea77496999d37bf47aedff9c0d44fdf2d2bbfa848ee6652abe9891b43e0f331'; |
43
|
26
|
|
|
|
|
904
|
return pack "H*", $crypt_key_hex; |
44
|
|
|
|
|
|
|
}, |
45
|
|
|
|
|
|
|
); |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
has use_old_crypt => ( |
48
|
|
|
|
|
|
|
is => 'rw', |
49
|
|
|
|
|
|
|
isa => Bool, |
50
|
|
|
|
|
|
|
default => undef, |
51
|
|
|
|
|
|
|
); |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
has 'old_crypt_key' => ( |
54
|
|
|
|
|
|
|
is => 'rw', |
55
|
|
|
|
|
|
|
isa => Str, |
56
|
|
|
|
|
|
|
lazy => 1, |
57
|
|
|
|
|
|
|
default => '6883868834006296591264051568595813693328016796531185824375212916576042669669556288781800326542091901603033335703884439231366552922364658270813734165084102xfasdfa8823423sfasdfalkj!@#$$CCCFFF!09xxxxlai3847lol13234408!!@#$_+-083dxje380-=0' |
58
|
|
|
|
|
|
|
); |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
has 'old_crypt' => ( |
61
|
|
|
|
|
|
|
is => 'ro', |
62
|
|
|
|
|
|
|
isa => InstanceOf['DBIx::Raw::Crypt'], |
63
|
|
|
|
|
|
|
lazy => 1, |
64
|
|
|
|
|
|
|
builder => sub { |
65
|
0
|
|
|
0
|
|
0
|
my ($self) = @_; |
66
|
0
|
|
|
|
|
0
|
return DBIx::Raw::Crypt->new( { secret => $self->old_crypt_key }); |
67
|
|
|
|
|
|
|
}, |
68
|
|
|
|
|
|
|
); |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
# LAST STH USED |
71
|
|
|
|
|
|
|
has 'sth' => is => 'rw'; |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
#find out what DBH is specifically |
74
|
|
|
|
|
|
|
has 'dbh' => ( |
75
|
|
|
|
|
|
|
is => 'rw', |
76
|
|
|
|
|
|
|
lazy => 1, |
77
|
|
|
|
|
|
|
default => sub { shift->connect } |
78
|
|
|
|
|
|
|
); |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
has 'keys' => ( |
81
|
|
|
|
|
|
|
is => 'ro', |
82
|
|
|
|
|
|
|
isa => HashRef[Str], |
83
|
|
|
|
|
|
|
default => sub { { |
84
|
|
|
|
|
|
|
query => 1, |
85
|
|
|
|
|
|
|
vals => 1, |
86
|
|
|
|
|
|
|
encrypt => 1, |
87
|
|
|
|
|
|
|
decrypt => 1, |
88
|
|
|
|
|
|
|
key => 1, |
89
|
|
|
|
|
|
|
href => 1, |
90
|
|
|
|
|
|
|
table => 1, |
91
|
|
|
|
|
|
|
where => 1, |
92
|
|
|
|
|
|
|
pk => 1, |
93
|
|
|
|
|
|
|
rows => 1, |
94
|
|
|
|
|
|
|
id => 1, |
95
|
|
|
|
|
|
|
} }, |
96
|
|
|
|
|
|
|
); |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
sub BUILD { |
99
|
70
|
|
|
70
|
0
|
10088
|
my ($self) = @_; |
100
|
70
|
|
|
|
|
4209
|
$self->_parse_conf; |
101
|
70
|
|
|
|
|
6899
|
$self->_validate_connect_info; |
102
|
|
|
|
|
|
|
} |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
=head1 NAME |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
DBIx::Raw - Maintain control of SQL queries while still having a layer of abstraction above DBI |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
=head1 SYNOPSIS |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
DBIx::Raw allows you to have complete control over your SQL, while still providing useful functionality so you don't have to deal directly with L. |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
use DBIx::Raw; |
113
|
|
|
|
|
|
|
my $db = DBIx::Raw->new(dsn => $dsn, user => $user, password => $password); |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
#alternatively, use a conf file |
116
|
|
|
|
|
|
|
my $db = DBIx::Raw->new(conf => '/path/to/conf.pl'); |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
#get single values in scalar context |
119
|
|
|
|
|
|
|
my $name = $db->raw("SELECT name FROM people WHERE id=1"); |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
#get multiple values in list context |
122
|
|
|
|
|
|
|
my ($name, $age) = $db->raw("SELECT name, age FROM people WHERE id=1"); |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
#or |
125
|
|
|
|
|
|
|
my @person = $db->raw("SELECT name, age FROM people WHERE id=1"); |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
#get hash when using scalar context but requesting multiple values |
128
|
|
|
|
|
|
|
my $person = $db->raw("SELECT name, age FROM people where id=1"); |
129
|
|
|
|
|
|
|
my $name = $person->{name}; |
130
|
|
|
|
|
|
|
my $age = $person->{age}; |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
#also get hash in scalar context when selecting multiple values using '*' |
133
|
|
|
|
|
|
|
my $person = $db->raw("SELECT * FROM people where id=1"); |
134
|
|
|
|
|
|
|
my $name = $person->{name}; |
135
|
|
|
|
|
|
|
my $age = $person->{age}; |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
#insert a record |
138
|
|
|
|
|
|
|
$db->raw("INSERT INTO people (name, age) VALUES ('Sally', 26)"); |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
#insert a record with bind values to help prevent SQL injection |
141
|
|
|
|
|
|
|
$db->raw("INSERT INTO people (name, age) VALUES (?, ?)", 'Sally', 26); |
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
#update records |
144
|
|
|
|
|
|
|
my $num_rows_updated = $db->raw("UPDATE people SET name='Joe',age=34 WHERE id=1"); |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
#use bind values to help prevent SQL injection |
147
|
|
|
|
|
|
|
my $num_rows_updated = $db->raw("UPDATE people SET name=?,age=? WHERE id=?", 'Joe', 34, 1); |
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
#also use bind values when selecting |
150
|
|
|
|
|
|
|
my $name = $db->raw("SELECT name FROM people WHERE id=?", 1); |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
#get multiple records as an array of hashes |
153
|
|
|
|
|
|
|
my $people = $db->aoh("SELECT name, age FROM people"); |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
for my $person (@$people) { |
156
|
|
|
|
|
|
|
print "$person->{name} is $person->{age} years old\n"; |
157
|
|
|
|
|
|
|
} |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
#update a record easily with a hash |
160
|
|
|
|
|
|
|
my %update = ( |
161
|
|
|
|
|
|
|
name => 'Joe', |
162
|
|
|
|
|
|
|
age => 34, |
163
|
|
|
|
|
|
|
); |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
#record with id=1 now has name=Joe an age=34 |
166
|
|
|
|
|
|
|
$db->update(href=>\%update, table => 'people', id=>1); |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
#use alternate syntax to encrypt and decrypt data |
169
|
|
|
|
|
|
|
my $num_rows_updated = $db->raw(query => "UPDATE people SET name=? WHERE id=1", vals => ['Joe'], encrypt => [0]); |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
my $decrypted_name = $db->raw(query => "SELECT name FROM people WHERE id=1", decrypt => [0]); |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
#when being returned a hash, use names of field for decryption |
174
|
|
|
|
|
|
|
my $decrypted_person = $db->raw(query => "SELECT name, age FROM people WHERE id=1", decrypt => ['name']); |
175
|
|
|
|
|
|
|
my $decrypted_name = $decrypted_person->{name}; |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
=head1 INITIALIZATION |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
There are three ways to intialize a L object: |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
=head2 dsn, user, password |
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
You can initialize a L object by passing in the dsn, user, and password connection information. |
185
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
my $db = DBIx::Raw->new(dsn => 'dbi:mysql:test:localhost:3306', user => 'user', password => 'password'); |
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
=head2 dbh |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
You can also initialize a L object by passing in an existing database handle. |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
my $db = DBIx::Raw->new(dbh => $dbh); |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
=head2 conf |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
If you're going to using the same connection information a lot, it's useful to store it in a configuration file and then |
197
|
|
|
|
|
|
|
use that when creating a L object. |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
my $db = DBIx::Raw->new(conf => '/path/to/conf.pl'); |
200
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
See L for more information on how to set up a configuration file. |
202
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
=head1 CONFIGURATION FILE |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
You can use a configuration file to store settings for L instead of passing them into new or setting them. |
206
|
|
|
|
|
|
|
L uses L, so you can use any configuration format that is acceptable for L. Variables |
207
|
|
|
|
|
|
|
that you might want to store in your configuration file are C, C, C, and L. |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
Below is an example configuration file in perl format: |
210
|
|
|
|
|
|
|
|
211
|
|
|
|
|
|
|
=head2 conf.pl |
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
{ |
214
|
|
|
|
|
|
|
dsn => 'dbi:mysql:test:localhost:3306', |
215
|
|
|
|
|
|
|
user => 'root', |
216
|
|
|
|
|
|
|
password => 'password', |
217
|
|
|
|
|
|
|
crypt_key => 'lxsafadsfadskl23239210453453802xxx02-487900-=+1!:)', |
218
|
|
|
|
|
|
|
} |
219
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
=head2 conf.yaml |
221
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
--- |
223
|
|
|
|
|
|
|
dsn: 'dbi:mysql:test:localhost:3306' |
224
|
|
|
|
|
|
|
user: 'root' |
225
|
|
|
|
|
|
|
password: 'password' |
226
|
|
|
|
|
|
|
crypt_key: 'lxsafadsfadskl23239210453453802xxx02-487900-=+1!:)' |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
Note that you do not need to include L if you just if you just want to use the file for configuration settings. |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
=head1 SYNTAXES |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
DBIx::Raw provides two different possible syntaxes when making queries. |
233
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
=head2 SIMPLE SYNTAX |
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
Simple syntax is an easy way to write queries. It is always in the format: |
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
("QUERY"); |
239
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
or |
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
("QUERY", "VAL1", "VAL2", ...); |
243
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
Below are some examples: |
245
|
|
|
|
|
|
|
|
246
|
|
|
|
|
|
|
my $num_rows_updated = $db->raw("UPDATE people SET name='Fred'"); |
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
my $name = $db->raw("SELECT name FROM people WHERE id=1"); |
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
DBIx::Raw also supports L for L. These can be useful to help prevent SQL injection. Below are |
251
|
|
|
|
|
|
|
some examples of how to use placeholders and bind values with L"SIMPLE SYNTAX">. |
252
|
|
|
|
|
|
|
|
253
|
|
|
|
|
|
|
my $num_rows_updated = $db->raw("UPDATE people SET name=?", 'Fred'); |
254
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
my $name = $db->raw("SELECT name FROM people WHERE id=?", 1); |
256
|
|
|
|
|
|
|
|
257
|
|
|
|
|
|
|
$db->raw("INSERT INTO people (name, age) VALUES (?, ?)", 'Frank', 44); |
258
|
|
|
|
|
|
|
|
259
|
|
|
|
|
|
|
Note that L"SIMPLE SYNTAX"> cannot be used for L, L, L, or L because of the extra parameters that they require. |
260
|
|
|
|
|
|
|
|
261
|
|
|
|
|
|
|
=head2 ADVANCED SYNTAX |
262
|
|
|
|
|
|
|
|
263
|
|
|
|
|
|
|
Advanced syntax is used whenever a subroutine requires extra parameters besides just the query and bind values, or whenever you need to use L |
264
|
|
|
|
|
|
|
or L. A simple example of the advanced syntax is: |
265
|
|
|
|
|
|
|
|
266
|
|
|
|
|
|
|
my $num_rows_updated = $db->raw(query => "UPDATE people SET name='Fred'"); |
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
This is equivalent to: |
269
|
|
|
|
|
|
|
|
270
|
|
|
|
|
|
|
my $num_rows_updated = $db->raw("UPDATE people SET name='Fred'"); |
271
|
|
|
|
|
|
|
|
272
|
|
|
|
|
|
|
A slightly more complex example adds in bind values: |
273
|
|
|
|
|
|
|
|
274
|
|
|
|
|
|
|
my $num_rows_updated = $db->raw(query => "UPDATE people SET name=?", vals => ['Fred']); |
275
|
|
|
|
|
|
|
|
276
|
|
|
|
|
|
|
This is equivalent to the simple syntax: |
277
|
|
|
|
|
|
|
|
278
|
|
|
|
|
|
|
my $num_rows_updated = $db->raw("UPDATE people SET name=?", 'Fred'); |
279
|
|
|
|
|
|
|
|
280
|
|
|
|
|
|
|
Also, advanced syntax is required whenevery you want to L or L values. |
281
|
|
|
|
|
|
|
|
282
|
|
|
|
|
|
|
my $num_rows_updated = $db->raw(query => "UPDATE people SET name=?", vals => ['Fred'], encrypt => [0]); |
283
|
|
|
|
|
|
|
|
284
|
|
|
|
|
|
|
my $decrypted_name = $db->raw(query => "SELECT name FROM people WHERE id=1", decrypt => [0]); |
285
|
|
|
|
|
|
|
|
286
|
|
|
|
|
|
|
Note that L"ADVANCED SYNTAX"> is required for L, L, L, or L because of the extra parameters that they require. |
287
|
|
|
|
|
|
|
|
288
|
|
|
|
|
|
|
=head1 ENCRYPT AND DECRYPT |
289
|
|
|
|
|
|
|
|
290
|
|
|
|
|
|
|
You can use L to encrypt values when putting them into the database and decrypt values when removing them from the database. |
291
|
|
|
|
|
|
|
Note that in order to store an encrypted value in the database, you should have the field be of type C or some type of character |
292
|
|
|
|
|
|
|
or text field where the encryption will fit. In order to encrypt and decrypt your values, L requires a L. It contains a default |
293
|
|
|
|
|
|
|
key, but it is recommended that you change it either by having a different one in your L file, or passing it in on creation with C or setting it using the |
294
|
|
|
|
|
|
|
L method. It is recommended that you use a module like L to generate a secure key. |
295
|
|
|
|
|
|
|
One thing to note is that both L and L require L"ADVANCED SYNTAX">. |
296
|
|
|
|
|
|
|
|
297
|
|
|
|
|
|
|
=head2 encrypt |
298
|
|
|
|
|
|
|
|
299
|
|
|
|
|
|
|
In order to encrypt values, the values that you want to encrypt must be in the bind values array reference that you pass into C. Note that for the values that you want to |
300
|
|
|
|
|
|
|
encrypt, you should put their index into the encrypt array that you pass in. For example: |
301
|
|
|
|
|
|
|
|
302
|
|
|
|
|
|
|
my $num_rows_updated = $db->raw(query => "UPDATE people SET name=?,age=?,height=? WHERE id=1", vals => ['Zoe', 24, "5'11"], encrypt => [0, 2]); |
303
|
|
|
|
|
|
|
|
304
|
|
|
|
|
|
|
In the above example, only C and C will be encrypted. You can easily encrypt all values by using '*', like so: |
305
|
|
|
|
|
|
|
|
306
|
|
|
|
|
|
|
my $num_rows_updated = $db->raw(query => "UPDATE people SET name=?,height=? WHERE id=1", vals => ['Zoe', "5'11"], encrypt => '*'); |
307
|
|
|
|
|
|
|
|
308
|
|
|
|
|
|
|
And this will encrypt both C and C. |
309
|
|
|
|
|
|
|
|
310
|
|
|
|
|
|
|
The only exception to the L syntax that is a little different is for L. See L"update encrypt"> for how to encrypt when using L. |
311
|
|
|
|
|
|
|
|
312
|
|
|
|
|
|
|
=head2 decrypt |
313
|
|
|
|
|
|
|
|
314
|
|
|
|
|
|
|
When decrypting values, there are two possible different syntaxes. |
315
|
|
|
|
|
|
|
|
316
|
|
|
|
|
|
|
=head3 DECRYPT LIST CONTEXT |
317
|
|
|
|
|
|
|
|
318
|
|
|
|
|
|
|
If your query is returning a single value or values in a list context, then the array reference that you pass in for decrypt will contain the indices for the |
319
|
|
|
|
|
|
|
order that the columns were listed in. For instance: |
320
|
|
|
|
|
|
|
|
321
|
|
|
|
|
|
|
my $name = $db->raw(query => "SELECT name FROM people WHERE id=1", decrypt => [0]); |
322
|
|
|
|
|
|
|
|
323
|
|
|
|
|
|
|
my ($name, $age) = $db->raw(query => "SELECT name, age FROM people WHERE id=1", decrypt => [0,1]); |
324
|
|
|
|
|
|
|
|
325
|
|
|
|
|
|
|
=head3 DECRYPT HASH CONTEXT |
326
|
|
|
|
|
|
|
|
327
|
|
|
|
|
|
|
When your query has L return your values in a hash context, then the columns that you want decrypted must be listed by name in the array reference: |
328
|
|
|
|
|
|
|
|
329
|
|
|
|
|
|
|
my $person = $db->raw(query => "SELECT name, age FROM people WHERE id=1", decrypt => ['name', 'age']) |
330
|
|
|
|
|
|
|
|
331
|
|
|
|
|
|
|
my $aoh = $db->aoh(query => "SELECT name, age FROM people", decrypt => ['name', 'age']); |
332
|
|
|
|
|
|
|
|
333
|
|
|
|
|
|
|
Note that for either L"LIST CONTEXT"> or L"HASH CONTEXT">, it is possible to use '*' to decrypt all columns: |
334
|
|
|
|
|
|
|
|
335
|
|
|
|
|
|
|
my ($name, $height) = $db->raw(query => "SELECT name, height FROM people WHERE id=1", decrypt => '*'); |
336
|
|
|
|
|
|
|
|
337
|
|
|
|
|
|
|
=head2 crypt_key |
338
|
|
|
|
|
|
|
|
339
|
|
|
|
|
|
|
L uses L"crypt_key"> to encrypt and decrypt all values. You can set the crypt key when you create your |
340
|
|
|
|
|
|
|
L object by passing it into L, providing it to L, |
341
|
|
|
|
|
|
|
or by setting it with its setter method: |
342
|
|
|
|
|
|
|
|
343
|
|
|
|
|
|
|
$db->crypt_key("1234"); |
344
|
|
|
|
|
|
|
|
345
|
|
|
|
|
|
|
It is strongly recommended that you do not use the default L"crypt_key">. The L should be the appropriate length |
346
|
|
|
|
|
|
|
for the L that is set. The default L uses L, which uses L, which |
347
|
|
|
|
|
|
|
allows key sizes of 128/192/256 bits. |
348
|
|
|
|
|
|
|
|
349
|
|
|
|
|
|
|
=head2 crypt |
350
|
|
|
|
|
|
|
|
351
|
|
|
|
|
|
|
The L object to use for encryption. Default is the default L object |
352
|
|
|
|
|
|
|
created with the key L. |
353
|
|
|
|
|
|
|
|
354
|
|
|
|
|
|
|
=head2 use_old_crypt |
355
|
|
|
|
|
|
|
|
356
|
|
|
|
|
|
|
In version 0.16 L started using L instead of L. Setting this to 1 uses the old encryption instead. |
357
|
|
|
|
|
|
|
Make sure to set L if you previously used L for encryption. |
358
|
|
|
|
|
|
|
|
359
|
|
|
|
|
|
|
=head2 old_crypt_key |
360
|
|
|
|
|
|
|
|
361
|
|
|
|
|
|
|
This sets the crypt key to use if L is set to true. Default is the previous crypt key. |
362
|
|
|
|
|
|
|
|
363
|
|
|
|
|
|
|
=head1 SUBROUTINES/METHODS |
364
|
|
|
|
|
|
|
|
365
|
|
|
|
|
|
|
=head2 raw |
366
|
|
|
|
|
|
|
|
367
|
|
|
|
|
|
|
L is a very versitile subroutine, and it can be called in three contexts. L should only be used to make a query that |
368
|
|
|
|
|
|
|
returns values for one record, or a query that returns no results (such as an INSERT query). If you need to have multiple |
369
|
|
|
|
|
|
|
results returned, see one of the subroutines below. |
370
|
|
|
|
|
|
|
|
371
|
|
|
|
|
|
|
=head3 SCALAR CONTEXT |
372
|
|
|
|
|
|
|
|
373
|
|
|
|
|
|
|
L can be called in a scalar context to only return one value, or in a undef context to return no value. Below are some examples. |
374
|
|
|
|
|
|
|
|
375
|
|
|
|
|
|
|
#select |
376
|
|
|
|
|
|
|
my $name = $db->raw("SELECT name FROM people WHERE id=1"); |
377
|
|
|
|
|
|
|
|
378
|
|
|
|
|
|
|
#update with number of rows updated returned |
379
|
|
|
|
|
|
|
my $num_rows_updated = $db->raw("UPDATE people SET name=? WHERE id=1", 'Frank'); |
380
|
|
|
|
|
|
|
|
381
|
|
|
|
|
|
|
#update in undef context, nothing returned. |
382
|
|
|
|
|
|
|
$db->raw("UPDATE people SET name=? WHERE id=1", 'Frank'); |
383
|
|
|
|
|
|
|
|
384
|
|
|
|
|
|
|
#insert |
385
|
|
|
|
|
|
|
$db->raw("INSERT INTO people (name, age) VALUES ('Jenny', 34)"); |
386
|
|
|
|
|
|
|
|
387
|
|
|
|
|
|
|
Note that to L for L"SCALAR CONTEXT"> for L, you would use L"DECRYPT LIST CONTEXT">. |
388
|
|
|
|
|
|
|
|
389
|
|
|
|
|
|
|
=head3 LIST CONTEXT |
390
|
|
|
|
|
|
|
|
391
|
|
|
|
|
|
|
L can also be called in a list context to return multiple columns for one row. |
392
|
|
|
|
|
|
|
|
393
|
|
|
|
|
|
|
my ($name, $age) = $db->raw("SELECT name, age FROM people WHERE id=1"); |
394
|
|
|
|
|
|
|
|
395
|
|
|
|
|
|
|
#or |
396
|
|
|
|
|
|
|
my @person = $db->raw("SELECT name, age FROM people WHERE id=1"); |
397
|
|
|
|
|
|
|
|
398
|
|
|
|
|
|
|
Note that to L for L"LIST CONTEXT"> for L, you would use L"DECRYPT LIST CONTEXT">. |
399
|
|
|
|
|
|
|
|
400
|
|
|
|
|
|
|
=head3 HASH CONTEXT |
401
|
|
|
|
|
|
|
|
402
|
|
|
|
|
|
|
L will return a hash if you are selecting more than one column for a single record. |
403
|
|
|
|
|
|
|
|
404
|
|
|
|
|
|
|
my $person = $db->raw("SELECT name, age FROM people WHERE id=1"); |
405
|
|
|
|
|
|
|
my $name = $person->{name}; |
406
|
|
|
|
|
|
|
my $age = $person->{age}; |
407
|
|
|
|
|
|
|
|
408
|
|
|
|
|
|
|
Note that L's L"HASH CONTEXT"> works when using * in your query. |
409
|
|
|
|
|
|
|
|
410
|
|
|
|
|
|
|
my $person = $db->raw("SELECT * FROM people WHERE id=1"); |
411
|
|
|
|
|
|
|
my $name = $person->{name}; |
412
|
|
|
|
|
|
|
my $age = $person->{age}; |
413
|
|
|
|
|
|
|
|
414
|
|
|
|
|
|
|
Note that to L for L"HASH CONTEXT"> for L, you would use L"DECRYPT HASH CONTEXT">. |
415
|
|
|
|
|
|
|
=cut |
416
|
|
|
|
|
|
|
|
417
|
|
|
|
|
|
|
sub raw { |
418
|
282
|
|
|
282
|
1
|
9867
|
my $self = shift; |
419
|
|
|
|
|
|
|
|
420
|
282
|
|
|
|
|
1904
|
my $params = $self->_params(@_); |
421
|
|
|
|
|
|
|
|
422
|
282
|
|
|
|
|
1046
|
my (@return_values, $return_type); |
423
|
282
|
50
|
|
|
|
8366
|
$self->sth($self->dbh->prepare($params->{query})) or $self->_perish($params); |
424
|
|
|
|
|
|
|
|
425
|
|
|
|
|
|
|
#if user asked for values to be encrypted |
426
|
282
|
100
|
|
|
|
1093472
|
if($params->{encrypt}) { |
427
|
157
|
|
|
|
|
898
|
$self->_crypt_encrypt($params); |
428
|
|
|
|
|
|
|
} |
429
|
|
|
|
|
|
|
|
430
|
282
|
|
|
|
|
1640
|
$self->_query($params); |
431
|
|
|
|
|
|
|
|
432
|
282
|
100
|
|
|
|
1600
|
if(not defined wantarray) { |
|
|
100
|
|
|
|
|
|
433
|
224
|
50
|
|
|
|
2130
|
$self->sth->finish or $self->_perish($params); |
434
|
224
|
|
|
|
|
2142
|
return; |
435
|
|
|
|
|
|
|
} |
436
|
|
|
|
|
|
|
elsif(wantarray) { |
437
|
11
|
|
|
|
|
45
|
$return_type = 'array'; |
438
|
|
|
|
|
|
|
} |
439
|
|
|
|
|
|
|
else { |
440
|
47
|
|
|
|
|
195
|
$return_type = 'scalar'; |
441
|
|
|
|
|
|
|
|
442
|
47
|
50
|
|
|
|
523
|
if($params->{query} =~ /SELECT\s+(.*?)\s+FROM/i) { |
443
|
47
|
|
|
|
|
217
|
my $match = $1; |
444
|
47
|
|
|
|
|
465
|
my $num_commas=()= $match =~ /,/g; |
445
|
47
|
|
|
|
|
266
|
my $num_stars=()= $match =~ /\*/g; |
446
|
|
|
|
|
|
|
|
447
|
47
|
100
|
100
|
|
|
340
|
if($num_commas > 0 or $num_stars > 0) { $return_type = 'hash' } |
|
37
|
|
|
|
|
118
|
|
448
|
|
|
|
|
|
|
} |
449
|
|
|
|
|
|
|
} |
450
|
|
|
|
|
|
|
|
451
|
58
|
50
|
33
|
|
|
991
|
if($params->{query} =~ /^(\n*?| *?|\r*?)UPDATE /si) { |
|
|
50
|
|
|
|
|
|
452
|
0
|
|
|
|
|
0
|
my $return_value = $self->sth->rows(); |
453
|
0
|
|
|
|
|
0
|
push @return_values, $return_value; |
454
|
|
|
|
|
|
|
} |
455
|
|
|
|
|
|
|
elsif(($params->{query} =~ /SELECT /sig) || ($params->{query} =~ /SHOW /sig)) { |
456
|
58
|
50
|
|
|
|
576
|
unless($params->{query} =~ /INSERT INTO (.*?)SELECT /sig) { |
457
|
58
|
100
|
|
|
|
261
|
if($return_type eq 'hash') { |
458
|
37
|
100
|
|
|
|
1546
|
return unless $params->{href} = $self->sth->fetchrow_hashref; #handles undef case |
459
|
|
|
|
|
|
|
|
460
|
36
|
100
|
|
|
|
285
|
if($params->{decrypt}) { |
461
|
8
|
|
|
|
|
42
|
$self->_crypt_decrypt($params); |
462
|
|
|
|
|
|
|
} |
463
|
|
|
|
|
|
|
|
464
|
36
|
|
|
|
|
732
|
push @return_values, $params->{href}; |
465
|
|
|
|
|
|
|
} |
466
|
|
|
|
|
|
|
else { |
467
|
21
|
100
|
|
|
|
598
|
return unless @return_values = $self->sth->fetchrow_array(); #handles undef cases |
468
|
|
|
|
|
|
|
|
469
|
19
|
100
|
|
|
|
131
|
if($params->{decrypt}) { |
470
|
5
|
|
|
|
|
23
|
$params->{return_values} = \@return_values; |
471
|
5
|
|
|
|
|
36
|
$self->_crypt_decrypt($params); |
472
|
|
|
|
|
|
|
} |
473
|
|
|
|
|
|
|
} |
474
|
|
|
|
|
|
|
} |
475
|
|
|
|
|
|
|
} |
476
|
|
|
|
|
|
|
|
477
|
55
|
50
|
|
|
|
1354
|
$self->sth->finish or $self->_perish($params); |
478
|
|
|
|
|
|
|
|
479
|
55
|
100
|
|
|
|
311
|
unless($return_type eq 'array') { |
480
|
45
|
|
|
|
|
357
|
return $return_values[0]; |
481
|
|
|
|
|
|
|
} |
482
|
|
|
|
|
|
|
else { |
483
|
10
|
|
|
|
|
85
|
return @return_values; |
484
|
|
|
|
|
|
|
} |
485
|
|
|
|
|
|
|
} |
486
|
|
|
|
|
|
|
|
487
|
|
|
|
|
|
|
=head2 aoh (array_of_hashes) |
488
|
|
|
|
|
|
|
|
489
|
|
|
|
|
|
|
L can be used to select multiple rows from the database. It returns an array reference of hashes, where each row is a hash in the array. |
490
|
|
|
|
|
|
|
|
491
|
|
|
|
|
|
|
my $people = $db->aoh("SELECT * FROM people"); |
492
|
|
|
|
|
|
|
|
493
|
|
|
|
|
|
|
for my $person (@$people) { |
494
|
|
|
|
|
|
|
print "$person->{name} is $person->{age} years old\n"; |
495
|
|
|
|
|
|
|
} |
496
|
|
|
|
|
|
|
|
497
|
|
|
|
|
|
|
Note that to L for L, you would use L"DECRYPT HASH CONTEXT">. |
498
|
|
|
|
|
|
|
=cut |
499
|
|
|
|
|
|
|
|
500
|
|
|
|
|
|
|
sub aoh { |
501
|
4
|
|
|
4
|
1
|
77
|
my $self = shift; |
502
|
4
|
|
|
|
|
20
|
my $params = $self->_params(@_); |
503
|
4
|
|
|
|
|
11
|
my ($href,@a); |
504
|
|
|
|
|
|
|
|
505
|
4
|
|
|
|
|
16
|
$self->_query($params); |
506
|
|
|
|
|
|
|
|
507
|
4
|
100
|
|
|
|
22
|
if($params->{decrypt}) { |
508
|
2
|
|
|
|
|
116
|
while($href=$self->sth->fetchrow_hashref){ |
509
|
4
|
|
|
|
|
24
|
$params->{href} = $href; |
510
|
4
|
|
|
|
|
19
|
$self->_crypt_decrypt($params); |
511
|
4
|
|
|
|
|
393
|
push @a, $href; |
512
|
|
|
|
|
|
|
} |
513
|
|
|
|
|
|
|
} |
514
|
|
|
|
|
|
|
else { |
515
|
2
|
|
|
|
|
131
|
while($href=$self->sth->fetchrow_hashref){ |
516
|
4
|
|
|
|
|
62
|
push @a, $href; |
517
|
|
|
|
|
|
|
} |
518
|
|
|
|
|
|
|
} |
519
|
|
|
|
|
|
|
|
520
|
4
|
|
|
|
|
44
|
return \@a; |
521
|
|
|
|
|
|
|
} |
522
|
|
|
|
|
|
|
|
523
|
|
|
|
|
|
|
=head2 aoa (array_of_arrays) |
524
|
|
|
|
|
|
|
|
525
|
|
|
|
|
|
|
L can be used to select multiple rows from the database. It returns an array reference of array references, where each row is an array within the array. |
526
|
|
|
|
|
|
|
|
527
|
|
|
|
|
|
|
my $people = $db->aoa("SELECT name,age FROM people"); |
528
|
|
|
|
|
|
|
|
529
|
|
|
|
|
|
|
for my $person (@$people) { |
530
|
|
|
|
|
|
|
my $name = $person->[0]; |
531
|
|
|
|
|
|
|
my $age = $person->[1]; |
532
|
|
|
|
|
|
|
print "$name is $age years old\n"; |
533
|
|
|
|
|
|
|
} |
534
|
|
|
|
|
|
|
|
535
|
|
|
|
|
|
|
Note that to L for L, you would use L"DECRYPT LIST CONTEXT">. |
536
|
|
|
|
|
|
|
=cut |
537
|
|
|
|
|
|
|
|
538
|
|
|
|
|
|
|
sub aoa { |
539
|
3
|
|
|
3
|
1
|
73
|
my $self = shift; |
540
|
3
|
|
|
|
|
26
|
my $params = $self->_params(@_); |
541
|
3
|
|
|
|
|
9
|
my (@return_values); |
542
|
|
|
|
|
|
|
|
543
|
3
|
|
|
|
|
18
|
$self->_query($params); |
544
|
|
|
|
|
|
|
|
545
|
3
|
100
|
|
|
|
18
|
if($params->{decrypt}) { |
546
|
1
|
|
|
|
|
33
|
while(my @a=$self->sth->fetchrow_array){ |
547
|
2
|
|
|
|
|
13
|
$params->{return_values} = \@a; |
548
|
2
|
|
|
|
|
10
|
$self->_crypt_decrypt($params); |
549
|
2
|
|
|
|
|
182
|
push @return_values, \@a; |
550
|
|
|
|
|
|
|
} |
551
|
|
|
|
|
|
|
} |
552
|
|
|
|
|
|
|
else { |
553
|
2
|
|
|
|
|
59
|
while(my @a=$self->sth->fetchrow_array){ |
554
|
4
|
|
|
|
|
50
|
push @return_values, \@a; |
555
|
|
|
|
|
|
|
} |
556
|
|
|
|
|
|
|
} |
557
|
|
|
|
|
|
|
|
558
|
3
|
|
|
|
|
30
|
return \@return_values; |
559
|
|
|
|
|
|
|
} |
560
|
|
|
|
|
|
|
|
561
|
|
|
|
|
|
|
|
562
|
|
|
|
|
|
|
|
563
|
|
|
|
|
|
|
=head2 hoh (hash_of_hashes) |
564
|
|
|
|
|
|
|
|
565
|
|
|
|
|
|
|
=over |
566
|
|
|
|
|
|
|
|
567
|
|
|
|
|
|
|
=item |
568
|
|
|
|
|
|
|
|
569
|
|
|
|
|
|
|
B - the query |
570
|
|
|
|
|
|
|
|
571
|
|
|
|
|
|
|
=item |
572
|
|
|
|
|
|
|
|
573
|
|
|
|
|
|
|
B - the name of the column that will serve as the key to access each row |
574
|
|
|
|
|
|
|
|
575
|
|
|
|
|
|
|
=item |
576
|
|
|
|
|
|
|
|
577
|
|
|
|
|
|
|
B - the hash reference that you would like to have the results added to |
578
|
|
|
|
|
|
|
|
579
|
|
|
|
|
|
|
=back |
580
|
|
|
|
|
|
|
|
581
|
|
|
|
|
|
|
L can be used when you want to be able to access an individual row behind a unique key, where each row is represented as a hash. For instance, |
582
|
|
|
|
|
|
|
this subroutine can be useful if you would like to be able to access rows by their id in the database. L returns a hash reference of hash references. |
583
|
|
|
|
|
|
|
|
584
|
|
|
|
|
|
|
my $people = $db->hoh(query => "SELECT id, name, age FROM people", key => "id"); |
585
|
|
|
|
|
|
|
|
586
|
|
|
|
|
|
|
for my $key(keys %$people) { |
587
|
|
|
|
|
|
|
my $person = $people->{$key}; |
588
|
|
|
|
|
|
|
print "$person->{name} is $person->{age} years old\n"; |
589
|
|
|
|
|
|
|
} |
590
|
|
|
|
|
|
|
|
591
|
|
|
|
|
|
|
#or |
592
|
|
|
|
|
|
|
while(my ($key, $person) = each %$people) { |
593
|
|
|
|
|
|
|
print "$person->{name} is $person->{age} years old\n"; |
594
|
|
|
|
|
|
|
} |
595
|
|
|
|
|
|
|
|
596
|
|
|
|
|
|
|
So if you wanted to access the person with an id of 1, you could do so like this: |
597
|
|
|
|
|
|
|
|
598
|
|
|
|
|
|
|
my $person1 = $people->{1}; |
599
|
|
|
|
|
|
|
my $person1_name = $person1->{name}; |
600
|
|
|
|
|
|
|
my $person1_age = $person1->{age}; |
601
|
|
|
|
|
|
|
|
602
|
|
|
|
|
|
|
Also, with L it is possible to add to a previous hash of hashes that you alread have by passing it in with the C key: |
603
|
|
|
|
|
|
|
|
604
|
|
|
|
|
|
|
#$people was previously retrieved, and results will now be added to $people |
605
|
|
|
|
|
|
|
$db->hoh(query => "SELECT id, name, age FROM people", key => "id", href => $people); |
606
|
|
|
|
|
|
|
|
607
|
|
|
|
|
|
|
Note that you must select whatever column you want to be the key. So if you want to use "id" as the key, then you must select id in your query. |
608
|
|
|
|
|
|
|
Also, keys must be unique or the records will overwrite one another. To retrieve multiple records and access them by the same key, see L<"hoaoh (hash_of_array_of_hashes)"/hoaoh>. |
609
|
|
|
|
|
|
|
To L for L, you would use L"DECRYPT HASH CONTEXT">. |
610
|
|
|
|
|
|
|
|
611
|
|
|
|
|
|
|
=cut |
612
|
|
|
|
|
|
|
|
613
|
|
|
|
|
|
|
sub hoh { |
614
|
3
|
|
|
3
|
1
|
106
|
my $self = shift; |
615
|
3
|
|
|
|
|
53
|
my $params = $self->_params(@_); |
616
|
3
|
|
|
|
|
14
|
my ($href); |
617
|
|
|
|
|
|
|
|
618
|
3
|
|
|
|
|
15
|
my $hoh = $params->{href}; #if hashref is passed in, it will just add to it |
619
|
|
|
|
|
|
|
|
620
|
3
|
|
|
|
|
17
|
$self->_query($params); |
621
|
|
|
|
|
|
|
|
622
|
3
|
100
|
|
|
|
15
|
if($params->{decrypt}) { |
623
|
1
|
|
|
|
|
59
|
while($href=$self->sth->fetchrow_hashref){ |
624
|
2
|
|
|
|
|
16
|
$params->{href} = $href; |
625
|
2
|
|
|
|
|
9
|
$self->_crypt_decrypt($params); |
626
|
2
|
|
|
|
|
216
|
$hoh->{$href->{$params->{key}}} = $href; |
627
|
|
|
|
|
|
|
} |
628
|
|
|
|
|
|
|
} |
629
|
|
|
|
|
|
|
else { |
630
|
2
|
|
|
|
|
117
|
while($href=$self->sth->fetchrow_hashref){ |
631
|
4
|
|
|
|
|
105
|
$hoh->{$href->{$params->{key}}} = $href; |
632
|
|
|
|
|
|
|
} |
633
|
|
|
|
|
|
|
} |
634
|
|
|
|
|
|
|
|
635
|
3
|
|
|
|
|
25
|
return $hoh; |
636
|
|
|
|
|
|
|
} |
637
|
|
|
|
|
|
|
|
638
|
|
|
|
|
|
|
=head2 hoa (hash_of_arrays) |
639
|
|
|
|
|
|
|
|
640
|
|
|
|
|
|
|
=over |
641
|
|
|
|
|
|
|
|
642
|
|
|
|
|
|
|
=item |
643
|
|
|
|
|
|
|
|
644
|
|
|
|
|
|
|
B - the query |
645
|
|
|
|
|
|
|
|
646
|
|
|
|
|
|
|
=item |
647
|
|
|
|
|
|
|
|
648
|
|
|
|
|
|
|
B - the name of the column that will serve as the key to store the values behind |
649
|
|
|
|
|
|
|
|
650
|
|
|
|
|
|
|
=item |
651
|
|
|
|
|
|
|
|
652
|
|
|
|
|
|
|
B - the name of the column whose values you want to be stored behind key |
653
|
|
|
|
|
|
|
|
654
|
|
|
|
|
|
|
=item |
655
|
|
|
|
|
|
|
|
656
|
|
|
|
|
|
|
B - the hash reference that you would like to have the results added to |
657
|
|
|
|
|
|
|
|
658
|
|
|
|
|
|
|
=back |
659
|
|
|
|
|
|
|
|
660
|
|
|
|
|
|
|
L is useful when you want to store a list of values for one column behind a key. For instance, |
661
|
|
|
|
|
|
|
say that you wanted the id's of all people who have the same name grouped together. You could perform that query like so: |
662
|
|
|
|
|
|
|
|
663
|
|
|
|
|
|
|
my $hoa = $db->hoa(query => "SELECT id, name FROM people", key => "name", val => "id"); |
664
|
|
|
|
|
|
|
|
665
|
|
|
|
|
|
|
for my $name (%$hoa) { |
666
|
|
|
|
|
|
|
my $ids = $hoa->{$name}; |
667
|
|
|
|
|
|
|
|
668
|
|
|
|
|
|
|
print "$name has ids "; |
669
|
|
|
|
|
|
|
for my $id (@$ids) { |
670
|
|
|
|
|
|
|
print " $id,"; |
671
|
|
|
|
|
|
|
} |
672
|
|
|
|
|
|
|
|
673
|
|
|
|
|
|
|
print "\n"; |
674
|
|
|
|
|
|
|
} |
675
|
|
|
|
|
|
|
|
676
|
|
|
|
|
|
|
Note that you must select whatever column you want to be the key. So if you want to use "name" as the key, then you must select name in your query. |
677
|
|
|
|
|
|
|
To L for L, you would use L"DECRYPT LIST CONTEXT">. |
678
|
|
|
|
|
|
|
|
679
|
|
|
|
|
|
|
=cut |
680
|
|
|
|
|
|
|
|
681
|
|
|
|
|
|
|
sub hoa { |
682
|
3
|
|
|
3
|
1
|
88
|
my $self = shift; |
683
|
3
|
|
|
|
|
17
|
my $params = $self->_params(@_); |
684
|
3
|
|
|
|
|
9
|
my ($href); |
685
|
|
|
|
|
|
|
|
686
|
3
|
50
|
33
|
|
|
56
|
croak "query, key, and val are required for hoa" unless $params->{query} and $params->{key} and $params->{val}; |
|
|
|
33
|
|
|
|
|
687
|
|
|
|
|
|
|
|
688
|
3
|
|
|
|
|
10
|
my $hash = $params->{href}; #if hash is passed in, it will just add to it |
689
|
|
|
|
|
|
|
|
690
|
3
|
|
|
|
|
16
|
$self->_query($params); |
691
|
|
|
|
|
|
|
|
692
|
3
|
100
|
|
|
|
16
|
if($params->{decrypt}) { |
693
|
1
|
|
|
|
|
67
|
while($href=$self->sth->fetchrow_hashref){ |
694
|
4
|
|
|
|
|
19
|
$params->{href} = $href; |
695
|
4
|
|
|
|
|
15
|
$self->_crypt_decrypt($params); |
696
|
4
|
|
|
|
|
395
|
push @{$hash->{$href->{$params->{key}}}}, $href->{$params->{val}}; |
|
4
|
|
|
|
|
127
|
|
697
|
|
|
|
|
|
|
} |
698
|
|
|
|
|
|
|
} |
699
|
|
|
|
|
|
|
else { |
700
|
2
|
|
|
|
|
119
|
while($href=$self->sth->fetchrow_hashref){ |
701
|
8
|
|
|
|
|
29
|
push @{$hash->{$href->{$params->{key}}}}, $href->{$params->{val}}; |
|
8
|
|
|
|
|
106
|
|
702
|
|
|
|
|
|
|
} |
703
|
|
|
|
|
|
|
} |
704
|
|
|
|
|
|
|
|
705
|
3
|
|
|
|
|
16
|
return $hash; |
706
|
|
|
|
|
|
|
} |
707
|
|
|
|
|
|
|
|
708
|
|
|
|
|
|
|
=head2 hoaoh (hash_of_array_of_hashes) |
709
|
|
|
|
|
|
|
|
710
|
|
|
|
|
|
|
=over |
711
|
|
|
|
|
|
|
|
712
|
|
|
|
|
|
|
=item |
713
|
|
|
|
|
|
|
|
714
|
|
|
|
|
|
|
B - the query |
715
|
|
|
|
|
|
|
|
716
|
|
|
|
|
|
|
=item |
717
|
|
|
|
|
|
|
|
718
|
|
|
|
|
|
|
B - the name of the column that will serve as the key to store the array of hashes behind |
719
|
|
|
|
|
|
|
|
720
|
|
|
|
|
|
|
=item |
721
|
|
|
|
|
|
|
|
722
|
|
|
|
|
|
|
B - the hash reference that you would like to have the results added to |
723
|
|
|
|
|
|
|
|
724
|
|
|
|
|
|
|
=back |
725
|
|
|
|
|
|
|
|
726
|
|
|
|
|
|
|
L can be used when you want to store multiple rows behind a key that they all have in common. For |
727
|
|
|
|
|
|
|
example, say that we wanted to have access to all rows for people that have the same name. That could be |
728
|
|
|
|
|
|
|
done like so: |
729
|
|
|
|
|
|
|
|
730
|
|
|
|
|
|
|
my $hoaoh = $db->hoaoh(query => "SELECT id, name, age FROM people", key => "name"); |
731
|
|
|
|
|
|
|
|
732
|
|
|
|
|
|
|
for my $name (keys %$hoaoh) { |
733
|
|
|
|
|
|
|
my $people = $hoaoh->{$name}; |
734
|
|
|
|
|
|
|
|
735
|
|
|
|
|
|
|
print "People named $name: "; |
736
|
|
|
|
|
|
|
for my $person (@$people) { |
737
|
|
|
|
|
|
|
print " $person->{name} is $person->{age} years old\n"; |
738
|
|
|
|
|
|
|
} |
739
|
|
|
|
|
|
|
|
740
|
|
|
|
|
|
|
print "\n"; |
741
|
|
|
|
|
|
|
} |
742
|
|
|
|
|
|
|
|
743
|
|
|
|
|
|
|
So to get the array of rows for all people named Fred, we could simply do: |
744
|
|
|
|
|
|
|
|
745
|
|
|
|
|
|
|
my @freds = $hoaoh->{Fred}; |
746
|
|
|
|
|
|
|
|
747
|
|
|
|
|
|
|
for my $fred (@freds) { ... } |
748
|
|
|
|
|
|
|
|
749
|
|
|
|
|
|
|
Note that you must select whatever column you want to be the key. So if you want to use "name" as the key, then you must select name in your query. |
750
|
|
|
|
|
|
|
To L for L, you would use L"DECRYPT HASH CONTEXT">. |
751
|
|
|
|
|
|
|
|
752
|
|
|
|
|
|
|
=cut |
753
|
|
|
|
|
|
|
|
754
|
|
|
|
|
|
|
sub hoaoh { |
755
|
3
|
|
|
3
|
1
|
78
|
my $self = shift; |
756
|
3
|
|
|
|
|
27
|
my $params = $self->_params(@_); |
757
|
3
|
|
|
|
|
7
|
my ($href); |
758
|
|
|
|
|
|
|
|
759
|
3
|
50
|
33
|
|
|
49
|
croak "query and key are required for hoaoh" unless $params->{query} and $params->{key}; |
760
|
|
|
|
|
|
|
|
761
|
3
|
|
|
|
|
17
|
my $hoa = $params->{href}; #if hashref is passed it, it will just add to it |
762
|
|
|
|
|
|
|
|
763
|
3
|
|
|
|
|
18
|
$self->_query($params); |
764
|
|
|
|
|
|
|
|
765
|
3
|
100
|
|
|
|
18
|
if($params->{decrypt}) { |
766
|
1
|
|
|
|
|
407
|
while($href=$self->sth->fetchrow_hashref){ |
767
|
4
|
|
|
|
|
20
|
$params->{href} = $href; |
768
|
4
|
|
|
|
|
14
|
$self->_crypt_decrypt($params); |
769
|
4
|
|
|
|
|
401
|
push @{$hoa->{$href->{$params->{key}}}},$href; |
|
4
|
|
|
|
|
86
|
|
770
|
|
|
|
|
|
|
} |
771
|
|
|
|
|
|
|
} |
772
|
|
|
|
|
|
|
else { |
773
|
2
|
|
|
|
|
105
|
while($href=$self->sth->fetchrow_hashref){ |
774
|
8
|
|
|
|
|
23
|
push @{$hoa->{$href->{$params->{key}}}},$href; |
|
8
|
|
|
|
|
98
|
|
775
|
|
|
|
|
|
|
} |
776
|
|
|
|
|
|
|
} |
777
|
|
|
|
|
|
|
|
778
|
3
|
|
|
|
|
18
|
return $hoa; |
779
|
|
|
|
|
|
|
} |
780
|
|
|
|
|
|
|
|
781
|
|
|
|
|
|
|
=head2 array |
782
|
|
|
|
|
|
|
|
783
|
|
|
|
|
|
|
L can be used for selecting one value from multiple rows. Say for instance that we wanted all the ids for anyone named Susie. |
784
|
|
|
|
|
|
|
We could do that like so: |
785
|
|
|
|
|
|
|
|
786
|
|
|
|
|
|
|
my $ids = $db->array("SELECT id FROM people WHERE name='Susie'"); |
787
|
|
|
|
|
|
|
|
788
|
|
|
|
|
|
|
print "Susie ids: \n"; |
789
|
|
|
|
|
|
|
for my $id (@$ids) { |
790
|
|
|
|
|
|
|
print "$id\n"; |
791
|
|
|
|
|
|
|
} |
792
|
|
|
|
|
|
|
|
793
|
|
|
|
|
|
|
To L for L, you would use L"DECRYPT LIST CONTEXT">. |
794
|
|
|
|
|
|
|
|
795
|
|
|
|
|
|
|
=cut |
796
|
|
|
|
|
|
|
|
797
|
|
|
|
|
|
|
sub array { |
798
|
2
|
|
|
2
|
1
|
57
|
my $self = shift; |
799
|
2
|
|
|
|
|
14
|
my $params = $self->_params(@_); |
800
|
2
|
|
|
|
|
65
|
my ($r,@a); |
801
|
|
|
|
|
|
|
|
802
|
|
|
|
|
|
|
# Get the Array of results: |
803
|
2
|
|
|
|
|
10
|
$self->_query($params); |
804
|
2
|
100
|
|
|
|
17
|
if($params->{decrypt}) { |
805
|
1
|
|
|
|
|
30
|
while(($r) = $self->sth->fetchrow_array()){ |
806
|
4
|
|
|
|
|
19
|
$r = $self->_decrypt($r); |
807
|
4
|
|
|
|
|
416
|
push @a, $r; |
808
|
|
|
|
|
|
|
} |
809
|
|
|
|
|
|
|
} |
810
|
|
|
|
|
|
|
else { |
811
|
1
|
|
|
|
|
49
|
while(($r) = $self->sth->fetchrow_array()){ |
812
|
4
|
|
|
|
|
27
|
push @a, $r; |
813
|
|
|
|
|
|
|
} |
814
|
|
|
|
|
|
|
} |
815
|
|
|
|
|
|
|
|
816
|
2
|
|
|
|
|
19
|
return \@a; |
817
|
|
|
|
|
|
|
} |
818
|
|
|
|
|
|
|
|
819
|
|
|
|
|
|
|
=head2 hash |
820
|
|
|
|
|
|
|
|
821
|
|
|
|
|
|
|
=over |
822
|
|
|
|
|
|
|
|
823
|
|
|
|
|
|
|
=item |
824
|
|
|
|
|
|
|
|
825
|
|
|
|
|
|
|
B - the query |
826
|
|
|
|
|
|
|
|
827
|
|
|
|
|
|
|
=item |
828
|
|
|
|
|
|
|
|
829
|
|
|
|
|
|
|
B - the name of the column that will serve as the key |
830
|
|
|
|
|
|
|
|
831
|
|
|
|
|
|
|
=item |
832
|
|
|
|
|
|
|
|
833
|
|
|
|
|
|
|
B - the name of the column that will be stored behind the key |
834
|
|
|
|
|
|
|
|
835
|
|
|
|
|
|
|
=item |
836
|
|
|
|
|
|
|
|
837
|
|
|
|
|
|
|
B - the hash reference that you would like to have the results added to |
838
|
|
|
|
|
|
|
|
839
|
|
|
|
|
|
|
=back |
840
|
|
|
|
|
|
|
|
841
|
|
|
|
|
|
|
L can be used if you want to map one key to one value for multiple rows. For instance, let's say |
842
|
|
|
|
|
|
|
we wanted to map each person's id to their name: |
843
|
|
|
|
|
|
|
|
844
|
|
|
|
|
|
|
my $ids_to_names = $db->hash(query => "SELECT id, name FROM people", key => "id", val => "name"); |
845
|
|
|
|
|
|
|
|
846
|
|
|
|
|
|
|
my $name_1 = $ids_to_names->{1}; |
847
|
|
|
|
|
|
|
|
848
|
|
|
|
|
|
|
print "$name_1\n"; #prints 'Fred' |
849
|
|
|
|
|
|
|
|
850
|
|
|
|
|
|
|
|
851
|
|
|
|
|
|
|
To have L add to an existing hash, just pass in the existing hash with C: |
852
|
|
|
|
|
|
|
|
853
|
|
|
|
|
|
|
|
854
|
|
|
|
|
|
|
$db->hash(query => "SELECT id, name FROM people", key => "id", val => "name", href => $ids_to_names); |
855
|
|
|
|
|
|
|
|
856
|
|
|
|
|
|
|
To L for L, you would use L"DECRYPT HASH CONTEXT">. |
857
|
|
|
|
|
|
|
|
858
|
|
|
|
|
|
|
=cut |
859
|
|
|
|
|
|
|
|
860
|
|
|
|
|
|
|
sub hash { |
861
|
3
|
|
|
3
|
1
|
102
|
my $self = shift; |
862
|
3
|
|
|
|
|
15
|
my $params = $self->_params(@_); |
863
|
3
|
|
|
|
|
8
|
my ($href); |
864
|
|
|
|
|
|
|
|
865
|
3
|
50
|
33
|
|
|
58
|
croak "query, key, and val are required for hash" unless $params->{query} and $params->{key} and $params->{val}; |
|
|
|
33
|
|
|
|
|
866
|
|
|
|
|
|
|
|
867
|
3
|
|
|
|
|
18
|
my $hash = $params->{href}; #if hash is passed in, it will just add to it |
868
|
|
|
|
|
|
|
|
869
|
3
|
|
|
|
|
14
|
$self->_query($params); |
870
|
|
|
|
|
|
|
|
871
|
3
|
100
|
|
|
|
27
|
if($params->{decrypt}) { |
872
|
1
|
|
|
|
|
87
|
while($href=$self->sth->fetchrow_hashref){ |
873
|
2
|
|
|
|
|
13
|
$params->{href} = $href; |
874
|
2
|
|
|
|
|
14
|
$self->_crypt_decrypt($params); |
875
|
2
|
|
|
|
|
328
|
$hash->{$href->{$params->{key}}} = $href->{$params->{val}}; |
876
|
|
|
|
|
|
|
} |
877
|
|
|
|
|
|
|
} |
878
|
|
|
|
|
|
|
else { |
879
|
2
|
|
|
|
|
127
|
while($href=$self->sth->fetchrow_hashref){ |
880
|
4
|
|
|
|
|
104
|
$hash->{$href->{$params->{key}}} = $href->{$params->{val}}; |
881
|
|
|
|
|
|
|
} |
882
|
|
|
|
|
|
|
} |
883
|
|
|
|
|
|
|
|
884
|
3
|
|
|
|
|
26
|
return $hash; |
885
|
|
|
|
|
|
|
} |
886
|
|
|
|
|
|
|
|
887
|
|
|
|
|
|
|
=head2 insert |
888
|
|
|
|
|
|
|
|
889
|
|
|
|
|
|
|
=over |
890
|
|
|
|
|
|
|
|
891
|
|
|
|
|
|
|
=item |
892
|
|
|
|
|
|
|
|
893
|
|
|
|
|
|
|
B - the hash reference that will be used to insert the row, with the columns as the keys and the new values as the values |
894
|
|
|
|
|
|
|
|
895
|
|
|
|
|
|
|
=item |
896
|
|
|
|
|
|
|
|
897
|
|
|
|
|
|
|
B - the name of the table that the row will be inserted into
898
|
|
|
|
|
|
|
|
899
|
|
|
|
|
|
|
=back |
900
|
|
|
|
|
|
|
|
901
|
|
|
|
|
|
|
L can be used to insert a single row with a hash. This can be useful if you already have the values you need |
902
|
|
|
|
|
|
|
to insert the row with in a hash, where the keys are the column names and the values are the new values. This function |
903
|
|
|
|
|
|
|
might be useful for submitting forms easily. |
904
|
|
|
|
|
|
|
|
905
|
|
|
|
|
|
|
my %person_to_insert = ( |
906
|
|
|
|
|
|
|
name => 'Billy', |
907
|
|
|
|
|
|
|
age => '32', |
908
|
|
|
|
|
|
|
favorite_color => 'blue', |
909
|
|
|
|
|
|
|
); |
910
|
|
|
|
|
|
|
|
911
|
|
|
|
|
|
|
$db->insert(href => \%person_to_insert, table => 'people'); |
912
|
|
|
|
|
|
|
|
913
|
|
|
|
|
|
|
If you need to have literal SQL into your insert query, then you just need to pass in a scalar reference. For example: |
914
|
|
|
|
|
|
|
|
915
|
|
|
|
|
|
|
"INSERT INTO people (name, update_time) VALUES('Billy', NOW())" |
916
|
|
|
|
|
|
|
|
917
|
|
|
|
|
|
|
If we had this: |
918
|
|
|
|
|
|
|
|
919
|
|
|
|
|
|
|
my %person_to_insert = ( |
920
|
|
|
|
|
|
|
name => 'Billy', |
921
|
|
|
|
|
|
|
update_time => 'NOW()', |
922
|
|
|
|
|
|
|
); |
923
|
|
|
|
|
|
|
|
924
|
|
|
|
|
|
|
$db->insert(href => \%person_to_insert, table => 'people'); |
925
|
|
|
|
|
|
|
|
926
|
|
|
|
|
|
|
This would effectively evaluate to: |
927
|
|
|
|
|
|
|
|
928
|
|
|
|
|
|
|
$db->raw(query => "INSERT INTO people (name, update_time) VALUES(?, ?)", vals => ['Billy', 'NOW()']); |
929
|
|
|
|
|
|
|
|
930
|
|
|
|
|
|
|
However, this will not work. Instead, we need to do: |
931
|
|
|
|
|
|
|
|
932
|
|
|
|
|
|
|
my %person_to_insert = ( |
933
|
|
|
|
|
|
|
name => 'Billy', |
934
|
|
|
|
|
|
|
update_time => \'NOW()', |
935
|
|
|
|
|
|
|
); |
936
|
|
|
|
|
|
|
|
937
|
|
|
|
|
|
|
$db->insert(href => \%person_to_insert, table => 'people'); |
938
|
|
|
|
|
|
|
|
939
|
|
|
|
|
|
|
Which evaluates to: |
940
|
|
|
|
|
|
|
|
941
|
|
|
|
|
|
|
$db->raw(query => "INSERT INTO people (name, update_time) VALUES(?, NOW())", vals => ['Billy']); |
942
|
|
|
|
|
|
|
|
943
|
|
|
|
|
|
|
And this is what we want. |
944
|
|
|
|
|
|
|
|
945
|
|
|
|
|
|
|
=head3 insert encrypt |
946
|
|
|
|
|
|
|
|
947
|
|
|
|
|
|
|
When encrypting for insert, because a hash is passed in you need to have the encrypt array reference contain the names of the columns that you want to encrypt |
948
|
|
|
|
|
|
|
instead of the indices for the order in which the columns are listed: |
949
|
|
|
|
|
|
|
|
950
|
|
|
|
|
|
|
my %person_to_insert = ( |
951
|
|
|
|
|
|
|
name => 'Billy', |
952
|
|
|
|
|
|
|
age => '32', |
953
|
|
|
|
|
|
|
favorite_color => 'blue', |
954
|
|
|
|
|
|
|
); |
955
|
|
|
|
|
|
|
|
956
|
|
|
|
|
|
|
$db->insert(href => \%person_to_insert, table => 'people', encrypt => ['name', 'favorite_color']); |
957
|
|
|
|
|
|
|
|
958
|
|
|
|
|
|
|
Note we do not ecnrypt age because it is most likely stored as an integer in the database. |
959
|
|
|
|
|
|
|
|
960
|
|
|
|
|
|
|
=cut |
961
|
|
|
|
|
|
|
|
962
|
|
|
|
|
|
|
# TODO: write insert tests |
963
|
|
|
|
|
|
|
sub insert { |
964
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
965
|
0
|
|
|
|
|
0
|
my $params = $self->_params(@_); |
966
|
|
|
|
|
|
|
|
967
|
0
|
0
|
0
|
|
|
0
|
croak "href and table are required for insert" unless $params->{href} and $params->{table}; |
968
|
|
|
|
|
|
|
|
969
|
0
|
|
|
|
|
0
|
my @vals; |
970
|
0
|
|
|
|
|
0
|
my $column_names = ''; |
971
|
0
|
|
|
|
|
0
|
my $values_string = ''; |
972
|
0
|
|
|
|
|
0
|
my @encrypt; |
973
|
0
|
|
|
|
|
0
|
while(my ($key,$val) = each %{$params->{href}}) { |
|
0
|
|
|
|
|
0
|
|
974
|
0
|
|
|
|
|
0
|
my $append = '?'; |
975
|
0
|
0
|
|
|
|
0
|
if (ref $val eq 'SCALAR') { |
976
|
0
|
|
|
|
|
0
|
$append = $$val; |
977
|
|
|
|
|
|
|
} |
978
|
|
|
|
|
|
|
else { |
979
|
0
|
0
|
0
|
0
|
|
0
|
if ($params->{encrypt} and first { $_ eq $key } @{$params->{encrypt}}) { |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
980
|
0
|
|
|
|
|
0
|
push @encrypt, scalar(@vals); |
981
|
|
|
|
|
|
|
} |
982
|
|
|
|
|
|
|
|
983
|
0
|
|
|
|
|
0
|
push @vals, $val; |
984
|
|
|
|
|
|
|
} |
985
|
|
|
|
|
|
|
|
986
|
0
|
|
|
|
|
0
|
$column_names .= "$key,"; |
987
|
0
|
|
|
|
|
0
|
$values_string .= "$append,"; |
988
|
|
|
|
|
|
|
} |
989
|
|
|
|
|
|
|
|
990
|
0
|
|
|
|
|
0
|
$column_names = substr $column_names, 0, -1; |
991
|
0
|
|
|
|
|
0
|
$values_string = substr $values_string, 0, -1; |
992
|
|
|
|
|
|
|
|
993
|
0
|
|
|
|
|
0
|
$params->{query} = "INSERT INTO $params->{table} ($column_names) VALUES($values_string)"; |
994
|
0
|
|
|
|
|
0
|
$params->{vals} = \@vals; |
995
|
|
|
|
|
|
|
|
996
|
0
|
0
|
0
|
|
|
0
|
if ($params->{encrypt} and @encrypt) { |
997
|
0
|
|
|
|
|
0
|
$params->{encrypt} = \@encrypt; |
998
|
0
|
|
|
|
|
0
|
$self->_crypt_encrypt($params); |
999
|
|
|
|
|
|
|
} |
1000
|
|
|
|
|
|
|
|
1001
|
0
|
|
|
|
|
0
|
$self->_query($params); |
1002
|
|
|
|
|
|
|
} |
1003
|
|
|
|
|
|
|
|
1004
|
|
|
|
|
|
|
=head2 update |
1005
|
|
|
|
|
|
|
|
1006
|
|
|
|
|
|
|
=over |
1007
|
|
|
|
|
|
|
|
1008
|
|
|
|
|
|
|
=item |
1009
|
|
|
|
|
|
|
|
1010
|
|
|
|
|
|
|
B - the hash reference that will be used to update the row, with the columns as the keys and the new values as the values |
1011
|
|
|
|
|
|
|
|
1012
|
|
|
|
|
|
|
=item |
1013
|
|
|
|
|
|
|
|
1014
|
|
|
|
|
|
|
B - the name of the table that the updated row is in
1015
|
|
|
|
|
|
|
|
1016
|
|
|
|
|
|
|
=item |
1017
|
|
|
|
|
|
|
|
1018
|
|
|
|
|
|
|
B - specifies the id of the item that we are updating (note, column must be called "id"). Should not be used if C is used |
1019
|
|
|
|
|
|
|
|
1020
|
|
|
|
|
|
|
=item |
1021
|
|
|
|
|
|
|
|
1022
|
|
|
|
|
|
|
B - A hash reference of the form C<{name =E 'column_name', val =E 'unique_val'}>. Can be used instead of C. Should not be used if C is used |
1023
|
|
|
|
|
|
|
|
1024
|
|
|
|
|
|
|
=item |
1025
|
|
|
|
|
|
|
|
1026
|
|
|
|
|
|
|
B - A where clause to help decide what row to update. Any bind values can be passed in with C |
1027
|
|
|
|
|
|
|
|
1028
|
|
|
|
|
|
|
=back |
1029
|
|
|
|
|
|
|
|
1030
|
|
|
|
|
|
|
L can be used to update a single row with a hash, and returns the number of rows updated. This can be useful if you already have the values you need |
1031
|
|
|
|
|
|
|
to update the row with in a hash, where the keys are the column names and the values are the new values. This function |
1032
|
|
|
|
|
|
|
might be useful for submitting forms easily. |
1033
|
|
|
|
|
|
|
|
1034
|
|
|
|
|
|
|
my %updated_person = ( |
1035
|
|
|
|
|
|
|
name => 'Billy', |
1036
|
|
|
|
|
|
|
age => '32', |
1037
|
|
|
|
|
|
|
favorite_color => 'blue', |
1038
|
|
|
|
|
|
|
); |
1039
|
|
|
|
|
|
|
|
1040
|
|
|
|
|
|
|
my $num_rows_updated = $db->update(href => \%updated_person, table => 'people', id => 1); |
1041
|
|
|
|
|
|
|
|
1042
|
|
|
|
|
|
|
# or in list context |
1043
|
|
|
|
|
|
|
my ($num_rows_updated) = $db->update(href => \%updated_person, table => 'people', id => 1); |
1044
|
|
|
|
|
|
|
|
1045
|
|
|
|
|
|
|
Note that above for "id", the column must actually be named id for it to work. If you have a primary key or unique |
1046
|
|
|
|
|
|
|
identifying column that is named something different than id, then you can use the C parameter: |
1047
|
|
|
|
|
|
|
|
1048
|
|
|
|
|
|
|
my $num_rows_updated = $db->update(href => \%updated_person, table => 'people', pk => {name => 'person_id', val => 1}); |
1049
|
|
|
|
|
|
|
|
1050
|
|
|
|
|
|
|
If you need to specify more constraints for the row that you are updating instead of just the id, you can pass in a where clause: |
1051
|
|
|
|
|
|
|
|
1052
|
|
|
|
|
|
|
my $num_rows_updated = $db->update(href => \%updated_person, table => 'people', where => 'name=? AND favorite_color=? AND age=?', vals => ['Joe', 'green', 61]); |
1053
|
|
|
|
|
|
|
|
1054
|
|
|
|
|
|
|
Note that any bind values used in a where clause can just be passed into the C as usual. It is possible to use a where clause and an id or pk together: |
1055
|
|
|
|
|
|
|
|
1056
|
|
|
|
|
|
|
my $num_rows_updated = $db->update(href => \%updated_person, table => 'people', where => 'name=? AND favorite_color=? AND age=?', vals => ['Joe', 'green', 61], id => 1); |
1057
|
|
|
|
|
|
|
|
1058
|
|
|
|
|
|
|
Alternatively, you could just put the C or C in your where clause. |
1059
|
|
|
|
|
|
|
|
1060
|
|
|
|
|
|
|
If you need to have literal SQL into your update query, then you just need to pass in a scalar reference. For example: |
1061
|
|
|
|
|
|
|
|
1062
|
|
|
|
|
|
|
"UPDATE people SET name='Billy', update_time=NOW() WHERE id=1" |
1063
|
|
|
|
|
|
|
|
1064
|
|
|
|
|
|
|
If we had this: |
1065
|
|
|
|
|
|
|
|
1066
|
|
|
|
|
|
|
my %updated_person = ( |
1067
|
|
|
|
|
|
|
name => 'Billy', |
1068
|
|
|
|
|
|
|
update_time => 'NOW()', |
1069
|
|
|
|
|
|
|
); |
1070
|
|
|
|
|
|
|
|
1071
|
|
|
|
|
|
|
my $num_rows_updated = $db->update(href => \%updated_person, table => 'people', id => 1); |
1072
|
|
|
|
|
|
|
|
1073
|
|
|
|
|
|
|
This would effectively evaluate to: |
1074
|
|
|
|
|
|
|
|
1075
|
|
|
|
|
|
|
my $num_rows_updated = $db->raw(query => "UPDATE people SET name=?, update_time=? WHERE id=?", vals => ['Billy', 'NOW()', 1]); |
1076
|
|
|
|
|
|
|
|
1077
|
|
|
|
|
|
|
However, this will not work. Instead, we need to do: |
1078
|
|
|
|
|
|
|
|
1079
|
|
|
|
|
|
|
my %updated_person = ( |
1080
|
|
|
|
|
|
|
name => 'Billy', |
1081
|
|
|
|
|
|
|
update_time => \'NOW()', |
1082
|
|
|
|
|
|
|
); |
1083
|
|
|
|
|
|
|
|
1084
|
|
|
|
|
|
|
my $num_rows_updated = $db->update(href => \%updated_person, table => 'people', id => 1); |
1085
|
|
|
|
|
|
|
|
1086
|
|
|
|
|
|
|
Which evaluates to: |
1087
|
|
|
|
|
|
|
|
1088
|
|
|
|
|
|
|
my $num_rows_updated = $db->raw(query => "UPDATE people SET name=?, update_time=NOW() WHERE id=?", vals => ['Billy', 1]); |
1089
|
|
|
|
|
|
|
|
1090
|
|
|
|
|
|
|
And this is what we want. |
1091
|
|
|
|
|
|
|
|
1092
|
|
|
|
|
|
|
=head3 update encrypt |
1093
|
|
|
|
|
|
|
|
1094
|
|
|
|
|
|
|
When encrypting for update, because a hash is passed in you need to have the encrypt array reference contain the names of the columns that you want to encrypt |
1095
|
|
|
|
|
|
|
instead of the indices for the order in which the columns are listed: |
1096
|
|
|
|
|
|
|
|
1097
|
|
|
|
|
|
|
my %updated_person = ( |
1098
|
|
|
|
|
|
|
name => 'Billy', |
1099
|
|
|
|
|
|
|
age => '32', |
1100
|
|
|
|
|
|
|
favorite_color => 'blue', |
1101
|
|
|
|
|
|
|
); |
1102
|
|
|
|
|
|
|
|
1103
|
|
|
|
|
|
|
my $num_rows_updated = $db->update(href => \%updated_person, table => 'people', id => 1, encrypt => ['name', 'favorite_color']); |
1104
|
|
|
|
|
|
|
|
1105
|
|
|
|
|
|
|
Note we do not ecnrypt age because it is most likely stored as an integer in the database. |
1106
|
|
|
|
|
|
|
|
1107
|
|
|
|
|
|
|
=cut |
1108
|
|
|
|
|
|
|
|
1109
|
|
|
|
|
|
|
sub update { |
1110
|
17
|
|
|
17
|
1
|
971
|
my $self = shift; |
1111
|
17
|
|
|
|
|
107
|
my $params = $self->_params(@_); |
1112
|
|
|
|
|
|
|
|
1113
|
17
|
50
|
33
|
|
|
301
|
croak "href and table are required for update" unless $params->{href} and $params->{table}; |
1114
|
|
|
|
|
|
|
|
1115
|
17
|
|
|
|
|
55
|
my @vals; |
1116
|
17
|
|
|
|
|
99
|
my $string = ''; |
1117
|
17
|
|
|
|
|
62
|
my @encrypt; |
1118
|
17
|
|
|
|
|
52
|
while(my ($key,$val) = each %{$params->{href}}) { |
|
68
|
|
|
|
|
313
|
|
1119
|
51
|
|
|
|
|
146
|
my $append = '?'; |
1120
|
51
|
100
|
|
|
|
149
|
if (ref $val eq 'SCALAR') { |
1121
|
3
|
|
|
|
|
9
|
$append = $$val; |
1122
|
|
|
|
|
|
|
} |
1123
|
|
|
|
|
|
|
else { |
1124
|
|
|
|
|
|
|
# TODO: write update encrypt tests |
1125
|
48
|
100
|
66
|
|
|
491
|
if ((defined $params->{encrypt} and $params->{encrypt} eq '*') |
|
|
|
33
|
|
|
|
|
|
|
|
66
|
|
|
|
|
1126
|
0
|
|
|
0
|
|
0
|
or ($params->{encrypt} and first { $_ eq $key } @{$params->{encrypt}})) { |
|
0
|
|
|
|
|
0
|
|
1127
|
24
|
|
|
|
|
69
|
push @encrypt, scalar(@vals); |
1128
|
|
|
|
|
|
|
} |
1129
|
|
|
|
|
|
|
|
1130
|
48
|
|
|
|
|
121
|
push @vals, $val; |
1131
|
|
|
|
|
|
|
} |
1132
|
|
|
|
|
|
|
|
1133
|
51
|
|
|
|
|
217
|
$string .= "$key=$append,"; |
1134
|
|
|
|
|
|
|
} |
1135
|
|
|
|
|
|
|
|
1136
|
17
|
|
|
|
|
92
|
$string = substr $string, 0, -1; |
1137
|
|
|
|
|
|
|
|
1138
|
17
|
100
|
|
|
|
87
|
$params->{vals} = [] unless $params->{vals}; |
1139
|
17
|
|
|
|
|
78
|
my $where = ''; |
1140
|
17
|
100
|
|
|
|
80
|
if($params->{where}) { |
1141
|
10
|
|
|
|
|
29
|
$where = " WHERE $params->{where}"; |
1142
|
10
|
|
|
|
|
25
|
push @vals, @{$params->{vals}}; |
|
10
|
|
|
|
|
30
|
|
1143
|
|
|
|
|
|
|
} |
1144
|
|
|
|
|
|
|
|
1145
|
17
|
100
|
|
|
|
96
|
if($params->{id}) { |
|
|
100
|
|
|
|
|
|
1146
|
5
|
100
|
|
|
|
20
|
if($where eq '') { |
1147
|
3
|
|
|
|
|
15
|
$where = " WHERE id=? "; |
1148
|
|
|
|
|
|
|
} |
1149
|
|
|
|
|
|
|
else { |
1150
|
2
|
|
|
|
|
5
|
$where .= " AND id=? "; |
1151
|
|
|
|
|
|
|
} |
1152
|
|
|
|
|
|
|
|
1153
|
5
|
|
|
|
|
18
|
push @vals, $params->{id}; |
1154
|
|
|
|
|
|
|
} |
1155
|
|
|
|
|
|
|
elsif($params->{pk}) { |
1156
|
6
|
|
|
|
|
34
|
my $name = $params->{pk}->{name}; |
1157
|
6
|
|
|
|
|
27
|
my $val = $params->{pk}->{val}; |
1158
|
6
|
100
|
|
|
|
30
|
if($where eq '') { |
1159
|
2
|
|
|
|
|
5
|
$where = " WHERE $name=? "; |
1160
|
|
|
|
|
|
|
} |
1161
|
|
|
|
|
|
|
else { |
1162
|
4
|
|
|
|
|
15
|
$where .= " AND $name=? "; |
1163
|
|
|
|
|
|
|
} |
1164
|
|
|
|
|
|
|
|
1165
|
6
|
|
|
|
|
13
|
push @vals, $val; |
1166
|
|
|
|
|
|
|
} |
1167
|
|
|
|
|
|
|
|
1168
|
17
|
|
|
|
|
109
|
$params->{query} = "UPDATE $params->{table} SET $string $where"; |
1169
|
17
|
|
|
|
|
58
|
$params->{vals} = \@vals; |
1170
|
|
|
|
|
|
|
|
1171
|
17
|
100
|
66
|
|
|
157
|
if ($params->{encrypt} and @encrypt) { |
1172
|
8
|
|
|
|
|
31
|
$params->{encrypt} = \@encrypt; |
1173
|
8
|
|
|
|
|
40
|
$self->_crypt_encrypt($params); |
1174
|
|
|
|
|
|
|
} |
1175
|
|
|
|
|
|
|
|
1176
|
17
|
|
|
|
|
88
|
$self->_query($params); |
1177
|
|
|
|
|
|
|
|
1178
|
17
|
50
|
|
|
|
231
|
return unless defined wantarray; |
1179
|
0
|
0
|
|
|
|
0
|
return wantarray ? ($self->sth->rows()) : $self->sth->rows(); |
1180
|
|
|
|
|
|
|
} |
1181
|
|
|
|
|
|
|
|
1182
|
|
|
|
|
|
|
=head2 insert_multiple |
1183
|
|
|
|
|
|
|
|
1184
|
|
|
|
|
|
|
=over |
1185
|
|
|
|
|
|
|
|
1186
|
|
|
|
|
|
|
=item |
1187
|
|
|
|
|
|
|
|
1188
|
|
|
|
|
|
|
B - the array reference of array references, where each inner array reference holds the values to be inserted for one row |
1189
|
|
|
|
|
|
|
|
1190
|
|
|
|
|
|
|
=item |
1191
|
|
|
|
|
|
|
|
1192
|
|
|
|
|
|
|
B - the name of the table that the rows are to be inserted into
1193
|
|
|
|
|
|
|
|
1194
|
|
|
|
|
|
|
=item |
1195
|
|
|
|
|
|
|
|
1196
|
|
|
|
|
|
|
B - The names of the columns that values are being inserted for |
1197
|
|
|
|
|
|
|
|
1198
|
|
|
|
|
|
|
=back |
1199
|
|
|
|
|
|
|
|
1200
|
|
|
|
|
|
|
L can be used to insert multiple rows with one query. For instance: |
1201
|
|
|
|
|
|
|
|
1202
|
|
|
|
|
|
|
my $rows = [ |
1203
|
|
|
|
|
|
|
[ |
1204
|
|
|
|
|
|
|
1, |
1205
|
|
|
|
|
|
|
'Joe', |
1206
|
|
|
|
|
|
|
23, |
1207
|
|
|
|
|
|
|
], |
1208
|
|
|
|
|
|
|
[ |
1209
|
|
|
|
|
|
|
2, |
1210
|
|
|
|
|
|
|
'Ralph, |
1211
|
|
|
|
|
|
|
50, |
1212
|
|
|
|
|
|
|
], |
1213
|
|
|
|
|
|
|
]; |
1214
|
|
|
|
|
|
|
|
1215
|
|
|
|
|
|
|
$db->insert_multiple(table => 'people', columns => [qw/id name age/], rows => $rows); |
1216
|
|
|
|
|
|
|
|
1217
|
|
|
|
|
|
|
This can be translated into the SQL query: |
1218
|
|
|
|
|
|
|
|
1219
|
|
|
|
|
|
|
INSERT INTO people (id, name, age) VALUES (1, 'Joe', 23), (2, 'Ralph', 50); |
1220
|
|
|
|
|
|
|
|
1221
|
|
|
|
|
|
|
Note that L does not yet support encrypt. I'm planning to add this feature later. If you need it now, please shoot me an email and I will |
1222
|
|
|
|
|
|
|
try to speed things up! |
1223
|
|
|
|
|
|
|
|
1224
|
|
|
|
|
|
|
=cut |
1225
|
|
|
|
|
|
|
|
1226
|
|
|
|
|
|
|
sub insert_multiple { |
1227
|
1
|
|
|
1
|
1
|
40
|
my $self = shift; |
1228
|
1
|
|
|
|
|
4
|
my $params = $self->_params(@_); |
1229
|
|
|
|
|
|
|
|
1230
|
1
|
|
|
|
|
7
|
while(my ($key, $val) = each %$params) { |
1231
|
3
|
|
|
|
|
79
|
print "$key=$val\n"; |
1232
|
|
|
|
|
|
|
} |
1233
|
|
|
|
|
|
|
|
1234
|
1
|
50
|
33
|
|
|
17
|
croak "columns, table, and rows are required for insert_multiple" unless $params->{columns} and $params->{table} and $params->{rows}; |
|
|
|
33
|
|
|
|
|
1235
|
|
|
|
|
|
|
|
1236
|
1
|
|
|
|
|
3
|
my $values_string = ''; |
1237
|
1
|
|
|
|
|
2
|
my @vals; |
1238
|
|
|
|
|
|
|
|
1239
|
1
|
|
|
|
|
2
|
my $columns = join ',', @{$params->{columns}}; |
|
1
|
|
|
|
|
5
|
|
1240
|
1
|
|
|
|
|
7
|
my $row_string = '?,' x @{$params->{columns}}; |
|
1
|
|
|
|
|
5
|
|
1241
|
1
|
|
|
|
|
3
|
$row_string = substr $row_string, 0, -1; |
1242
|
|
|
|
|
|
|
|
1243
|
1
|
|
|
|
|
2
|
for my $row (@{$params->{rows}}) { |
|
1
|
|
|
|
|
6
|
|
1244
|
2
|
|
|
|
|
12
|
push @vals, @$row; |
1245
|
2
|
|
|
|
|
8
|
$values_string .= "($row_string),"; |
1246
|
|
|
|
|
|
|
} |
1247
|
|
|
|
|
|
|
|
1248
|
1
|
|
|
|
|
6
|
$values_string = substr $values_string, 0, -1; |
1249
|
|
|
|
|
|
|
|
1250
|
1
|
|
|
|
|
6
|
$params->{query} = "INSERT INTO $params->{table} ($columns) VALUES $values_string"; |
1251
|
1
|
|
|
|
|
9
|
print $params->{query} . "\n"; |
1252
|
1
|
|
|
|
|
4
|
$params->{vals} = \@vals; |
1253
|
|
|
|
|
|
|
|
1254
|
1
|
|
|
|
|
4
|
$self->_query($params); |
1255
|
|
|
|
|
|
|
} |
1256
|
|
|
|
|
|
|
|
1257
|
|
|
|
|
|
|
=head2 sth |
1258
|
|
|
|
|
|
|
|
1259
|
|
|
|
|
|
|
L returns the statement handle from the previous query. |
1260
|
|
|
|
|
|
|
|
1261
|
|
|
|
|
|
|
my $sth = $db->sth; |
1262
|
|
|
|
|
|
|
|
1263
|
|
|
|
|
|
|
This can be useful if you need a statement handle to perform a function, like to get |
1264
|
|
|
|
|
|
|
the id of the last inserted row. |
1265
|
|
|
|
|
|
|
|
1266
|
|
|
|
|
|
|
=cut |
1267
|
|
|
|
|
|
|
|
1268
|
|
|
|
|
|
|
=head2 dbh |
1269
|
|
|
|
|
|
|
|
1270
|
|
|
|
|
|
|
L returns the database handle that L is using. |
1271
|
|
|
|
|
|
|
|
1272
|
|
|
|
|
|
|
my $dbh = $db->dbh; |
1273
|
|
|
|
|
|
|
|
1274
|
|
|
|
|
|
|
L can also be used to set a new database handle for L to use. |
1275
|
|
|
|
|
|
|
|
1276
|
|
|
|
|
|
|
$db->dbh($new_dbh); |
1277
|
|
|
|
|
|
|
|
1278
|
|
|
|
|
|
|
=cut |
1279
|
|
|
|
|
|
|
|
1280
|
|
|
|
|
|
|
=head2 dsn |
1281
|
|
|
|
|
|
|
|
1282
|
|
|
|
|
|
|
L returns the dsn that was provided. |
1283
|
|
|
|
|
|
|
|
1284
|
|
|
|
|
|
|
my $dsn = $db->dsn; |
1285
|
|
|
|
|
|
|
|
1286
|
|
|
|
|
|
|
L can also be used to set a new C. |
1287
|
|
|
|
|
|
|
|
1288
|
|
|
|
|
|
|
$db->dsn($new_dsn); |
1289
|
|
|
|
|
|
|
|
1290
|
|
|
|
|
|
|
When setting a new C, it's likely you'll want to use L. |
1291
|
|
|
|
|
|
|
|
1292
|
|
|
|
|
|
|
=cut |
1293
|
|
|
|
|
|
|
|
1294
|
|
|
|
|
|
|
=head2 user |
1295
|
|
|
|
|
|
|
|
1296
|
|
|
|
|
|
|
L returns the user that was provided. |
1297
|
|
|
|
|
|
|
|
1298
|
|
|
|
|
|
|
my $user = $db->user; |
1299
|
|
|
|
|
|
|
|
1300
|
|
|
|
|
|
|
L can also be used to set a new C. |
1301
|
|
|
|
|
|
|
|
1302
|
|
|
|
|
|
|
$db->user($new_user); |
1303
|
|
|
|
|
|
|
|
1304
|
|
|
|
|
|
|
When setting a new C, it's likely you'll want to use L. |
1305
|
|
|
|
|
|
|
|
1306
|
|
|
|
|
|
|
=cut |
1307
|
|
|
|
|
|
|
|
1308
|
|
|
|
|
|
|
=head2 password |
1309
|
|
|
|
|
|
|
|
1310
|
|
|
|
|
|
|
L returns the password that was provided. |
1311
|
|
|
|
|
|
|
|
1312
|
|
|
|
|
|
|
my $password = $db->password; |
1313
|
|
|
|
|
|
|
|
1314
|
|
|
|
|
|
|
L can also be used to set a new C. |
1315
|
|
|
|
|
|
|
|
1316
|
|
|
|
|
|
|
$db->password($new_password); |
1317
|
|
|
|
|
|
|
|
1318
|
|
|
|
|
|
|
When setting a new C, it's likely you'll want to use L. |
1319
|
|
|
|
|
|
|
|
1320
|
|
|
|
|
|
|
=cut |
1321
|
|
|
|
|
|
|
|
1322
|
|
|
|
|
|
|
=head2 conf |
1323
|
|
|
|
|
|
|
|
1324
|
|
|
|
|
|
|
L returns the conf file that was provided. |
1325
|
|
|
|
|
|
|
|
1326
|
|
|
|
|
|
|
my $conf = $db->conf; |
1327
|
|
|
|
|
|
|
|
1328
|
|
|
|
|
|
|
L can also be used to set a new C file. |
1329
|
|
|
|
|
|
|
|
1330
|
|
|
|
|
|
|
$db->conf($new_conf); |
1331
|
|
|
|
|
|
|
|
1332
|
|
|
|
|
|
|
When setting a new C, it's likely you'll want to use L. |
1333
|
|
|
|
|
|
|
|
1334
|
|
|
|
|
|
|
=cut |
1335
|
|
|
|
|
|
|
|
1336
|
|
|
|
|
|
|
=head2 connect |
1337
|
|
|
|
|
|
|
|
1338
|
|
|
|
|
|
|
L can be used to keep the same L object, but get a new L. You can call connect to get a new dbh with the same settings that you have provided: |
1339
|
|
|
|
|
|
|
|
1340
|
|
|
|
|
|
|
#now there is a new dbh with the same DBIx::Raw object using the same settings |
1341
|
|
|
|
|
|
|
$db->connect; |
1342
|
|
|
|
|
|
|
|
1343
|
|
|
|
|
|
|
Or you can change the connect info. |
1344
|
|
|
|
|
|
|
For example, if you update C, C, C: |
1345
|
|
|
|
|
|
|
|
1346
|
|
|
|
|
|
|
$db->dsn('new_dsn'); |
1347
|
|
|
|
|
|
|
$db->user('user'); |
1348
|
|
|
|
|
|
|
$db->password('password'); |
1349
|
|
|
|
|
|
|
|
1350
|
|
|
|
|
|
|
#get new dbh but keep same DBIx::Raw object |
1351
|
|
|
|
|
|
|
$db->connect; |
1352
|
|
|
|
|
|
|
|
1353
|
|
|
|
|
|
|
Or if you update the conf file: |
1354
|
|
|
|
|
|
|
|
1355
|
|
|
|
|
|
|
$db->conf('/path/to/new_conf.pl'); |
1356
|
|
|
|
|
|
|
|
1357
|
|
|
|
|
|
|
#get new dbh but keep same DBIx::Raw object |
1358
|
|
|
|
|
|
|
$db->connect; |
1359
|
|
|
|
|
|
|
|
1360
|
|
|
|
|
|
|
=cut |
1361
|
|
|
|
|
|
|
|
1362
|
|
|
|
|
|
|
sub connect { |
1363
|
70
|
|
|
70
|
1
|
538
|
my ($self) = @_; |
1364
|
|
|
|
|
|
|
|
1365
|
70
|
|
|
|
|
579
|
$self->_parse_conf; |
1366
|
70
|
|
|
|
|
6949
|
$self->_validate_connect_info; |
1367
|
70
|
|
33
|
|
|
4638
|
return $self->dbh(DBI->connect($self->dsn, $self->user, $self->password) or croak($DBI::errstr)); |
1368
|
|
|
|
|
|
|
} |
1369
|
|
|
|
|
|
|
|
1370
|
|
|
|
|
|
|
sub _params { |
1371
|
321
|
|
|
321
|
|
976
|
my $self = shift; |
1372
|
|
|
|
|
|
|
|
1373
|
321
|
|
|
|
|
829
|
my %params; |
1374
|
321
|
100
|
|
|
|
2433
|
unless($self->keys->{$_[0]}) { |
1375
|
43
|
|
|
|
|
283
|
$params{query} = shift; |
1376
|
43
|
|
|
|
|
182
|
$params{vals} = [@_]; |
1377
|
|
|
|
|
|
|
} |
1378
|
|
|
|
|
|
|
else { |
1379
|
278
|
|
|
|
|
2990
|
%params = @_; |
1380
|
|
|
|
|
|
|
} |
1381
|
|
|
|
|
|
|
|
1382
|
321
|
|
|
|
|
1601
|
return \%params; |
1383
|
|
|
|
|
|
|
} |
1384
|
|
|
|
|
|
|
|
1385
|
|
|
|
|
|
|
sub _query { |
1386
|
321
|
|
|
321
|
|
878
|
my ($self, $params) = (@_); |
1387
|
|
|
|
|
|
|
|
1388
|
321
|
50
|
|
|
|
8082
|
$self->sth($self->dbh->prepare($params->{query})) or $self->_perish($params); |
1389
|
|
|
|
|
|
|
|
1390
|
321
|
100
|
|
|
|
28475
|
if($params->{'vals'}){ |
1391
|
227
|
50
|
|
|
|
835
|
$self->sth->execute(@{$params->{'vals'}}) or $self->_perish($params); |
|
227
|
|
|
|
|
6792
|
|
1392
|
|
|
|
|
|
|
} |
1393
|
|
|
|
|
|
|
else { |
1394
|
94
|
50
|
|
|
|
12566
|
$self->sth->execute() or $self->_perish($params); |
1395
|
|
|
|
|
|
|
} |
1396
|
|
|
|
|
|
|
} |
1397
|
|
|
|
|
|
|
|
1398
|
|
|
|
|
|
|
sub _perish { |
1399
|
0
|
|
|
0
|
|
0
|
my ($self, $params) = @_; |
1400
|
0
|
|
|
|
|
0
|
croak "ERROR: Can't prepare query.\n\n$DBI::errstr\n\nquery='" . $params->{query} . "'\n"; |
1401
|
|
|
|
|
|
|
} |
1402
|
|
|
|
|
|
|
|
1403
|
|
|
|
|
|
|
sub _crypt_decrypt { |
1404
|
31
|
|
|
31
|
|
264
|
my ($self, $params) = @_; |
1405
|
31
|
|
|
|
|
122
|
my @keys; |
1406
|
31
|
100
|
|
|
|
149
|
if($params->{decrypt} eq '*') { |
1407
|
8
|
100
|
|
|
|
60
|
if($params->{href}) { |
1408
|
6
|
|
|
|
|
42
|
@keys = keys %{$params->{href}}; |
|
6
|
|
|
|
|
36
|
|
1409
|
|
|
|
|
|
|
} |
1410
|
|
|
|
|
|
|
else { |
1411
|
2
|
|
|
|
|
10
|
@keys = 0..$#{$params->{return_values}}; |
|
2
|
|
|
|
|
10
|
|
1412
|
|
|
|
|
|
|
} |
1413
|
|
|
|
|
|
|
} |
1414
|
|
|
|
|
|
|
else { |
1415
|
23
|
|
|
|
|
47
|
@keys = @{$params->{decrypt}}; |
|
23
|
|
|
|
|
76
|
|
1416
|
|
|
|
|
|
|
} |
1417
|
|
|
|
|
|
|
|
1418
|
31
|
100
|
|
|
|
170
|
if($params->{href}) { |
1419
|
24
|
|
|
|
|
152
|
for my $key (@keys) { |
1420
|
47
|
50
|
|
|
|
2622
|
$params->{href}->{$key} = $self->_decrypt($params->{href}->{$key}) if $params->{href}->{$key}; |
1421
|
|
|
|
|
|
|
} |
1422
|
|
|
|
|
|
|
} |
1423
|
|
|
|
|
|
|
else { |
1424
|
7
|
|
|
|
|
51
|
for my $index (@keys) { |
1425
|
12
|
50
|
|
|
|
735
|
$params->{return_values}->[$index] = $self->_decrypt( $params->{return_values}->[$index] ) if $params->{return_values}->[$index]; |
1426
|
|
|
|
|
|
|
} |
1427
|
|
|
|
|
|
|
} |
1428
|
|
|
|
|
|
|
} |
1429
|
|
|
|
|
|
|
|
1430
|
|
|
|
|
|
|
sub _crypt_encrypt { |
1431
|
165
|
|
|
165
|
|
585
|
my ($self, $params) = @_; |
1432
|
165
|
|
|
|
|
381
|
my @indices; |
1433
|
|
|
|
|
|
|
|
1434
|
165
|
100
|
|
|
|
778
|
if($params->{encrypt} eq '*') { |
1435
|
4
|
|
|
|
|
43
|
my $num_question_marks = 0; |
1436
|
|
|
|
|
|
|
#don't want to encrypt where conditions! Might be buggy...should look into this more |
1437
|
4
|
50
|
|
|
|
80
|
if($params->{query} =~ /WHERE\s+(.*)/i) { |
1438
|
4
|
|
|
|
|
72
|
$num_question_marks =()= $1 =~ /=\s*?\?/g; |
1439
|
|
|
|
|
|
|
} |
1440
|
|
|
|
|
|
|
|
1441
|
4
|
|
|
|
|
35
|
@indices = 0..($#{$params->{vals}} - $num_question_marks); |
|
4
|
|
|
|
|
29
|
|
1442
|
|
|
|
|
|
|
} |
1443
|
|
|
|
|
|
|
else { |
1444
|
161
|
|
|
|
|
399
|
@indices = @{$params->{encrypt}}; |
|
161
|
|
|
|
|
536
|
|
1445
|
|
|
|
|
|
|
} |
1446
|
|
|
|
|
|
|
|
1447
|
165
|
|
|
|
|
877
|
for my $index (@indices) { |
1448
|
80
|
|
|
|
|
207
|
@{$params->{vals}}[$index] = $self->_encrypt( @{$params->{vals}}[$index] ); |
|
80
|
|
|
|
|
47020
|
|
|
80
|
|
|
|
|
389
|
|
1449
|
|
|
|
|
|
|
} |
1450
|
|
|
|
|
|
|
} |
1451
|
|
|
|
|
|
|
|
1452
|
|
|
|
|
|
|
sub _encrypt { |
1453
|
80
|
|
|
80
|
|
226
|
my ($self, $text) = @_; |
1454
|
|
|
|
|
|
|
|
1455
|
80
|
50
|
|
|
|
2193
|
if ($self->use_old_crypt) { |
1456
|
0
|
|
|
|
|
0
|
return $self->old_crypt->encrypt($text); |
1457
|
|
|
|
|
|
|
} |
1458
|
|
|
|
|
|
|
|
1459
|
80
|
|
|
|
|
2249
|
return $self->crypt->encrypt($text); |
1460
|
|
|
|
|
|
|
} |
1461
|
|
|
|
|
|
|
|
1462
|
|
|
|
|
|
|
sub _decrypt { |
1463
|
63
|
|
|
63
|
|
250
|
my ($self, $text) = @_; |
1464
|
|
|
|
|
|
|
|
1465
|
63
|
50
|
|
|
|
1432
|
if ($self->use_old_crypt) { |
1466
|
0
|
|
|
|
|
0
|
return $self->old_crypt->decrypt($text); |
1467
|
|
|
|
|
|
|
} |
1468
|
|
|
|
|
|
|
|
1469
|
63
|
|
|
|
|
1426
|
return $self->crypt->decrypt($text); |
1470
|
|
|
|
|
|
|
} |
1471
|
|
|
|
|
|
|
|
1472
|
|
|
|
|
|
|
sub _parse_conf { |
1473
|
140
|
|
|
140
|
|
472
|
my ($self) = @_; |
1474
|
|
|
|
|
|
|
|
1475
|
|
|
|
|
|
|
#load in configuration if it exists |
1476
|
140
|
100
|
|
|
|
2116
|
if($self->conf) { |
1477
|
|
|
|
|
|
|
|
1478
|
|
|
|
|
|
|
#no need to read in settings again if conf hasn't changed, unless dsn, user, or password is unset |
1479
|
137
|
50
|
100
|
|
|
7149
|
return if $self->conf eq $self->prev_conf and $self->dsn and $self->user and $self->password; |
|
|
|
66
|
|
|
|
|
|
|
|
66
|
|
|
|
|
1480
|
|
|
|
|
|
|
|
1481
|
137
|
|
|
|
|
10533
|
my $config = Config::Any->load_files({files =>[$self->conf],use_ext => 1 }); |
1482
|
|
|
|
|
|
|
|
1483
|
137
|
|
|
|
|
1664458
|
for my $c (@$config){ |
1484
|
137
|
|
|
|
|
1606
|
for my $file (keys %$c){ |
1485
|
137
|
|
|
|
|
692
|
for my $attribute (keys %{$c->{$file}}){ |
|
137
|
|
|
|
|
1017
|
|
1486
|
412
|
50
|
|
|
|
3678
|
if($self->can($attribute)) { |
1487
|
412
|
|
|
|
|
4448
|
$self->$attribute($c->{$file}->{$attribute}); |
1488
|
|
|
|
|
|
|
} |
1489
|
|
|
|
|
|
|
} |
1490
|
|
|
|
|
|
|
} |
1491
|
|
|
|
|
|
|
} |
1492
|
|
|
|
|
|
|
|
1493
|
137
|
|
|
|
|
11737
|
$self->prev_conf($self->conf); |
1494
|
|
|
|
|
|
|
} |
1495
|
|
|
|
|
|
|
} |
1496
|
|
|
|
|
|
|
|
1497
|
|
|
|
|
|
|
sub _validate_connect_info { |
1498
|
140
|
|
|
140
|
|
820
|
my ($self) = @_; |
1499
|
140
|
50
|
66
|
|
|
10858
|
croak "Need to specify 'dsn', 'user', and 'password' either when you create the object or by passing in a configuration file in 'conf'! Or, pass in an existing dbh" |
|
|
|
66
|
|
|
|
|
|
|
|
66
|
|
|
|
|
1500
|
|
|
|
|
|
|
unless (defined $self->dsn and defined $self->user and defined $self->password) or defined $self->dbh; |
1501
|
|
|
|
|
|
|
} |
1502
|
|
|
|
|
|
|
|
1503
|
|
|
|
|
|
|
=head1 AUTHOR |
1504
|
|
|
|
|
|
|
|
1505
|
|
|
|
|
|
|
Adam Hopkins, C<< >> |
1506
|
|
|
|
|
|
|
|
1507
|
|
|
|
|
|
|
=head1 BUGS |
1508
|
|
|
|
|
|
|
|
1509
|
|
|
|
|
|
|
Please report any bugs or feature requests to C, or through |
1510
|
|
|
|
|
|
|
the web interface at L. I will be notified, and then you'll |
1511
|
|
|
|
|
|
|
automatically be notified of progress on your bug as I make changes. |
1512
|
|
|
|
|
|
|
|
1513
|
|
|
|
|
|
|
=head1 SUPPORT |
1514
|
|
|
|
|
|
|
|
1515
|
|
|
|
|
|
|
You can find documentation for this module with the perldoc command. |
1516
|
|
|
|
|
|
|
|
1517
|
|
|
|
|
|
|
perldoc DBIx::Raw |
1518
|
|
|
|
|
|
|
|
1519
|
|
|
|
|
|
|
|
1520
|
|
|
|
|
|
|
You can also look for information at: |
1521
|
|
|
|
|
|
|
|
1522
|
|
|
|
|
|
|
=over 4 |
1523
|
|
|
|
|
|
|
|
1524
|
|
|
|
|
|
|
=item * RT: CPAN's request tracker (report bugs here) |
1525
|
|
|
|
|
|
|
|
1526
|
|
|
|
|
|
|
L |
1527
|
|
|
|
|
|
|
|
1528
|
|
|
|
|
|
|
=item * AnnoCPAN: Annotated CPAN documentation |
1529
|
|
|
|
|
|
|
|
1530
|
|
|
|
|
|
|
L |
1531
|
|
|
|
|
|
|
|
1532
|
|
|
|
|
|
|
=item * CPAN Ratings |
1533
|
|
|
|
|
|
|
|
1534
|
|
|
|
|
|
|
L |
1535
|
|
|
|
|
|
|
|
1536
|
|
|
|
|
|
|
=item * Search CPAN |
1537
|
|
|
|
|
|
|
|
1538
|
|
|
|
|
|
|
L |
1539
|
|
|
|
|
|
|
|
1540
|
|
|
|
|
|
|
=back |
1541
|
|
|
|
|
|
|
|
1542
|
|
|
|
|
|
|
|
1543
|
|
|
|
|
|
|
=head1 ACKNOWLEDGEMENTS |
1544
|
|
|
|
|
|
|
|
1545
|
|
|
|
|
|
|
Special thanks to Jay Davis who wrote a lot of the original code that this module is based on. |
1546
|
|
|
|
|
|
|
|
1547
|
|
|
|
|
|
|
=head1 LICENSE |
1548
|
|
|
|
|
|
|
|
1549
|
|
|
|
|
|
|
This library is free software; you can redistribute it and/or modify |
1550
|
|
|
|
|
|
|
it under the same terms as Perl itself. |
1551
|
|
|
|
|
|
|
|
1552
|
|
|
|
|
|
|
=cut |
1553
|
|
|
|
|
|
|
|
1554
|
|
|
|
|
|
|
1; |
| | |