File Coverage

blib/lib/DBIx/Raw.pm
Criterion Covered Total %
statement 289 327 88.3
branch 90 124 72.5
condition 33 72 45.8
subroutine 32 37 86.4
pod 12 13 92.3
total 456 573 79.5


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.
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 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 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.
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 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 or L, 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 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. 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 for L, you would use L.
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 for L, you would use L.
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 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 for L, you would use L.
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.
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.
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.
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.
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.
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.
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.
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;