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

package DBIx::Raw;

use 5.008_005;
our $VERSION = '0.22';

use strictures 2;
use Moo;
use Types::Standard qw/Bool HashRef InstanceOf Str/;
use DBI;
use Config::Any;
use DBIx::Raw::Crypt;
use Carp;
use List::Util qw/first/;
use Crypt::Mode::CBC::Easy;

#have an errors file to write to
has 'dsn' => is => 'rw';
has 'user' => is => 'rw';
has 'password' => is => 'rw';
has 'conf' => is => 'rw';
has 'prev_conf' => (
    is => 'rw',
    isa => Str,
    default => '',
);

has 'crypt' => (
	is => 'ro',
	isa => InstanceOf['Crypt::Mode::CBC::Easy'],
	lazy => 1,
	builder => sub {
		my ($self) = @_;
		return Crypt::Mode::CBC::Easy->new(key => $self->crypt_key);
	},
);

has 'crypt_key' => (
    is => 'rw',
    isa => Str,
    lazy => 1,
    builder => sub {
        my $crypt_key_hex = 'aea77496999d37bf47aedff9c0d44fdf2d2bbfa848ee6652abe9891b43e0f331';
        return pack "H*", $crypt_key_hex;
    },
);

has 'use_old_crypt' => (
    is => 'rw',
    isa => Bool,
);

has 'old_crypt_key' => (
    is => 'rw',
    isa => Str,
    lazy => 1,
    default => '6883868834006296591264051568595813693328016796531185824375212916576042669669556288781800326542091901603033335703884439231366552922364658270813734165084102xfasdfa8823423sfasdfalkj!@#$$CCCFFF!09xxxxlai3847lol13234408!!@#$_+-083dxje380-=0'
);

has 'old_crypt' => (
	is => 'ro',
	isa => InstanceOf['DBIx::Raw::Crypt'],
	lazy => 1,
	builder => sub {
		my ($self) = @_;
		return DBIx::Raw::Crypt->new( { secret => $self->old_crypt_key });
	},
);

# LAST STH USED
has 'sth' => is => 'rw';

#find out what DBH is specifically
has 'dbh' => (
	is => 'rw',
	lazy => 1,
	default => sub { shift->connect }
);

has 'keys' => (
	is => 'ro',
	isa => HashRef[Str],
	default => sub { {
		query => 1,
		vals => 1,
		encrypt => 1,
		decrypt => 1,
		key => 1,
		href => 1,
		table => 1,
		where => 1,
		pk => 1,
		rows => 1,
        id => 1,
	} },
);

sub BUILD {
	my ($self) = @_;
	$self->_parse_conf;
	$self->_validate_connect_info;
}

=head1 NAME

DBIx::Raw - Maintain control of SQL queries while still having a layer of abstraction above DBI

=head1 SYNOPSIS

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.

    use DBIx::Raw;
    my $db = DBIx::Raw->new(dsn => $dsn, user => $user, password => $password);

    #alternatively, use a conf file
    my $db = DBIx::Raw->new(conf => '/path/to/conf.pl');

    #get single values in scalar context
    my $name = $db->raw("SELECT name FROM people WHERE id=1");

    #get multiple values in list context
    my ($name, $age) = $db->raw("SELECT name, age FROM people WHERE id=1");

    #or
    my @person = $db->raw("SELECT name, age FROM people WHERE id=1");

    #get hash when using scalar context but requesting multiple values
    my $person = $db->raw("SELECT name, age FROM people where id=1");
    my $name = $person->{name};
    my $age = $person->{age};

    #also get hash in scalar context when selecting multiple values using '*'
    my $person = $db->raw("SELECT * FROM people where id=1");
    my $name = $person->{name};
    my $age = $person->{age};

    #insert a record
    $db->raw("INSERT INTO people (name, age) VALUES ('Sally', 26)");

    #insert a record with bind values to help prevent SQL injection
    $db->raw("INSERT INTO people (name, age) VALUES (?, ?)", 'Sally', 26);

    #update records
    my $num_rows_updated = $db->raw("UPDATE people SET name='Joe',age=34 WHERE id=1");

    #use bind values to help prevent SQL injection
    my $num_rows_updated = $db->raw("UPDATE people SET name=?,age=? WHERE id=?", 'Joe', 34, 1);

    #also use bind values when selecting
    my $name = $db->raw("SELECT name FROM people WHERE id=?", 1);

    #get multiple records as an array of hashes
    my $people = $db->aoh("SELECT name, age FROM people");

    for my $person (@$people) {
        print "$person->{name} is $person->{age} years old\n";
    }

    #update a record easily with a hash
    my %update = (
        name => 'Joe',
        age => 34,
    );

    #record with id=1 now has name=Joe an age=34
    $db->update(href=>\%update, table => 'people', id=>1);

    #use alternate syntax to encrypt and decrypt data
    my $num_rows_updated = $db->raw(query => "UPDATE people SET name=? WHERE id=1", vals => ['Joe'], encrypt => [0]);

    my $decrypted_name = $db->raw(query => "SELECT name FROM people WHERE id=1", decrypt => [0]);

    #when being returned a hash, use names of field for decryption
    my $decrypted_person = $db->raw(query => "SELECT name, age FROM people WHERE id=1", decrypt => ['name']);
    my $decrypted_name = $decrypted_person->{name};


=head1 INITIALIZATION

There are three ways to intialize a L object:

=head2 dsn, user, password

You can initialize a L object by passing in the dsn, user, and password connection information.

    my $db = DBIx::Raw->new(dsn => 'dbi:mysql:test:localhost:3306', user => 'user', password => 'password');

=head2 dbh

You can also initialize a L object by passing in an existing database handle.

    my $db = DBIx::Raw->new(dbh => $dbh);

=head2 conf

If you're going to using the same connection information a lot, it's useful to store it in a configuration file and then
use that when creating a L object.

    my $db = DBIx::Raw->new(conf => '/path/to/conf.pl');

See L for more information on how to set up a configuration file.

=head1 CONFIGURATION FILE

You can use a configuration file to store settings for L instead of passing them into new or setting them.
L uses L, so you can use any configuration format that is acceptable for L. Variables
that you might want to store in your configuration file are C, C, C, and L.

Below is an example configuration file in perl format:

=head2 conf.pl

    {
        dsn => 'dbi:mysql:test:localhost:3306',
        user => 'root',
        password => 'password',
        crypt_key => 'lxsafadsfadskl23239210453453802xxx02-487900-=+1!:)',
    }

=head2 conf.yaml

    ---
    dsn: 'dbi:mysql:test:localhost:3306'
    user: 'root'
    password: 'password'
    crypt_key: 'lxsafadsfadskl23239210453453802xxx02-487900-=+1!:)'

Note that you do not need to include L if you just if you just want to use the file for configuration settings.

=head1 SYNTAXES

DBIx::Raw provides two different possible syntaxes when making queries.

=head2 SIMPLE SYNTAX

Simple syntax is an easy way to write queries. It is always in the format:

    ("QUERY");

or

    ("QUERY", "VAL1", "VAL2", ...);

Below are some examples:

    my $num_rows_updated = $db->raw("UPDATE people SET name='Fred'");

    my $name = $db->raw("SELECT name FROM people WHERE id=1");

DBIx::Raw also supports L for L. These can be useful to help prevent SQL injection. Below are
some examples of how to use placeholders and bind values with L.

    my $num_rows_updated = $db->raw("UPDATE people SET name=?", 'Fred');

    my $name = $db->raw("SELECT name FROM people WHERE id=?", 1);

    $db->raw("INSERT INTO people (name, age) VALUES (?, ?)", 'Frank', 44);

Note that L cannot be used for L, L, L, or L because of the extra parameters that they require.

=head2 ADVANCED SYNTAX

Advanced syntax is used whenever a subroutine requires extra parameters besides just the query and bind values, or whenever you need to use L
or L. A simple example of the advanced syntax is:

    my $num_rows_updated = $db->raw(query => "UPDATE people SET name='Fred'");

This is equivalent to:

    my $num_rows_updated = $db->raw("UPDATE people SET name='Fred'");

A slightly more complex example adds in bind values:

    my $num_rows_updated = $db->raw(query => "UPDATE people SET name=?", vals => ['Fred']);

This is equivalent to the simple syntax:

    my $num_rows_updated = $db->raw("UPDATE people SET name=?", 'Fred');

Also, advanced syntax is required whenevery you want to L or L values.

    my $num_rows_updated = $db->raw(query => "UPDATE people SET name=?", vals => ['Fred'], encrypt => [0]);

    my $decrypted_name = $db->raw(query => "SELECT name FROM people WHERE id=1", decrypt => [0]);

Note that L is required for L, L, L, or L because of the extra parameters that they require.

=head1 ENCRYPT AND DECRYPT

You can use L to encrypt values when putting them into the database and decrypt values when removing them from the database.
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
or text field where the encryption will fit. In order to encrypt and decrypt your values, L requires a L. It contains a default
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
L method. It is recommended that you use a module like L to generate a secure key.
One thing to note is that both L and L require L.

=head2 encrypt

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
encrypt, you should put their index into the encrypt array that you pass in. For example:

    my $num_rows_updated = $db->raw(query => "UPDATE people SET name=?,age=?,height=? WHERE id=1", vals => ['Zoe', 24, "5'11"], encrypt => [0, 2]);

In the above example, only C and C will be encrypted. You can easily encrypt all values by using '*', like so:

    my $num_rows_updated = $db->raw(query => "UPDATE people SET name=?,height=? WHERE id=1", vals => ['Zoe', "5'11"], encrypt => '*');

And this will encrypt both C and C.

The only exception to the L syntax that is a little different is for L. See L for how to encrypt when using L.

=head2 decrypt

When decrypting values, there are two possible different syntaxes.

=head3 DECRYPT LIST CONTEXT

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
order that the columns were listed in. For instance:

    my $name = $db->raw(query => "SELECT name FROM people WHERE id=1", decrypt => [0]);

    my ($name, $age) = $db->raw(query => "SELECT name, age FROM people WHERE id=1", decrypt => [0,1]);

=head3 DECRYPT HASH CONTEXT

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:

    my $person = $db->raw(query => "SELECT name, age FROM people WHERE id=1", decrypt => ['name', 'age'])

    my $aoh = $db->aoh(query => "SELECT name, age FROM people", decrypt => ['name', 'age']);

Note that for either L or L, it is possible to use '*' to decrypt all columns:

    my ($name, $height) = $db->raw(query => "SELECT name, height FROM people WHERE id=1", decrypt => '*');

=head2 crypt_key

L uses L to encrypt and decrypt all values. You can set the crypt key when you create your
L object by passing it into L, providing it to L,
or by setting it with its setter method:

    $db->crypt_key("1234");

It is strongly recommended that you do not use the default L. The L should be the appropriate length
for the L that is set. The default L uses L, which uses L, which
allows key sizes of 128/192/256 bits.

=head2 crypt

The L object to use for encryption. Default is the default L object
created with the key L.

=head2 use_old_crypt

In version 0.16 L started using L instead of L. Setting this to 1 uses the old encryption instead.
Make sure to set L if you previously used L for encryption.

=head2 old_crypt_key

This sets the crypt key to use if L is set to true. Default is the previous crypt key.

=head1 SUBROUTINES/METHODS

=head2 raw

L is a very versitile subroutine, and it can be called in three contexts. L should only be used to make a query that
returns values for one record, or a query that returns no results (such as an INSERT query). If you need to have multiple
results returned, see one of the subroutines below.

=head3 SCALAR CONTEXT

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.

    #select
    my $name = $db->raw("SELECT name FROM people WHERE id=1");

    #update with number of rows updated returned
    my $num_rows_updated = $db->raw("UPDATE people SET name=? WHERE id=1", 'Frank');

    #update in undef context, nothing returned.
    $db->raw("UPDATE people SET name=? WHERE id=1", 'Frank');

    #insert
    $db->raw("INSERT INTO people (name, age) VALUES ('Jenny', 34)");

Note that to L for L for L, you would use L.

=head3 LIST CONTEXT

L can also be called in a list context to return multiple columns for one row.

    my ($name, $age) = $db->raw("SELECT name, age FROM people WHERE id=1");

    #or
    my @person = $db->raw("SELECT name, age FROM people WHERE id=1");

Note that to L for L for L, you would use L.

=head3 HASH CONTEXT

L will return a hash if you are selecting more than one column for a single record.

    my $person = $db->raw("SELECT name, age FROM people WHERE id=1");
    my $name = $person->{name};
    my $age = $person->{age};

Note that L's L works when using * in your query.

    my $person = $db->raw("SELECT * FROM people WHERE id=1");
    my $name = $person->{name};
    my $age = $person->{age};

Note that to L for L for L, you would use L.
=cut

sub raw {
	my $self = shift;

	my $params = $self->_params(@_);

	my (@return_values, $return_type);
	$self->sth($self->dbh->prepare($params->{query})) or $self->_perish($params);

	#if user asked for values to be encrypted
	if($params->{encrypt}) {
		$self->_crypt_encrypt($params);
	}

	$self->_query($params);

	if(not defined wantarray) {
		$self->sth->finish or $self->_perish($params);
		return;
	}
	elsif(wantarray) {
		$return_type = 'array';
	}
	else {
		$return_type = 'scalar';

		if($params->{query} =~ /SELECT\s+(.*?)\s+FROM/i) {
			my $match = $1;
			my $num_commas=()= $match =~ /,/g;
			my $num_stars=()= $match =~ /\*/g;

			if($num_commas > 0 or $num_stars > 0) { $return_type = 'hash' }
		}
	}

	if($params->{query} =~ /^(\n*?| *?|\r*?)UPDATE /si) {
  		my $return_value = $self->sth->rows();
		push @return_values, $return_value;
	}
    elsif(($params->{query} =~ /SELECT /sig) || ($params->{query} =~ /SHOW /sig)) {
  		unless($params->{query} =~ /INSERT INTO (.*?)SELECT /sig) {
  			if($return_type eq 'hash') {
				return unless $params->{href} = $self->sth->fetchrow_hashref; #handles undef case

				if($params->{decrypt}) {
					$self->_crypt_decrypt($params);
				}

  				push @return_values, $params->{href};
			}
			else {
				return unless @return_values = $self->sth->fetchrow_array(); #handles undef cases

				if($params->{decrypt}) {
					$params->{return_values} = \@return_values;
					$self->_crypt_decrypt($params);
				}
			}
		}
	}

	$self->sth->finish or $self->_perish($params);

	unless($return_type eq 'array') {
  		return $return_values[0];
	}
	else {
  		return @return_values;
	}
}

=head2 aoh (array_of_hashes)

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.

    my $people = $db->aoh("SELECT * FROM people");

    for my $person (@$people) {
        print "$person->{name} is $person->{age} years old\n";
    }

Note that to L for L, you would use L.
=cut

sub aoh {
	my $self = shift;
	my $params = $self->_params(@_);
	my ($href,@a);

	$self->_query($params);

	if($params->{decrypt}) {
		while($href=$self->sth->fetchrow_hashref){
			$params->{href} = $href;
			$self->_crypt_decrypt($params);
  			push @a, $href;
		}
	}
	else {
		while($href=$self->sth->fetchrow_hashref){
  			push @a, $href;
		}
	}

	return \@a;
}

=head2 aoa (array_of_arrays)

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.

    my $people = $db->aoa("SELECT name,age FROM people");

    for my $person (@$people) {
        my $name = $person->[0];
        my $age = $person->[1];
        print "$name is $age years old\n";
    }

Note that to L for L, you would use L.
=cut

sub aoa {
	my $self = shift;
	my $params = $self->_params(@_);
	my (@return_values);

	$self->_query($params);

	if($params->{decrypt}) {
		while(my @a=$self->sth->fetchrow_array){
			$params->{return_values} = \@a;
			$self->_crypt_decrypt($params);
  			push @return_values, \@a;
		}
	}
	else {
		while(my @a=$self->sth->fetchrow_array){
  			push @return_values, \@a;
		}
	}

	return \@return_values;
}



=head2 hoh (hash_of_hashes)

=over

=item

B - the query

=item

B - the name of the column that will serve as the key to access each row

=item

B - the hash reference that you would like to have the results added to

=back

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,
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.

    my $people = $db->hoh(query => "SELECT id, name, age FROM people", key => "id");

    for my $key(keys %$people) {
        my $person = $people->{$key};
        print "$person->{name} is $person->{age} years old\n";
    }

    #or
    while(my ($key, $person) = each %$people) {
        print "$person->{name} is $person->{age} years old\n";
    }

So if you wanted to access the person with an id of 1, you could do so like this:

    my $person1 = $people->{1};
    my $person1_name = $person1->{name};
    my $person1_age = $person1->{age};

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:

    #$people was previously retrieved, and results will now be added to $people
    $db->hoh(query => "SELECT id, name, age FROM people", key => "id", href => $people);

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

=cut

sub hoh {
	my $self = shift;
	my $params = $self->_params(@_);
	my ($href);

	my $hoh = $params->{href}; #if hashref is passed in, it will just add to it

	$self->_query($params);

	if($params->{decrypt}) {
		while($href=$self->sth->fetchrow_hashref){
			$params->{href} = $href;
			$self->_crypt_decrypt($params);
			$hoh->{$href->{$params->{key}}} = $href;
		}
	}
	else {
		while($href=$self->sth->fetchrow_hashref){
			$hoh->{$href->{$params->{key}}} = $href;
		}
	}

	return $hoh;
}

=head2 hoa (hash_of_arrays)

=over

=item

B - the query

=item

B - the name of the column that will serve as the key to store the values behind

=item

B - the name of the column whose values you want to be stored behind key

=item

B - the hash reference that you would like to have the results added to

=back

L is useful when you want to store a list of values for one column behind a key. For instance,
say that you wanted the id's of all people who have the same name grouped together. You could perform that query like so:

    my $hoa = $db->hoa(query => "SELECT id, name FROM people", key => "name", val => "id");

    for my $name (%$hoa) {
        my $ids = $hoa->{$name};

        print "$name has ids ";
        for my $id (@$ids) {
            print " $id,";
        }

        print "\n";
    }

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

=cut

sub hoa {
	my $self = shift;
	my $params = $self->_params(@_);
	my ($href);

	croak "query, key, and val are required for hoa" unless $params->{query} and $params->{key} and $params->{val};

	my $hash = $params->{href}; #if hash is passed in, it will just add to it

	$self->_query($params);

	if($params->{decrypt}) {
		while($href=$self->sth->fetchrow_hashref){
			$params->{href} = $href;
			$self->_crypt_decrypt($params);
			push @{$hash->{$href->{$params->{key}}}}, $href->{$params->{val}};
		}
	}
	else {
		while($href=$self->sth->fetchrow_hashref){
			push @{$hash->{$href->{$params->{key}}}}, $href->{$params->{val}};
		}
	}

	return $hash;
}

=head2 hoaoh (hash_of_array_of_hashes)

=over

=item

B - the query

=item

B - the name of the column that will serve as the key to store the array of hashes behind

=item

B - the hash reference that you would like to have the results added to

=back

L can be used when you want to store multiple rows behind a key that they all have in common. For
example, say that we wanted to have access to all rows for people that have the same name. That could be
done like so:

    my $hoaoh = $db->hoaoh(query => "SELECT id, name, age FROM people", key => "name");

    for my $name (keys %$hoaoh) {
        my $people = $hoaoh->{$name};

        print "People named $name: ";
        for my $person (@$people) {
            print "  $person->{name} is $person->{age} years old\n";
        }

        print "\n";
    }

So to get the array of rows for all people named Fred, we could simply do:

    my @freds = $hoaoh->{Fred};

    for my $fred (@freds) { ... }

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

=cut

sub hoaoh {
	my $self = shift;
	my $params = $self->_params(@_);
	my ($href);

	croak "query and key are required for hoaoh" unless $params->{query} and $params->{key};

	my $hoa = $params->{href}; #if hashref is passed it, it will just add to it

	$self->_query($params);

	if($params->{decrypt}) {
		while($href=$self->sth->fetchrow_hashref){
			$params->{href} = $href;
			$self->_crypt_decrypt($params);
			push @{$hoa->{$href->{$params->{key}}}},$href;
		}
	}
	else {
		while($href=$self->sth->fetchrow_hashref){
			push @{$hoa->{$href->{$params->{key}}}},$href;
		}
	}

	return $hoa;
}

=head2 array

L can be used for selecting one value from multiple rows. Say for instance that we wanted all the ids for anyone named Susie.
We could do that like so:

    my $ids = $db->array("SELECT id FROM people WHERE name='Susie'");

    print "Susie ids: \n";
    for my $id (@$ids) {
        print "$id\n";
    }

To L for L, you would use L.

=cut

sub array {
	my $self = shift;
	my $params = $self->_params(@_);
	my ($r,@a);

	# Get the Array of results:
	$self->_query($params);
	if($params->{decrypt}) {
		while(($r) = $self->sth->fetchrow_array()){
	  		$r = $self->_decrypt($r);
			push @a, $r;
		}
	}
	else {
		while(($r) = $self->sth->fetchrow_array()){
			push @a, $r;
		}
	}

	return \@a;
}

=head2 hash

=over

=item

B - the query

=item

B - the name of the column that will serve as the key

=item

B - the name of the column that will be stored behind the key

=item

B - the hash reference that you would like to have the results added to

=back

L can be used if you want to map one key to one value for multiple rows. For instance, let's say
we wanted to map each person's id to their name:

    my $ids_to_names = $db->hash(query => "SELECT id, name FROM people", key => "id", val => "name");

    my $name_1 = $ids_to_names->{1};

    print "$name_1\n"; #prints 'Fred'


To have L add to an existing hash, just pass in the existing hash with C:


    $db->hash(query => "SELECT id, name FROM people", key => "id", val => "name", href => $ids_to_names);

To L for L, you would use L.

=cut

sub hash {
	my $self = shift;
	my $params = $self->_params(@_);
	my ($href);

	croak "query, key, and val are required for hash" unless $params->{query} and $params->{key} and $params->{val};

	my $hash = $params->{href}; #if hash is passed in, it will just add to it

	$self->_query($params);

	if($params->{decrypt}) {
		while($href=$self->sth->fetchrow_hashref){
			$params->{href} = $href;
			$self->_crypt_decrypt($params);
			$hash->{$href->{$params->{key}}} = $href->{$params->{val}};
		}
	}
	else {
		while($href=$self->sth->fetchrow_hashref){
			$hash->{$href->{$params->{key}}} = $href->{$params->{val}};
		}
	}

	return $hash;
}

=head2 insert

=over

=item

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

=item

B - the name of the table that the row will be inserted into 




897




 





 





 





 





 





 



   




898




 





 





 





 





 





 



 =back 




899




 





 





 





 





 





 



   




900




 





 





 





 





 





 



 L can be used to insert a single row with a hash. This can be useful if you already have the values you need 




901




 





 





 





 





 





 



 to insert the row with in a hash, where the keys are the column names and the values are the new values. This function 




902




 





 





 





 





 





 



 might be useful for submitting forms easily. 




903




 





 





 





 





 





 



   




904




 





 





 





 





 





 



     my %person_to_insert = (  




905




 





 





 





 





 





 



         name => 'Billy', 




906




 





 





 





 





 





 



         age => '32', 




907




 





 





 





 





 





 



         favorite_color => 'blue', 




908




 





 





 





 





 





 



     ); 




909




 





 





 





 





 





 



   




910




 





 





 





 





 





 



     $db->insert(href => \%person_to_insert, table => 'people'); 




911




 





 





 





 





 





 



   




912




 





 





 





 





 





 



 If you need to have literal SQL into your insert query, then you just need to pass in a scalar reference. For example: 




913




 





 





 





 





 





 



   




914




 





 





 





 





 





 



     "INSERT INTO people (name, update_time) VALUES('Billy', NOW())" 




915




 





 





 





 





 





 



   




916




 





 





 





 





 





 



 If we had this: 




917




 





 





 





 





 





 



   




918




 





 





 





 





 





 



     my %person_to_insert = ( 




919




 





 





 





 





 





 



         name => 'Billy', 




920




 





 





 





 





 





 



         update_time => 'NOW()', 




921




 





 





 





 





 





 



     ); 




922




 





 





 





 





 





 



   




923




 





 





 





 





 





 



     $db->insert(href => \%person_to_insert, table => 'people'); 




924




 





 





 





 





 





 



   




925




 





 





 





 





 





 



 This would effectively evaluate to: 




926




 





 





 





 





 





 



   




927




 





 





 





 





 





 



     $db->raw(query => "INSERT INTO people (name, update_time) VALUES(?, ?)", vals => ['Billy', 'NOW()']); 




928




 





 





 





 





 





 



   




929




 





 





 





 





 





 



 However, this will not work. Instead, we need to do: 




930




 





 





 





 





 





 



   




931




 





 





 





 





 





 



     my %person_to_insert = ( 




932




 





 





 





 





 





 



         name => 'Billy', 




933




 





 





 





 





 





 



         update_time => \'NOW()', 




934




 





 





 





 





 





 



     ); 




935




 





 





 





 





 





 



   




936




 





 





 





 





 





 



     $db->insert(href => \%person_to_insert, table => 'people'); 




937




 





 





 





 





 





 



   




938




 





 





 





 





 





 



 Which evaluates to: 




939




 





 





 





 





 





 



   




940




 





 





 





 





 





 



     $db->raw(query => "INSERT INTO people (name, update_time) VALUES(?, NOW())", vals => ['Billy']); 




941




 





 





 





 





 





 



   




942




 





 





 





 





 





 



 And this is what we want. 




943




 





 





 





 





 





 



   




944




 





 





 





 





 





 



 =head3 insert encrypt 




945




 





 





 





 





 





 



   




946




 





 





 





 





 





 



 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  




947




 





 





 





 





 





 



 instead of the indices for the order in which the columns are listed: 




948




 





 





 





 





 





 



   




949




 





 





 





 





 





 



     my %person_to_insert = (  




950




 





 





 





 





 





 



         name => 'Billy', 




951




 





 





 





 





 





 



         age => '32', 




952




 





 





 





 





 





 



         favorite_color => 'blue', 




953




 





 





 





 





 





 



     ); 




954




 





 





 





 





 





 



   




955




 





 





 





 





 





 



     $db->insert(href => \%person_to_insert, table => 'people', encrypt => ['name', 'favorite_color']); 




956




 





 





 





 





 





 



   




957




 





 





 





 





 





 



 Note we do not ecnrypt age because it is most likely stored as an integer in the database. 




958




 





 





 





 





 





 



   




959




 





 





 





 





 





 



 =cut 




960




 





 





 





 





 





 



   




961




 





 





 





 





 





 



 # TODO: write insert tests 




962




 





 





 





 





 





 



 sub insert { 




963



  
0
  




 





 




  
0
  



  
1
  




0



 	my $self = shift; 




964



  
0
  




 





 





 





 





0



 	my $params = $self->_params(@_); 




965




 





 





 





 





 





 



   




966



  
0
  



  
  0
  



  
  0
  




 





 





0



 	croak "href and table are required for insert" unless $params->{href} and $params->{table}; 




967




 





 





 





 





 





 



   




968



  
0
  




 





 





 





 





0



 	my @vals; 




969



  
0
  




 





 





 





 





0



 	my $column_names = ''; 




970



  
0
  




 





 





 





 





0



 	my $values_string = ''; 




971



  
0
  




 





 





 





 





0



     my @encrypt; 




972



  
0
  




 





 





 





 





0



 	while(my ($key,$val) = each %{$params->{href}}) {  




 



  
0
  




 





 





 





 





0



   




973



  
0
  




 





 





 





 





0



 		my $append = '?'; 




974



  
0
  



  
  0
  




 





 





 





0



 		if (ref $val eq 'SCALAR') { 




975



  
0
  




 





 





 





 





0



 			$append = $$val; 




976




 





 





 





 





 





 



 		} 




977




 





 





 





 





 





 



 		else {  




978



  
0
  



  
  0
  



  
  0
  



  
0
  




 





0



             if ($params->{encrypt} and first { $_ eq $key } @{$params->{encrypt}}) { 




 



  
0
  




 





 





 





 





0



   




 



  
0
  




 





 





 





 





0



   




979



  
0
  




 





 





 





 





0



                 push @encrypt, scalar(@vals); 




980




 





 





 





 





 





 



             } 




981




 





 





 





 





 





 



   




982



  
0
  




 





 





 





 





0



 			push @vals, $val; 




983




 





 





 





 





 





 



 		} 




984




 





 





 





 





 





 



   




985



  
0
  




 





 





 





 





0



         $column_names .= "$key,"; 




986



  
0
  




 





 





 





 





0



         $values_string .= "$append,"; 




987




 





 





 





 





 





 



 	} 




988




 





 





 





 





 





 



 	 




989



  
0
  




 





 





 





 





0



 	$column_names = substr $column_names, 0, -1; 




990



  
0
  




 





 





 





 





0



 	$values_string = substr $values_string, 0, -1; 




991




 





 





 





 





 





 



   




992



  
0
  




 





 





 





 





0



 	$params->{query} = "INSERT INTO $params->{table} ($column_names) VALUES($values_string)"; 




993



  
0
  




 





 





 





 





0



 	$params->{vals} = \@vals; 




994




 





 





 





 





 





 



   




995



  
0
  



  
  0
  



  
  0
  




 





 





0



     if ($params->{encrypt} and @encrypt) { 




996



  
0
  




 





 





 





 





0



         $params->{encrypt} = \@encrypt; 




997



  
0
  




 





 





 





 





0



 	    $self->_crypt_encrypt($params); 




998




 





 





 





 





 





 



     } 




999




 





 





 





 





 





 



   




1000



  
0
  




 





 





 





 





0



 	$self->_query($params); 




1001




 





 





 





 





 





 



 }  




1002




 





 





 





 





 





 



   




1003




 





 





 





 





 





 



 =head2 update 




1004




 





 





 





 





 





 



   




1005




 





 





 





 





 





 



 =over 




1006




 





 





 





 





 





 



   




1007




 





 





 





 





 





 



 =item  




1008




 





 





 





 





 





 



   




1009




 





 





 





 





 





 



 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 




1010




 





 





 





 





 





 



   




1011




 





 





 





 





 





 



 =item  




1012




 





 





 





 





 





 



   




1013




 





 





 





 





 





 



 B - the name of the table that the updated row is in 




1014




 





 





 





 





 





 



   




1015




 





 





 





 





 





 



 =item  




1016




 





 





 





 





 





 



   




1017




 





 





 





 





 





 



 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 




1018




 





 





 





 





 





 



   




1019




 





 





 





 





 





 



 =item  




1020




 





 





 





 





 





 



   




1021




 





 





 





 





 





 



 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 




1022




 





 





 





 





 





 



   




1023




 





 





 





 





 





 



 =item  




1024




 





 





 





 





 





 



   




1025




 





 





 





 





 





 



 B - A where clause to help decide what row to update. Any bind values can be passed in with C 




1026




 





 





 





 





 





 



   




1027




 





 





 





 





 





 



 =back 




1028




 





 





 





 





 





 



   




1029




 





 





 





 





 





 



 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 




1030




 





 





 





 





 





 



 to update the row with in a hash, where the keys are the column names and the values are the new values. This function 




1031




 





 





 





 





 





 



 might be useful for submitting forms easily. 




1032




 





 





 





 





 





 



   




1033




 





 





 





 





 





 



     my %updated_person = (  




1034




 





 





 





 





 





 



         name => 'Billy', 




1035




 





 





 





 





 





 



         age => '32', 




1036




 





 





 





 





 





 



         favorite_color => 'blue', 




1037




 





 





 





 





 





 



     ); 




1038




 





 





 





 





 





 



   




1039




 





 





 





 





 





 



     my $num_rows_updated = $db->update(href => \%updated_person, table => 'people', id => 1); 




1040




 





 





 





 





 





 



   




1041




 





 





 





 





 





 



     # or in list context 




1042




 





 





 





 





 





 



     my ($num_rows_updated) = $db->update(href => \%updated_person, table => 'people', id => 1); 




1043




 





 





 





 





 





 



   




1044




 





 





 





 





 





 



 Note that above for "id", the column must actually be named id for it to work. If you have a primary key or unique 




1045




 





 





 





 





 





 



 identifying column that is named something different than id, then you can use the C parameter: 




1046




 





 





 





 





 





 



   




1047




 





 





 





 





 





 



     my $num_rows_updated = $db->update(href => \%updated_person, table => 'people', pk => {name => 'person_id', val => 1}); 




1048




 





 





 





 





 





 



   




1049




 





 





 





 





 





 



 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: 




1050




 





 





 





 





 





 



   




1051




 





 





 





 





 





 



     my $num_rows_updated = $db->update(href => \%updated_person, table => 'people', where => 'name=? AND favorite_color=? AND age=?', vals => ['Joe', 'green', 61]); 




1052




 





 





 





 





 





 



      




1053




 





 





 





 





 





 



 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: 




1054




 





 





 





 





 





 



   




1055




 





 





 





 





 





 



     my $num_rows_updated = $db->update(href => \%updated_person, table => 'people', where => 'name=? AND favorite_color=? AND age=?', vals => ['Joe', 'green', 61], id => 1); 




1056




 





 





 





 





 





 



   




1057




 





 





 





 





 





 



 Alternatively, you could just put the C or C in your where clause. 




1058




 





 





 





 





 





 



   




1059




 





 





 





 





 





 



 If you need to have literal SQL into your update query, then you just need to pass in a scalar reference. For example: 




1060




 





 





 





 





 





 



   




1061




 





 





 





 





 





 



     "UPDATE people SET name='Billy', update_time=NOW() WHERE id=1" 




1062




 





 





 





 





 





 



   




1063




 





 





 





 





 





 



 If we had this: 




1064




 





 





 





 





 





 



   




1065




 





 





 





 





 





 



     my %updated_person = ( 




1066




 





 





 





 





 





 



         name => 'Billy', 




1067




 





 





 





 





 





 



         update_time => 'NOW()', 




1068




 





 





 





 





 





 



     ); 




1069




 





 





 





 





 





 



   




1070




 





 





 





 





 





 



     my $num_rows_updated = $db->update(href => \%updated_person, table => 'people', id => 1); 




1071




 





 





 





 





 





 



   




1072




 





 





 





 





 





 



 This would effectively evaluate to: 




1073




 





 





 





 





 





 



   




1074




 





 





 





 





 





 



     my $num_rows_updated = $db->raw(query => "UPDATE people SET name=?, update_time=? WHERE id=?", vals => ['Billy', 'NOW()', 1]); 




1075




 





 





 





 





 





 



   




1076




 





 





 





 





 





 



 However, this will not work. Instead, we need to do: 




1077




 





 





 





 





 





 



   




1078




 





 





 





 





 





 



     my %updated_person = ( 




1079




 





 





 





 





 





 



         name => 'Billy', 




1080




 





 





 





 





 





 



         update_time => \'NOW()', 




1081




 





 





 





 





 





 



     ); 




1082




 





 





 





 





 





 



   




1083




 





 





 





 





 





 



     my $num_rows_updated = $db->update(href => \%updated_person, table => 'people', id => 1); 




1084




 





 





 





 





 





 



   




1085




 





 





 





 





 





 



 Which evaluates to: 




1086




 





 





 





 





 





 



   




1087




 





 





 





 





 





 



     my $num_rows_updated = $db->raw(query => "UPDATE people SET name=?, update_time=NOW() WHERE id=?", vals => ['Billy', 1]); 




1088




 





 





 





 





 





 



   




1089




 





 





 





 





 





 



 And this is what we want. 




1090




 





 





 





 





 





 



   




1091




 





 





 





 





 





 



 =head3 update encrypt 




1092




 





 





 





 





 





 



   




1093




 





 





 





 





 





 



 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  




1094




 





 





 





 





 





 



 instead of the indices for the order in which the columns are listed: 




1095




 





 





 





 





 





 



   




1096




 





 





 





 





 





 



     my %updated_person = (  




1097




 





 





 





 





 





 



         name => 'Billy', 




1098




 





 





 





 





 





 



         age => '32', 




1099




 





 





 





 





 





 



         favorite_color => 'blue', 




1100




 





 





 





 





 





 



     ); 




1101




 





 





 





 





 





 



   




1102




 





 





 





 





 





 



     my $num_rows_updated = $db->update(href => \%updated_person, table => 'people', id => 1, encrypt => ['name', 'favorite_color']); 




1103




 





 





 





 





 





 



   




1104




 





 





 





 





 





 



 Note we do not ecnrypt age because it is most likely stored as an integer in the database. 




1105




 





 





 





 





 





 



   




1106




 





 





 





 





 





 



 =cut 




1107




 





 





 





 





 





 



   




1108




 





 





 





 





 





 



 sub update { 




1109




17





 





 




  
17
  



  
1
  




1003



 	my $self = shift; 




1110




17





 





 





 





 





100



 	my $params = $self->_params(@_); 




1111




 





 





 





 





 





 



   




1112




17




  
 50
  



  
 33
  




 





 





332



 	croak "href and table are required for update" unless $params->{href} and $params->{table}; 




1113




 





 





 





 





 





 



   




1114




17





 





 





 





 





111



 	my @vals; 




1115




17





 





 





 





 





94



 	my $string = ''; 




1116




17





 





 





 





 





60



     my @encrypt; 




1117




17





 





 





 





 





74



 	while(my ($key,$val) = each %{$params->{href}}) {  




 




68





 





 





 





 





338



   




1118




51





 





 





 





 





141



 		my $append = '?'; 




1119




51




  
100
  




 





 





 





159



 		if (ref $val eq 'SCALAR') { 




1120




3





 





 





 





 





13



 			$append = $$val; 




1121




 





 





 





 





 





 



 		} 




1122




 





 





 





 





 





 



 		else {  




1123




 





 





 





 





 





 



             # TODO: write update encrypt tests 




1124




48




  
100
  



  
 66
  




 





 





509



             if ((defined $params->{encrypt} and $params->{encrypt} eq '*')  




 




 





 




  
 33
  




 





 





 



   




 




 





 




  
 66
  




 





 





 



   




1125



  
0
  




 





 




  
0
  




 





0



                     or ($params->{encrypt} and first { $_ eq $key } @{$params->{encrypt}})) { 




 



  
0
  




 





 





 





 





0



   




1126




24





 





 





 





 





74



                 push @encrypt, scalar(@vals); 




1127




 





 





 





 





 





 



             } 




1128




 





 





 





 





 





 



   




1129




48





 





 





 





 





151



 			push @vals, $val; 




1130




 





 





 





 





 





 



 		} 




1131




 





 





 





 





 





 



   




1132




51





 





 





 





 





187



 		$string .= "$key=$append,"; 




1133




 





 





 





 





 





 



 	} 




1134




 





 





 





 





 





 



 	 




1135




17





 





 





 





 





86



 	$string = substr $string, 0, -1; 




1136




 





 





 





 





 





 



   




1137




17




  
100
  




 





 





 





99



 	$params->{vals} = [] unless $params->{vals}; 




1138




17





 





 





 





 





74



 	my $where = ''; 




1139




17




  
100
  




 





 





 





80



 	if($params->{where}) {  




1140




10





 





 





 





 





40



 		$where = " WHERE $params->{where}";	 




1141




10





 





 





 





 





45



 		push @vals, @{$params->{vals}}; 




 




10





 





 





 





 





31



   




1142




 





 





 





 





 





 



 	} 




1143




 





 





 





 





 





 



   




1144




17




  
100
  




 





 





 





100



 	if($params->{id}) {  




 




 




  
100
  




 





 





 





 



   




1145




5




  
100
  




 





 





 





27



 		if($where eq '') {  




1146




3





 





 





 





 





16



 			$where = " WHERE id=? ";	 




1147




 





 





 





 





 





 



 		}	 




1148




 





 





 





 





 





 



 		else {  




1149




2





 





 





 





 





6



 			$where .= " AND id=? "; 




1150




 





 





 





 





 





 



 		} 




1151




 





 





 





 





 





 



   




1152




5





 





 





 





 





20



 		push @vals, $params->{id}; 




1153




 





 





 





 





 





 



 	} 




1154




 





 





 





 





 





 



 	elsif($params->{pk}) {  




1155




6





 





 





 





 





23



 		my $name = $params->{pk}->{name}; 




1156




6





 





 





 





 





29



 		my $val = $params->{pk}->{val}; 




1157




6




  
100
  




 





 





 





29



 		if($where eq '') {  




1158




2





 





 





 





 





12



 			$where = " WHERE $name=? ";	 




1159




 





 





 





 





 





 



 		}	 




1160




 





 





 





 





 





 



 		else {  




1161




4





 





 





 





 





20



 			$where .= " AND $name=? "; 




1162




 





 





 





 





 





 



 		} 




1163




 





 





 





 





 





 



   




1164




6





 





 





 





 





24



 		push @vals, $val; 




1165




 





 





 





 





 





 



 	} 




1166




 





 





 





 





 





 



   




1167




17





 





 





 





 





110



 	$params->{query} = "UPDATE $params->{table} SET $string $where"; 




1168




17





 





 





 





 





70



 	$params->{vals} = \@vals; 




1169




 





 





 





 





 





 



   




1170




17




  
100
  



  
 66
  




 





 





163



     if ($params->{encrypt} and @encrypt) { 




1171




8





 





 





 





 





32



         $params->{encrypt} = \@encrypt; 




1172




8





 





 





 





 





39



 	    $self->_crypt_encrypt($params); 




1173




 





 





 





 





 





 



     } 




1174




 





 





 





 





 





 



   




1175




17





 





 





 





 





82



 	$self->_query($params); 




1176




 





 





 





 





 





 



   




1177




17




  
 50
  




 





 





 





254



     return unless defined wantarray; 




1178



  
0
  



  
  0
  




 





 





 





0



     return wantarray ? ($self->sth->rows()) : $self->sth->rows(); 




1179




 





 





 





 





 





 



 }  




1180




 





 





 





 





 





 



   




1181




 





 





 





 





 





 



 =head2 insert_multiple 




1182




 





 





 





 





 





 



   




1183




 





 





 





 





 





 



 =over 




1184




 





 





 





 





 





 



   




1185




 





 





 





 





 





 



 =item  




1186




 





 





 





 





 





 



   




1187




 





 





 





 





 





 



 B - the array reference of array references, where each inner array reference holds the values to be inserted for one row 




1188




 





 





 





 





 





 



   




1189




 





 





 





 





 





 



 =item  




1190




 





 





 





 





 





 



   




1191




 





 





 





 





 





 



 B - the name of the table that the rows are to be inserted into 




1192




 





 





 





 





 





 



   




1193




 





 





 





 





 





 



 =item  




1194




 





 





 





 





 





 



   




1195




 





 





 





 





 





 



 B - The names of the columns that values are being inserted for 




1196




 





 





 





 





 





 



   




1197




 





 





 





 





 





 



 =back 




1198




 





 





 





 





 





 



   




1199




 





 





 





 





 





 



 L can be used to insert multiple rows with one query. For instance: 




1200




 





 





 





 





 





 



   




1201




 





 





 





 





 





 



     my $rows = [ 




1202




 





 





 





 





 





 



         [ 




1203




 





 





 





 





 





 



             1, 




1204




 





 





 





 





 





 



             'Joe', 




1205




 





 





 





 





 





 



             23, 




1206




 





 





 





 





 





 



         ], 




1207




 





 





 





 





 





 



         [ 




1208




 





 





 





 





 





 



             2, 




1209




 





 





 





 





 





 



             'Ralph, 




1210




 





 





 





 





 





 



             50, 




1211




 





 





 





 





 





 



         ], 




1212




 





 





 





 





 





 



     ]; 




1213




 





 





 





 





 





 



   




1214




 





 





 





 





 





 



     $db->insert_multiple(table => 'people', columns => [qw/id name age/], rows => $rows); 




1215




 





 





 





 





 





 



   




1216




 





 





 





 





 





 



 This can be translated into the SQL query: 




1217




 





 





 





 





 





 



   




1218




 





 





 





 





 





 



     INSERT INTO people (id, name, age) VALUES (1, 'Joe', 23), (2, 'Ralph', 50); 




1219




 





 





 





 





 





 



   




1220




 





 





 





 





 





 



 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 




1221




 





 





 





 





 





 



 try to speed things up! 




1222




 





 





 





 





 





 



   




1223




 





 





 





 





 





 



 =cut 




1224




 





 





 





 





 





 



   




1225




 





 





 





 





 





 



 sub insert_multiple { 




1226




1





 





 




  
1
  



  
1
  




49



 	my $self = shift; 




1227




1





 





 





 





 





5



 	my $params = $self->_params(@_); 




1228




 





 





 





 





 





 



   




1229




1





 





 





 





 





10



 	while(my ($key, $val) = each %$params) {  




1230




3





 





 





 





 





85



 		print "$key=$val\n"; 




1231




 





 





 





 





 





 



 	} 




1232




 





 





 





 





 





 



   




1233




1




  
 50
  



  
 33
  




 





 





24



 	croak "columns, table, and rows are required for insert_multiple" unless $params->{columns} and $params->{table} and $params->{rows}; 




 




 





 




  
 33
  




 





 





 



   




1234




 





 





 





 





 





 



   




1235




1





 





 





 





 





3



 	my $values_string = ''; 




1236




1





 





 





 





 





2



 	my @vals; 




1237




 





 





 





 





 





 



   




1238




1





 





 





 





 





4



 	my $columns = join ',', @{$params->{columns}}; 




 




1





 





 





 





 





9



   




1239




1





 





 





 





 





7



 	my $row_string = '?,' x @{$params->{columns}}; 




 




1





 





 





 





 





4



   




1240




1





 





 





 





 





4



 	$row_string = substr $row_string, 0, -1; 




1241




 





 





 





 





 





 



   




1242




1





 





 





 





 





2



 	for my $row (@{$params->{rows}}) {  




 




1





 





 





 





 





7



   




1243




2





 





 





 





 





13



 		push @vals, @$row; 




1244




2





 





 





 





 





13



 		$values_string .= "($row_string),";		 




1245




 





 





 





 





 





 



 	} 




1246




 





 





 





 





 





 



   




1247




1





 





 





 





 





9



 	$values_string = substr $values_string, 0, -1; 




1248




 





 





 





 





 





 



   




1249




1





 





 





 





 





6



 	$params->{query} = "INSERT INTO $params->{table} ($columns) VALUES $values_string"; 




1250




1





 





 





 





 





9



 	print $params->{query} . "\n"; 




1251




1





 





 





 





 





4



 	$params->{vals} = \@vals; 




1252




 





 





 





 





 





 



   




1253




1





 





 





 





 





5



 	$self->_query($params); 




1254




 





 





 





 





 





 



 }  




1255




 





 





 





 





 





 



   




1256




 





 





 





 





 





 



 =head2 sth 




1257




 





 





 





 





 





 



   




1258




 





 





 





 





 





 



 L returns the statement handle from the previous query. 




1259




 





 





 





 





 





 



   




1260




 





 





 





 





 





 



     my $sth = $db->sth; 




1261




 





 





 





 





 





 



   




1262




 





 





 





 





 





 



 This can be useful if you need a statement handle to perform a function, like to get 




1263




 





 





 





 





 





 



 the id of the last inserted row. 




1264




 





 





 





 





 





 



   




1265




 





 





 





 





 





 



 =cut 




1266




 





 





 





 





 





 



   




1267




 





 





 





 





 





 



 =head2 dbh 




1268




 





 





 





 





 





 



   




1269




 





 





 





 





 





 



 L returns the database handle that L is using. 




1270




 





 





 





 





 





 



   




1271




 





 





 





 





 





 



     my $dbh = $db->dbh; 




1272




 





 





 





 





 





 



   




1273




 





 





 





 





 





 



 L can also be used to set a new database handle for L to use. 




1274




 





 





 





 





 





 



   




1275




 





 





 





 





 





 



     $db->dbh($new_dbh); 




1276




 





 





 





 





 





 



   




1277




 





 





 





 





 





 



 =cut 




1278




 





 





 





 





 





 



   




1279




 





 





 





 





 





 



 =head2 dsn 




1280




 





 





 





 





 





 



   




1281




 





 





 





 





 





 



 L returns the dsn that was provided. 




1282




 





 





 





 





 





 



   




1283




 





 





 





 





 





 



     my $dsn = $db->dsn; 




1284




 





 





 





 





 





 



   




1285




 





 





 





 





 





 



 L can also be used to set a new C. 




1286




 





 





 





 





 





 



   




1287




 





 





 





 





 





 



     $db->dsn($new_dsn); 




1288




 





 





 





 





 





 



   




1289




 





 





 





 





 





 



 When setting a new C, it's likely you'll want to use L. 




1290




 





 





 





 





 





 



   




1291




 





 





 





 





 





 



 =cut 




1292




 





 





 





 





 





 



   




1293




 





 





 





 





 





 



 =head2 user 




1294




 





 





 





 





 





 



   




1295




 





 





 





 





 





 



 L returns the user that was provided. 




1296




 





 





 





 





 





 



   




1297




 





 





 





 





 





 



     my $user = $db->user; 




1298




 





 





 





 





 





 



   




1299




 





 





 





 





 





 



 L can also be used to set a new C. 




1300




 





 





 





 





 





 



   




1301




 





 





 





 





 





 



     $db->user($new_user); 




1302




 





 





 





 





 





 



   




1303




 





 





 





 





 





 



 When setting a new C, it's likely you'll want to use L. 




1304




 





 





 





 





 





 



   




1305




 





 





 





 





 





 



 =cut 




1306




 





 





 





 





 





 



   




1307




 





 





 





 





 





 



 =head2 password 




1308




 





 





 





 





 





 



   




1309




 





 





 





 





 





 



 L returns the password that was provided. 




1310




 





 





 





 





 





 



   




1311




 





 





 





 





 





 



     my $password = $db->password; 




1312




 





 





 





 





 





 



   




1313




 





 





 





 





 





 



 L can also be used to set a new C. 




1314




 





 





 





 





 





 



   




1315




 





 





 





 





 





 



     $db->password($new_password); 




1316




 





 





 





 





 





 



   




1317




 





 





 





 





 





 



 When setting a new C, it's likely you'll want to use L. 




1318




 





 





 





 





 





 



   




1319




 





 





 





 





 





 



 =cut 




1320




 





 





 





 





 





 



   




1321




 





 





 





 





 





 



 =head2 conf 




1322




 





 





 





 





 





 



   




1323




 





 





 





 





 





 



 L returns the conf file that was provided. 




1324




 





 





 





 





 





 



   




1325




 





 





 





 





 





 



     my $conf = $db->conf; 




1326




 





 





 





 





 





 



   




1327




 





 





 





 





 





 



 L can also be used to set a new C file. 




1328




 





 





 





 





 





 



   




1329




 





 





 





 





 





 



     $db->conf($new_conf); 




1330




 





 





 





 





 





 



   




1331




 





 





 





 





 





 



 When setting a new C, it's likely you'll want to use L. 




1332




 





 





 





 





 





 



   




1333




 





 





 





 





 





 



 =cut 




1334




 





 





 





 





 





 



   




1335




 





 





 





 





 





 



 =head2 connect 




1336




 





 





 





 





 





 



   




1337




 





 





 





 





 





 



 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: 




1338




 





 





 





 





 





 



   




1339




 





 





 





 





 





 



     #now there is a new dbh with the same DBIx::Raw object using the same settings 




1340




 





 





 





 





 





 



     $db->connect; 




1341




 





 





 





 





 





 



   




1342




 





 





 





 





 





 



 Or you can change the connect info.  




1343




 





 





 





 





 





 



 For example, if you update C, C, C: 




1344




 





 





 





 





 





 



   




1345




 





 





 





 





 





 



     $db->dsn('new_dsn'); 




1346




 





 





 





 





 





 



     $db->user('user'); 




1347




 





 





 





 





 





 



     $db->password('password'); 




1348




 





 





 





 





 





 



   




1349




 





 





 





 





 





 



     #get new dbh but keep same DBIx::Raw object 




1350




 





 





 





 





 





 



     $db->connect; 




1351




 





 





 





 





 





 



   




1352




 





 





 





 





 





 



 Or if you update the conf file: 




1353




 





 





 





 





 





 



   




1354




 





 





 





 





 





 



     $db->conf('/path/to/new_conf.pl'); 




1355




 





 





 





 





 





 



      




1356




 





 





 





 





 





 



     #get new dbh but keep same DBIx::Raw object 




1357




 





 





 





 





 





 



     $db->connect; 




1358




 





 





 





 





 





 



   




1359




 





 





 





 





 





 



 =cut 




1360




 





 





 





 





 





 



   




1361




 





 





 





 





 





 



 sub connect {  




1362




70





 





 




  
70
  



  
1
  




536



 	my ($self) = @_; 




1363




 





 





 





 





 





 



   




1364




70





 





 





 





 





632



 	$self->_parse_conf; 




1365




70





 





 





 





 





7010



 	$self->_validate_connect_info; 




1366




70





 




  
 33
  




 





 





3926



 	return $self->dbh(DBI->connect($self->dsn, $self->user, $self->password) or croak($DBI::errstr)); 




1367




 





 





 





 





 





 



 } 




1368




 





 





 





 





 





 



   




1369




 





 





 





 





 





 



 sub _params {  




1370




321





 





 




  
321
  




 





924



 	my $self = shift; 




1371




 





 





 





 





 





 



   




1372




321





 





 





 





 





854



 	my %params; 




1373




321




  
100
  




 





 





 





2312



 	unless($self->keys->{$_[0]}) { 




1374




43





 





 





 





 





270



 		$params{query} = shift; 




1375




43





 





 





 





 





188



 		$params{vals} = [@_]; 




1376




 





 





 





 





 





 



 	} 




1377




 





 





 





 





 





 



 	else {  




1378




278





 





 





 





 





3020



 		%params = @_; 




1379




 





 





 





 





 





 



 	} 




1380




 





 





 





 





 





 



   




1381




321





 





 





 





 





1669



 	return \%params; 




1382




 





 





 





 





 





 



 } 




1383




 





 





 





 





 





 



   




1384




 





 





 





 





 





 



 sub _query { 




1385




321





 





 




  
321
  




 





857



 	my ($self, $params) = (@_); 




1386




 





 





 





 





 





 



   




1387




321




  
 50
  




 





 





 





7884



 	$self->sth($self->dbh->prepare($params->{query})) or $self->_perish($params); 




1388




 





 





 





 





 





 



   




1389




321




  
100
  




 





 





 





27852



 	if($params->{'vals'}){ 




1390




227




  
 50
  




 





 





 





840



   		$self->sth->execute(@{$params->{'vals'}}) or $self->_perish($params); 




 




227





 





 





 





 





6579



   




1391




 





 





 





 





 





 



 	} 




1392




 





 





 





 





 





 



 	else { 




1393




94




  
 50
  




 





 





 





13226



   		$self->sth->execute() or $self->_perish($params); 




1394




 





 





 





 





 





 



 	} 




1395




 





 





 





 





 





 



 } 




1396




 





 





 





 





 





 



   




1397




 





 





 





 





 





 



 sub _perish {  




1398



  
0
  




 





 




  
0
  




 





0



 	my ($self, $params) = @_; 




1399



  
0
  




 





 





 





 





0



 	croak "ERROR: Can't prepare query.\n\n$DBI::errstr\n\nquery='" . $params->{query} . "'\n"; 




1400




 





 





 





 





 





 



 } 




1401




 





 





 





 





 





 



   




1402




 





 





 





 





 





 



 sub _crypt_decrypt {  




1403




31





 





 




  
31
  




 





279



 	my ($self, $params) = @_; 




1404




31





 





 





 





 





139



 	my @keys; 




1405




31




  
100
  




 





 





 





144



 	if($params->{decrypt} eq '*') {  




1406




8




  
100
  




 





 





 





56



 		if($params->{href}) {  




1407




6





 





 





 





 





42



 			@keys = keys %{$params->{href}}; 




 




6





 





 





 





 





39



   




1408




 





 





 





 





 





 



 		} 




1409




 





 





 





 





 





 



 		else {  




1410




2





 





 





 





 





6



 			@keys = 0..$#{$params->{return_values}}; 




 




2





 





 





 





 





13



   




1411




 





 





 





 





 





 



 		} 




1412




 





 





 





 





 





 



 	} 




1413




 





 





 





 





 





 



 	else {  




1414




23





 





 





 





 





94



 		@keys = @{$params->{decrypt}}; 




 




23





 





 





 





 





82



   




1415




 





 





 





 





 





 



 	} 




1416




 





 





 





 





 





 



   




1417




31




  
100
  




 





 





 





168



 	if($params->{href}) { 




1418




24





 





 





 





 





158



 		for my $key (@keys) { 




1419




47




  
 50
  




 





 





 





3164



 			$params->{href}->{$key} = $self->_decrypt($params->{href}->{$key}) if $params->{href}->{$key}; 




1420




 





 





 





 





 





 



 		} 	 




1421




 





 





 





 





 





 



 	} 




1422




 





 





 





 





 





 



 	else {  




1423




7





 





 





 





 





49



 		for my $index (@keys) { 




1424




12




  
 50
  




 





 





 





767



 			$params->{return_values}->[$index] = $self->_decrypt( $params->{return_values}->[$index] ) if $params->{return_values}->[$index]; 




1425




 





 





 





 





 





 



 		} 




1426




 





 





 





 





 





 



 	} 




1427




 





 





 





 





 





 



 } 




1428




 





 





 





 





 





 



   




1429




 





 





 





 





 





 



 sub _crypt_encrypt {  




1430




165





 





 




  
165
  




 





573



 	my ($self, $params) = @_; 




1431




165





 





 





 





 





353



 	my @indices;  




1432




 





 





 





 





 





 



   




1433




165




  
100
  




 





 





 





785



 	if($params->{encrypt} eq '*') {  




1434




4





 





 





 





 





18



 		my $num_question_marks = 0; 




1435




 





 





 





 





 





 



 		#don't want to encrypt where conditions! Might be buggy...should look into this more 




1436




4




  
 50
  




 





 





 





95



 		if($params->{query} =~ /WHERE\s+(.*)/i) {  




1437




4





 





 





 





 





66



 			$num_question_marks =()= $1 =~ /=\s*?\?/g; 




1438




 





 





 





 





 





 



 		} 




1439




 





 





 





 





 





 



   




1440




4





 





 





 





 





19



 		@indices = 0..($#{$params->{vals}} - $num_question_marks); 




 




4





 





 





 





 





19



   




1441




 





 





 





 





 





 



 	} 




1442




 





 





 





 





 





 



 	else {  




1443




161





 





 





 





 





353



 		@indices = @{$params->{encrypt}}; 




 




161





 





 





 





 





544



   




1444




 





 





 





 





 





 



 	} 




1445




 





 





 





 





 





 



   




1446




165





 





 





 





 





952



 	for my $index (@indices) { 




1447




80





 





 





 





 





207



    		@{$params->{vals}}[$index] = $self->_encrypt( @{$params->{vals}}[$index] ); 




 




80





 





 





 





 





45655



   




 




80





 





 





 





 





325



   




1448




 





 





 





 





 





 



 	} 




1449




 





 





 





 





 





 



 } 




1450




 





 





 





 





 





 



   




1451




 





 





 





 





 





 



 sub _encrypt {  




1452




80





 





 




  
80
  




 





205



 	my ($self, $text) = @_; 




1453




 





 





 





 





 





 



   




1454




80




  
 50
  




 





 





 





2269



     if ($self->use_old_crypt) { 




1455



  
0
  




 





 





 





 





0



         return $self->old_crypt->encrypt($text); 




1456




 





 





 





 





 





 



     } 




1457




 





 





 





 





 





 



   




1458




80





 





 





 





 





2285



     return $self->crypt->encrypt($text);  




1459




 





 





 





 





 





 



 } 




1460




 





 





 





 





 





 



   




1461




 





 





 





 





 





 



 sub _decrypt {  




1462




63





 





 




  
63
  




 





214



 	my ($self, $text) = @_; 




1463




 





 





 





 





 





 



      




1464




63




  
 50
  




 





 





 





1477



     if ($self->use_old_crypt) { 




1465




0





 





 





 





 





0



         return $self->old_crypt->decrypt($text); 




1466




 





 





 





 





 





 



     } 




1467




 





 





 





 





 





 



   




1468




63





 





 





 





 





1452



 	return $self->crypt->decrypt($text);  




1469




 





 





 





 





 





 



 } 




1470




 





 





 





 





 





 



   




1471




 





 





 





 





 





 



 sub _parse_conf {  




1472




140





 





 




  
140
  




 





1693



 	my ($self) = @_; 




1473




 





 





 





 





 





 



   




1474




 





 





 





 





 





 



 	#load in configuration if it exists 




1475




140




  
100
  




 





 





 





2008



 	if($self->conf) {  




1476




 





 





 





 





 





 



   




1477




 





 





 





 





 





 



 		#no need to read in settings again if conf hasn't changed, unless dsn, user, or password is unset 




1478




137




  
 50
  



  
100
  




 





 





5854



 		return if $self->conf eq $self->prev_conf and $self->dsn and $self->user and $self->password; 




 




 





 




  
 66
  




 





 





 



   




 




 





 




  
 66
  




 





 





 



   




1479




 





 





 





 





 





 



   




1480




137





 





 





 





 





11175



 		my $config = Config::Any->load_files({files =>[$self->conf],use_ext => 1  });  




1481




 





 





 





 





 





 



   




1482




137





 





 





 





 





1633771



 		for my $c (@$config){ 




1483




137





 





 





 





 





1399



   			for my $file (keys %$c){ 




1484




137





 





 





 





 





912



      			for my $attribute (keys %{$c->{$file}}){ 




 




137





 





 





 





 





1031



   




1485




412




  
 50
  




 





 





 





3562



 					if($self->can($attribute)) {  




1486




412





 





 





 





 





4279



 						$self->$attribute($c->{$file}->{$attribute}); 




1487




 





 





 





 





 





 



 					} 




1488




 





 





 





 





 





 



    				} 




1489




 





 





 





 





 





 



   			} 




1490




 





 





 





 





 





 



 		} 




1491




 





 





 





 





 





 



   




1492




137





 





 





 





 





11354



 		$self->prev_conf($self->conf); 




1493




 





 





 





 





 





 



 	} 




1494




 





 





 





 





 





 



 } 




1495




 





 





 





 





 





 



   




1496




 





 





 





 





 





 



 sub _validate_connect_info {  




1497




140





 





 




  
140
  




 





801



 	my ($self) = @_; 




1498




140




  
 50
  



  
 66
  




 





 





10536



 	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
  




 





 





 



   




1499




 





 





 





 





 





 



 		unless (defined $self->dsn and defined $self->user and defined $self->password) or defined $self->dbh; 




1500




 





 





 





 





 





 



 } 




1501




 





 





 





 





 





 



   




1502




 





 





 





 





 





 



 =head1 AUTHOR 




1503




 





 





 





 





 





 



   




1504




 





 





 





 





 





 



 Adam Hopkins, C<<  >> 




1505




 





 





 





 





 





 



   




1506




 





 





 





 





 





 



 =head1 BUGS 




1507




 





 





 





 





 





 



   




1508




 





 





 





 





 





 



 Please report any bugs or feature requests to C, or through 




1509




 





 





 





 





 





 



 the web interface at L.  I will be notified, and then you'll 




1510




 





 





 





 





 





 



 automatically be notified of progress on your bug as I make changes. 




1511




 





 





 





 





 





 



   




1512




 





 





 





 





 





 



 =head1 SUPPORT 




1513




 





 





 





 





 





 



   




1514




 





 





 





 





 





 



 You can find documentation for this module with the perldoc command. 




1515




 





 





 





 





 





 



   




1516




 





 





 





 





 





 



     perldoc DBIx::Raw 




1517




 





 





 





 





 





 



   




1518




 





 





 





 





 





 



   




1519




 





 





 





 





 





 



 You can also look for information at: 




1520




 





 





 





 





 





 



   




1521




 





 





 





 





 





 



 =over 4 




1522




 





 





 





 





 





 



   




1523




 





 





 





 





 





 



 =item * RT: CPAN's request tracker (report bugs here) 




1524




 





 





 





 





 





 



   




1525




 





 





 





 





 





 



 L 




1526




 





 





 





 





 





 



   




1527




 





 





 





 





 





 



 =item * AnnoCPAN: Annotated CPAN documentation 




1528




 





 





 





 





 





 



   




1529




 





 





 





 





 





 



 L 




1530




 





 





 





 





 





 



   




1531




 





 





 





 





 





 



 =item * CPAN Ratings 




1532




 





 





 





 





 





 



   




1533




 





 





 





 





 





 



 L 




1534




 





 





 





 





 





 



   




1535




 





 





 





 





 





 



 =item * Search CPAN 




1536




 





 





 





 





 





 



   




1537




 





 





 





 





 





 



 L 




1538




 





 





 





 





 





 



   




1539




 





 





 





 





 





 



 =back 




1540




 





 





 





 





 





 



   




1541




 





 





 





 





 





 



   




1542




 





 





 





 





 





 



 =head1 ACKNOWLEDGEMENTS 




1543




 





 





 





 





 





 



   




1544




 





 





 





 





 





 



 Special thanks to Jay Davis who wrote a lot of the original code that this module is based on. 




1545




 





 





 





 





 





 



   




1546




 





 





 





 





 





 



 =head1 LICENSE 




1547




 





 





 





 





 





 



   




1548




 





 





 





 





 





 



 This library is free software; you can redistribute it and/or modify 




1549




 





 





 





 





 





 



 it under the same terms as Perl itself. 




1550




 





 





 





 





 





 



   




1551




 





 





 





 





 





 



 =cut 




1552




 





 





 





 





 





 



   




1553




 





 





 





 





 





 



 1;

=back

L can be used to insert a single row with a hash. This can be useful if you already have the values you need
to insert the row with in a hash, where the keys are the column names and the values are the new values. This function
might be useful for submitting forms easily.

    my %person_to_insert = (
        name => 'Billy',
        age => '32',
        favorite_color => 'blue',
    );

    $db->insert(href => \%person_to_insert, table => 'people');

If you need to have literal SQL into your insert query, then you just need to pass in a scalar reference. For example:

    "INSERT INTO people (name, update_time) VALUES('Billy', NOW())"

If we had this:

    my %person_to_insert = (
        name => 'Billy',
        update_time => 'NOW()',
    );

    $db->insert(href => \%person_to_insert, table => 'people');

This would effectively evaluate to:

    $db->raw(query => "INSERT INTO people (name, update_time) VALUES(?, ?)", vals => ['Billy', 'NOW()']);

However, this will not work. Instead, we need to do:

    my %person_to_insert = (
        name => 'Billy',
        update_time => \'NOW()',
    );

    $db->insert(href => \%person_to_insert, table => 'people');

Which evaluates to:

    $db->raw(query => "INSERT INTO people (name, update_time) VALUES(?, NOW())", vals => ['Billy']);

And this is what we want.

=head3 insert encrypt

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
instead of the indices for the order in which the columns are listed:

    my %person_to_insert = (
        name => 'Billy',
        age => '32',
        favorite_color => 'blue',
    );

    $db->insert(href => \%person_to_insert, table => 'people', encrypt => ['name', 'favorite_color']);

Note we do not ecnrypt age because it is most likely stored as an integer in the database.

=cut

# TODO: write insert tests
sub insert {
	my $self = shift;
	my $params = $self->_params(@_);

	croak "href and table are required for insert" unless $params->{href} and $params->{table};

	my @vals;
	my $column_names = '';
	my $values_string = '';
    my @encrypt;
	while(my ($key,$val) = each %{$params->{href}}) {
		my $append = '?';
		if (ref $val eq 'SCALAR') {
			$append = $$val;
		}
		else {
            if ($params->{encrypt} and first { $_ eq $key } @{$params->{encrypt}}) {
                push @encrypt, scalar(@vals);
            }

			push @vals, $val;
		}

        $column_names .= "$key,";
        $values_string .= "$append,";
	}

	$column_names = substr $column_names, 0, -1;
	$values_string = substr $values_string, 0, -1;

	$params->{query} = "INSERT INTO $params->{table} ($column_names) VALUES($values_string)";
	$params->{vals} = \@vals;

    if ($params->{encrypt} and @encrypt) {
        $params->{encrypt} = \@encrypt;
	    $self->_crypt_encrypt($params);
    }

	$self->_query($params);
}

=head2 update

=over

=item

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

=item

B - the name of the table that the updated row is in 




1014




 





 





 





 





 





 



   




1015




 





 





 





 





 





 



 =item  




1016




 





 





 





 





 





 



   




1017




 





 





 





 





 





 



 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 




1018




 





 





 





 





 





 



   




1019




 





 





 





 





 





 



 =item  




1020




 





 





 





 





 





 



   




1021




 





 





 





 





 





 



 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 




1022




 





 





 





 





 





 



   




1023




 





 





 





 





 





 



 =item  




1024




 





 





 





 





 





 



   




1025




 





 





 





 





 





 



 B - A where clause to help decide what row to update. Any bind values can be passed in with C 




1026




 





 





 





 





 





 



   




1027




 





 





 





 





 





 



 =back 




1028




 





 





 





 





 





 



   




1029




 





 





 





 





 





 



 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 




1030




 





 





 





 





 





 



 to update the row with in a hash, where the keys are the column names and the values are the new values. This function 




1031




 





 





 





 





 





 



 might be useful for submitting forms easily. 




1032




 





 





 





 





 





 



   




1033




 





 





 





 





 





 



     my %updated_person = (  




1034




 





 





 





 





 





 



         name => 'Billy', 




1035




 





 





 





 





 





 



         age => '32', 




1036




 





 





 





 





 





 



         favorite_color => 'blue', 




1037




 





 





 





 





 





 



     ); 




1038




 





 





 





 





 





 



   




1039




 





 





 





 





 





 



     my $num_rows_updated = $db->update(href => \%updated_person, table => 'people', id => 1); 




1040




 





 





 





 





 





 



   




1041




 





 





 





 





 





 



     # or in list context 




1042




 





 





 





 





 





 



     my ($num_rows_updated) = $db->update(href => \%updated_person, table => 'people', id => 1); 




1043




 





 





 





 





 





 



   




1044




 





 





 





 





 





 



 Note that above for "id", the column must actually be named id for it to work. If you have a primary key or unique 




1045




 





 





 





 





 





 



 identifying column that is named something different than id, then you can use the C parameter: 




1046




 





 





 





 





 





 



   




1047




 





 





 





 





 





 



     my $num_rows_updated = $db->update(href => \%updated_person, table => 'people', pk => {name => 'person_id', val => 1}); 




1048




 





 





 





 





 





 



   




1049




 





 





 





 





 





 



 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: 




1050




 





 





 





 





 





 



   




1051




 





 





 





 





 





 



     my $num_rows_updated = $db->update(href => \%updated_person, table => 'people', where => 'name=? AND favorite_color=? AND age=?', vals => ['Joe', 'green', 61]); 




1052




 





 





 





 





 





 



      




1053




 





 





 





 





 





 



 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: 




1054




 





 





 





 





 





 



   




1055




 





 





 





 





 





 



     my $num_rows_updated = $db->update(href => \%updated_person, table => 'people', where => 'name=? AND favorite_color=? AND age=?', vals => ['Joe', 'green', 61], id => 1); 




1056




 





 





 





 





 





 



   




1057




 





 





 





 





 





 



 Alternatively, you could just put the C or C in your where clause. 




1058




 





 





 





 





 





 



   




1059




 





 





 





 





 





 



 If you need to have literal SQL into your update query, then you just need to pass in a scalar reference. For example: 




1060




 





 





 





 





 





 



   




1061




 





 





 





 





 





 



     "UPDATE people SET name='Billy', update_time=NOW() WHERE id=1" 




1062




 





 





 





 





 





 



   




1063




 





 





 





 





 





 



 If we had this: 




1064




 





 





 





 





 





 



   




1065




 





 





 





 





 





 



     my %updated_person = ( 




1066




 





 





 





 





 





 



         name => 'Billy', 




1067




 





 





 





 





 





 



         update_time => 'NOW()', 




1068




 





 





 





 





 





 



     ); 




1069




 





 





 





 





 





 



   




1070




 





 





 





 





 





 



     my $num_rows_updated = $db->update(href => \%updated_person, table => 'people', id => 1); 




1071




 





 





 





 





 





 



   




1072




 





 





 





 





 





 



 This would effectively evaluate to: 




1073




 





 





 





 





 





 



   




1074




 





 





 





 





 





 



     my $num_rows_updated = $db->raw(query => "UPDATE people SET name=?, update_time=? WHERE id=?", vals => ['Billy', 'NOW()', 1]); 




1075




 





 





 





 





 





 



   




1076




 





 





 





 





 





 



 However, this will not work. Instead, we need to do: 




1077




 





 





 





 





 





 



   




1078




 





 





 





 





 





 



     my %updated_person = ( 




1079




 





 





 





 





 





 



         name => 'Billy', 




1080




 





 





 





 





 





 



         update_time => \'NOW()', 




1081




 





 





 





 





 





 



     ); 




1082




 





 





 





 





 





 



   




1083




 





 





 





 





 





 



     my $num_rows_updated = $db->update(href => \%updated_person, table => 'people', id => 1); 




1084




 





 





 





 





 





 



   




1085




 





 





 





 





 





 



 Which evaluates to: 




1086




 





 





 





 





 





 



   




1087




 





 





 





 





 





 



     my $num_rows_updated = $db->raw(query => "UPDATE people SET name=?, update_time=NOW() WHERE id=?", vals => ['Billy', 1]); 




1088




 





 





 





 





 





 



   




1089




 





 





 





 





 





 



 And this is what we want. 




1090




 





 





 





 





 





 



   




1091




 





 





 





 





 





 



 =head3 update encrypt 




1092




 





 





 





 





 





 



   




1093




 





 





 





 





 





 



 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  




1094




 





 





 





 





 





 



 instead of the indices for the order in which the columns are listed: 




1095




 





 





 





 





 





 



   




1096




 





 





 





 





 





 



     my %updated_person = (  




1097




 





 





 





 





 





 



         name => 'Billy', 




1098




 





 





 





 





 





 



         age => '32', 




1099




 





 





 





 





 





 



         favorite_color => 'blue', 




1100




 





 





 





 





 





 



     ); 




1101




 





 





 





 





 





 



   




1102




 





 





 





 





 





 



     my $num_rows_updated = $db->update(href => \%updated_person, table => 'people', id => 1, encrypt => ['name', 'favorite_color']); 




1103




 





 





 





 





 





 



   




1104




 





 





 





 





 





 



 Note we do not ecnrypt age because it is most likely stored as an integer in the database. 




1105




 





 





 





 





 





 



   




1106




 





 





 





 





 





 



 =cut 




1107




 





 





 





 





 





 



   




1108




 





 





 





 





 





 



 sub update { 




1109




17





 





 




  
17
  



  
1
  




1003



 	my $self = shift; 




1110




17





 





 





 





 





100



 	my $params = $self->_params(@_); 




1111




 





 





 





 





 





 



   




1112




17




  
 50
  



  
 33
  




 





 





332



 	croak "href and table are required for update" unless $params->{href} and $params->{table}; 




1113




 





 





 





 





 





 



   




1114




17





 





 





 





 





111



 	my @vals; 




1115




17





 





 





 





 





94



 	my $string = ''; 




1116




17





 





 





 





 





60



     my @encrypt; 




1117




17





 





 





 





 





74



 	while(my ($key,$val) = each %{$params->{href}}) {  




 




68





 





 





 





 





338



   




1118




51





 





 





 





 





141



 		my $append = '?'; 




1119




51




  
100
  




 





 





 





159



 		if (ref $val eq 'SCALAR') { 




1120




3





 





 





 





 





13



 			$append = $$val; 




1121




 





 





 





 





 





 



 		} 




1122




 





 





 





 





 





 



 		else {  




1123




 





 





 





 





 





 



             # TODO: write update encrypt tests 




1124




48




  
100
  



  
 66
  




 





 





509



             if ((defined $params->{encrypt} and $params->{encrypt} eq '*')  




 




 





 




  
 33
  




 





 





 



   




 




 





 




  
 66
  




 





 





 



   




1125



  
0
  




 





 




  
0
  




 





0



                     or ($params->{encrypt} and first { $_ eq $key } @{$params->{encrypt}})) { 




 



  
0
  




 





 





 





 





0



   




1126




24





 





 





 





 





74



                 push @encrypt, scalar(@vals); 




1127




 





 





 





 





 





 



             } 




1128




 





 





 





 





 





 



   




1129




48





 





 





 





 





151



 			push @vals, $val; 




1130




 





 





 





 





 





 



 		} 




1131




 





 





 





 





 





 



   




1132




51





 





 





 





 





187



 		$string .= "$key=$append,"; 




1133




 





 





 





 





 





 



 	} 




1134




 





 





 





 





 





 



 	 




1135




17





 





 





 





 





86



 	$string = substr $string, 0, -1; 




1136




 





 





 





 





 





 



   




1137




17




  
100
  




 





 





 





99



 	$params->{vals} = [] unless $params->{vals}; 




1138




17





 





 





 





 





74



 	my $where = ''; 




1139




17




  
100
  




 





 





 





80



 	if($params->{where}) {  




1140




10





 





 





 





 





40



 		$where = " WHERE $params->{where}";	 




1141




10





 





 





 





 





45



 		push @vals, @{$params->{vals}}; 




 




10





 





 





 





 





31



   




1142




 





 





 





 





 





 



 	} 




1143




 





 





 





 





 





 



   




1144




17




  
100
  




 





 





 





100



 	if($params->{id}) {  




 




 




  
100
  




 





 





 





 



   




1145




5




  
100
  




 





 





 





27



 		if($where eq '') {  




1146




3





 





 





 





 





16



 			$where = " WHERE id=? ";	 




1147




 





 





 





 





 





 



 		}	 




1148




 





 





 





 





 





 



 		else {  




1149




2





 





 





 





 





6



 			$where .= " AND id=? "; 




1150




 





 





 





 





 





 



 		} 




1151




 





 





 





 





 





 



   




1152




5





 





 





 





 





20



 		push @vals, $params->{id}; 




1153




 





 





 





 





 





 



 	} 




1154




 





 





 





 





 





 



 	elsif($params->{pk}) {  




1155




6





 





 





 





 





23



 		my $name = $params->{pk}->{name}; 




1156




6





 





 





 





 





29



 		my $val = $params->{pk}->{val}; 




1157




6




  
100
  




 





 





 





29



 		if($where eq '') {  




1158




2





 





 





 





 





12



 			$where = " WHERE $name=? ";	 




1159




 





 





 





 





 





 



 		}	 




1160




 





 





 





 





 





 



 		else {  




1161




4





 





 





 





 





20



 			$where .= " AND $name=? "; 




1162




 





 





 





 





 





 



 		} 




1163




 





 





 





 





 





 



   




1164




6





 





 





 





 





24



 		push @vals, $val; 




1165




 





 





 





 





 





 



 	} 




1166




 





 





 





 





 





 



   




1167




17





 





 





 





 





110



 	$params->{query} = "UPDATE $params->{table} SET $string $where"; 




1168




17





 





 





 





 





70



 	$params->{vals} = \@vals; 




1169




 





 





 





 





 





 



   




1170




17




  
100
  



  
 66
  




 





 





163



     if ($params->{encrypt} and @encrypt) { 




1171




8





 





 





 





 





32



         $params->{encrypt} = \@encrypt; 




1172




8





 





 





 





 





39



 	    $self->_crypt_encrypt($params); 




1173




 





 





 





 





 





 



     } 




1174




 





 





 





 





 





 



   




1175




17





 





 





 





 





82



 	$self->_query($params); 




1176




 





 





 





 





 





 



   




1177




17




  
 50
  




 





 





 





254



     return unless defined wantarray; 




1178



  
0
  



  
  0
  




 





 





 





0



     return wantarray ? ($self->sth->rows()) : $self->sth->rows(); 




1179




 





 





 





 





 





 



 }  




1180




 





 





 





 





 





 



   




1181




 





 





 





 





 





 



 =head2 insert_multiple 




1182




 





 





 





 





 





 



   




1183




 





 





 





 





 





 



 =over 




1184




 





 





 





 





 





 



   




1185




 





 





 





 





 





 



 =item  




1186




 





 





 





 





 





 



   




1187




 





 





 





 





 





 



 B - the array reference of array references, where each inner array reference holds the values to be inserted for one row 




1188




 





 





 





 





 





 



   




1189




 





 





 





 





 





 



 =item  




1190




 





 





 





 





 





 



   




1191




 





 





 





 





 





 



 B - the name of the table that the rows are to be inserted into 




1192




 





 





 





 





 





 



   




1193




 





 





 





 





 





 



 =item  




1194




 





 





 





 





 





 



   




1195




 





 





 





 





 





 



 B - The names of the columns that values are being inserted for 




1196




 





 





 





 





 





 



   




1197




 





 





 





 





 





 



 =back 




1198




 





 





 





 





 





 



   




1199




 





 





 





 





 





 



 L can be used to insert multiple rows with one query. For instance: 




1200




 





 





 





 





 





 



   




1201




 





 





 





 





 





 



     my $rows = [ 




1202




 





 





 





 





 





 



         [ 




1203




 





 





 





 





 





 



             1, 




1204




 





 





 





 





 





 



             'Joe', 




1205




 





 





 





 





 





 



             23, 




1206




 





 





 





 





 





 



         ], 




1207




 





 





 





 





 





 



         [ 




1208




 





 





 





 





 





 



             2, 




1209




 





 





 





 





 





 



             'Ralph, 




1210




 





 





 





 





 





 



             50, 




1211




 





 





 





 





 





 



         ], 




1212




 





 





 





 





 





 



     ]; 




1213




 





 





 





 





 





 



   




1214




 





 





 





 





 





 



     $db->insert_multiple(table => 'people', columns => [qw/id name age/], rows => $rows); 




1215




 





 





 





 





 





 



   




1216




 





 





 





 





 





 



 This can be translated into the SQL query: 




1217




 





 





 





 





 





 



   




1218




 





 





 





 





 





 



     INSERT INTO people (id, name, age) VALUES (1, 'Joe', 23), (2, 'Ralph', 50); 




1219




 





 





 





 





 





 



   




1220




 





 





 





 





 





 



 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 




1221




 





 





 





 





 





 



 try to speed things up! 




1222




 





 





 





 





 





 



   




1223




 





 





 





 





 





 



 =cut 




1224




 





 





 





 





 





 



   




1225




 





 





 





 





 





 



 sub insert_multiple { 




1226




1





 





 




  
1
  



  
1
  




49



 	my $self = shift; 




1227




1





 





 





 





 





5



 	my $params = $self->_params(@_); 




1228




 





 





 





 





 





 



   




1229




1





 





 





 





 





10



 	while(my ($key, $val) = each %$params) {  




1230




3





 





 





 





 





85



 		print "$key=$val\n"; 




1231




 





 





 





 





 





 



 	} 




1232




 





 





 





 





 





 



   




1233




1




  
 50
  



  
 33
  




 





 





24



 	croak "columns, table, and rows are required for insert_multiple" unless $params->{columns} and $params->{table} and $params->{rows}; 




 




 





 




  
 33
  




 





 





 



   




1234




 





 





 





 





 





 



   




1235




1





 





 





 





 





3



 	my $values_string = ''; 




1236




1





 





 





 





 





2



 	my @vals; 




1237




 





 





 





 





 





 



   




1238




1





 





 





 





 





4



 	my $columns = join ',', @{$params->{columns}}; 




 




1





 





 





 





 





9



   




1239




1





 





 





 





 





7



 	my $row_string = '?,' x @{$params->{columns}}; 




 




1





 





 





 





 





4



   




1240




1





 





 





 





 





4



 	$row_string = substr $row_string, 0, -1; 




1241




 





 





 





 





 





 



   




1242




1





 





 





 





 





2



 	for my $row (@{$params->{rows}}) {  




 




1





 





 





 





 





7



   




1243




2





 





 





 





 





13



 		push @vals, @$row; 




1244




2





 





 





 





 





13



 		$values_string .= "($row_string),";		 




1245




 





 





 





 





 





 



 	} 




1246




 





 





 





 





 





 



   




1247




1





 





 





 





 





9



 	$values_string = substr $values_string, 0, -1; 




1248




 





 





 





 





 





 



   




1249




1





 





 





 





 





6



 	$params->{query} = "INSERT INTO $params->{table} ($columns) VALUES $values_string"; 




1250




1





 





 





 





 





9



 	print $params->{query} . "\n"; 




1251




1





 





 





 





 





4



 	$params->{vals} = \@vals; 




1252




 





 





 





 





 





 



   




1253




1





 





 





 





 





5



 	$self->_query($params); 




1254




 





 





 





 





 





 



 }  




1255




 





 





 





 





 





 



   




1256




 





 





 





 





 





 



 =head2 sth 




1257




 





 





 





 





 





 



   




1258




 





 





 





 





 





 



 L returns the statement handle from the previous query. 




1259




 





 





 





 





 





 



   




1260




 





 





 





 





 





 



     my $sth = $db->sth; 




1261




 





 





 





 





 





 



   




1262




 





 





 





 





 





 



 This can be useful if you need a statement handle to perform a function, like to get 




1263




 





 





 





 





 





 



 the id of the last inserted row. 




1264




 





 





 





 





 





 



   




1265




 





 





 





 





 





 



 =cut 




1266




 





 





 





 





 





 



   




1267




 





 





 





 





 





 



 =head2 dbh 




1268




 





 





 





 





 





 



   




1269




 





 





 





 





 





 



 L returns the database handle that L is using. 




1270




 





 





 





 





 





 



   




1271




 





 





 





 





 





 



     my $dbh = $db->dbh; 




1272




 





 





 





 





 





 



   




1273




 





 





 





 





 





 



 L can also be used to set a new database handle for L to use. 




1274




 





 





 





 





 





 



   




1275




 





 





 





 





 





 



     $db->dbh($new_dbh); 




1276




 





 





 





 





 





 



   




1277




 





 





 





 





 





 



 =cut 




1278




 





 





 





 





 





 



   




1279




 





 





 





 





 





 



 =head2 dsn 




1280




 





 





 





 





 





 



   




1281




 





 





 





 





 





 



 L returns the dsn that was provided. 




1282




 





 





 





 





 





 



   




1283




 





 





 





 





 





 



     my $dsn = $db->dsn; 




1284




 





 





 





 





 





 



   




1285




 





 





 





 





 





 



 L can also be used to set a new C. 




1286




 





 





 





 





 





 



   




1287




 





 





 





 





 





 



     $db->dsn($new_dsn); 




1288




 





 





 





 





 





 



   




1289




 





 





 





 





 





 



 When setting a new C, it's likely you'll want to use L. 




1290




 





 





 





 





 





 



   




1291




 





 





 





 





 





 



 =cut 




1292




 





 





 





 





 





 



   




1293




 





 





 





 





 





 



 =head2 user 




1294




 





 





 





 





 





 



   




1295




 





 





 





 





 





 



 L returns the user that was provided. 




1296




 





 





 





 





 





 



   




1297




 





 





 





 





 





 



     my $user = $db->user; 




1298




 





 





 





 





 





 



   




1299




 





 





 





 





 





 



 L can also be used to set a new C. 




1300




 





 





 





 





 





 



   




1301




 





 





 





 





 





 



     $db->user($new_user); 




1302




 





 





 





 





 





 



   




1303




 





 





 





 





 





 



 When setting a new C, it's likely you'll want to use L. 




1304




 





 





 





 





 





 



   




1305




 





 





 





 





 





 



 =cut 




1306




 





 





 





 





 





 



   




1307




 





 





 





 





 





 



 =head2 password 




1308




 





 





 





 





 





 



   




1309




 





 





 





 





 





 



 L returns the password that was provided. 




1310




 





 





 





 





 





 



   




1311




 





 





 





 





 





 



     my $password = $db->password; 




1312




 





 





 





 





 





 



   




1313




 





 





 





 





 





 



 L can also be used to set a new C. 




1314




 





 





 





 





 





 



   




1315




 





 





 





 





 





 



     $db->password($new_password); 




1316




 





 





 





 





 





 



   




1317




 





 





 





 





 





 



 When setting a new C, it's likely you'll want to use L. 




1318




 





 





 





 





 





 



   




1319




 





 





 





 





 





 



 =cut 




1320




 





 





 





 





 





 



   




1321




 





 





 





 





 





 



 =head2 conf 




1322




 





 





 





 





 





 



   




1323




 





 





 





 





 





 



 L returns the conf file that was provided. 




1324




 





 





 





 





 





 



   




1325




 





 





 





 





 





 



     my $conf = $db->conf; 




1326




 





 





 





 





 





 



   




1327




 





 





 





 





 





 



 L can also be used to set a new C file. 




1328




 





 





 





 





 





 



   




1329




 





 





 





 





 





 



     $db->conf($new_conf); 




1330




 





 





 





 





 





 



   




1331




 





 





 





 





 





 



 When setting a new C, it's likely you'll want to use L. 




1332




 





 





 





 





 





 



   




1333




 





 





 





 





 





 



 =cut 




1334




 





 





 





 





 





 



   




1335




 





 





 





 





 





 



 =head2 connect 




1336




 





 





 





 





 





 



   




1337




 





 





 





 





 





 



 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: 




1338




 





 





 





 





 





 



   




1339




 





 





 





 





 





 



     #now there is a new dbh with the same DBIx::Raw object using the same settings 




1340




 





 





 





 





 





 



     $db->connect; 




1341




 





 





 





 





 





 



   




1342




 





 





 





 





 





 



 Or you can change the connect info.  




1343




 





 





 





 





 





 



 For example, if you update C, C, C: 




1344




 





 





 





 





 





 



   




1345




 





 





 





 





 





 



     $db->dsn('new_dsn'); 




1346




 





 





 





 





 





 



     $db->user('user'); 




1347




 





 





 





 





 





 



     $db->password('password'); 




1348




 





 





 





 





 





 



   




1349




 





 





 





 





 





 



     #get new dbh but keep same DBIx::Raw object 




1350




 





 





 





 





 





 



     $db->connect; 




1351




 





 





 





 





 





 



   




1352




 





 





 





 





 





 



 Or if you update the conf file: 




1353




 





 





 





 





 





 



   




1354




 





 





 





 





 





 



     $db->conf('/path/to/new_conf.pl'); 




1355




 





 





 





 





 





 



      




1356




 





 





 





 





 





 



     #get new dbh but keep same DBIx::Raw object 




1357




 





 





 





 





 





 



     $db->connect; 




1358




 





 





 





 





 





 



   




1359




 





 





 





 





 





 



 =cut 




1360




 





 





 





 





 





 



   




1361




 





 





 





 





 





 



 sub connect {  




1362




70





 





 




  
70
  



  
1
  




536



 	my ($self) = @_; 




1363




 





 





 





 





 





 



   




1364




70





 





 





 





 





632



 	$self->_parse_conf; 




1365




70





 





 





 





 





7010



 	$self->_validate_connect_info; 




1366




70





 




  
 33
  




 





 





3926



 	return $self->dbh(DBI->connect($self->dsn, $self->user, $self->password) or croak($DBI::errstr)); 




1367




 





 





 





 





 





 



 } 




1368




 





 





 





 





 





 



   




1369




 





 





 





 





 





 



 sub _params {  




1370




321





 





 




  
321
  




 





924



 	my $self = shift; 




1371




 





 





 





 





 





 



   




1372




321





 





 





 





 





854



 	my %params; 




1373




321




  
100
  




 





 





 





2312



 	unless($self->keys->{$_[0]}) { 




1374




43





 





 





 





 





270



 		$params{query} = shift; 




1375




43





 





 





 





 





188



 		$params{vals} = [@_]; 




1376




 





 





 





 





 





 



 	} 




1377




 





 





 





 





 





 



 	else {  




1378




278





 





 





 





 





3020



 		%params = @_; 




1379




 





 





 





 





 





 



 	} 




1380




 





 





 





 





 





 



   




1381




321





 





 





 





 





1669



 	return \%params; 




1382




 





 





 





 





 





 



 } 




1383




 





 





 





 





 





 



   




1384




 





 





 





 





 





 



 sub _query { 




1385




321





 





 




  
321
  




 





857



 	my ($self, $params) = (@_); 




1386




 





 





 





 





 





 



   




1387




321




  
 50
  




 





 





 





7884



 	$self->sth($self->dbh->prepare($params->{query})) or $self->_perish($params); 




1388




 





 





 





 





 





 



   




1389




321




  
100
  




 





 





 





27852



 	if($params->{'vals'}){ 




1390




227




  
 50
  




 





 





 





840



   		$self->sth->execute(@{$params->{'vals'}}) or $self->_perish($params); 




 




227





 





 





 





 





6579



   




1391




 





 





 





 





 





 



 	} 




1392




 





 





 





 





 





 



 	else { 




1393




94




  
 50
  




 





 





 





13226



   		$self->sth->execute() or $self->_perish($params); 




1394




 





 





 





 





 





 



 	} 




1395




 





 





 





 





 





 



 } 




1396




 





 





 





 





 





 



   




1397




 





 





 





 





 





 



 sub _perish {  




1398



  
0
  




 





 




  
0
  




 





0



 	my ($self, $params) = @_; 




1399



  
0
  




 





 





 





 





0



 	croak "ERROR: Can't prepare query.\n\n$DBI::errstr\n\nquery='" . $params->{query} . "'\n"; 




1400




 





 





 





 





 





 



 } 




1401




 





 





 





 





 





 



   




1402




 





 





 





 





 





 



 sub _crypt_decrypt {  




1403




31





 





 




  
31
  




 





279



 	my ($self, $params) = @_; 




1404




31





 





 





 





 





139



 	my @keys; 




1405




31




  
100
  




 





 





 





144



 	if($params->{decrypt} eq '*') {  




1406




8




  
100
  




 





 





 





56



 		if($params->{href}) {  




1407




6





 





 





 





 





42



 			@keys = keys %{$params->{href}}; 




 




6





 





 





 





 





39



   




1408




 





 





 





 





 





 



 		} 




1409




 





 





 





 





 





 



 		else {  




1410




2





 





 





 





 





6



 			@keys = 0..$#{$params->{return_values}}; 




 




2





 





 





 





 





13



   




1411




 





 





 





 





 





 



 		} 




1412




 





 





 





 





 





 



 	} 




1413




 





 





 





 





 





 



 	else {  




1414




23





 





 





 





 





94



 		@keys = @{$params->{decrypt}}; 




 




23





 





 





 





 





82



   




1415




 





 





 





 





 





 



 	} 




1416




 





 





 





 





 





 



   




1417




31




  
100
  




 





 





 





168



 	if($params->{href}) { 




1418




24





 





 





 





 





158



 		for my $key (@keys) { 




1419




47




  
 50
  




 





 





 





3164



 			$params->{href}->{$key} = $self->_decrypt($params->{href}->{$key}) if $params->{href}->{$key}; 




1420




 





 





 





 





 





 



 		} 	 




1421




 





 





 





 





 





 



 	} 




1422




 





 





 





 





 





 



 	else {  




1423




7





 





 





 





 





49



 		for my $index (@keys) { 




1424




12




  
 50
  




 





 





 





767



 			$params->{return_values}->[$index] = $self->_decrypt( $params->{return_values}->[$index] ) if $params->{return_values}->[$index]; 




1425




 





 





 





 





 





 



 		} 




1426




 





 





 





 





 





 



 	} 




1427




 





 





 





 





 





 



 } 




1428




 





 





 





 





 





 



   




1429




 





 





 





 





 





 



 sub _crypt_encrypt {  




1430




165





 





 




  
165
  




 





573



 	my ($self, $params) = @_; 




1431




165





 





 





 





 





353



 	my @indices;  




1432




 





 





 





 





 





 



   




1433




165




  
100
  




 





 





 





785



 	if($params->{encrypt} eq '*') {  




1434




4





 





 





 





 





18



 		my $num_question_marks = 0; 




1435




 





 





 





 





 





 



 		#don't want to encrypt where conditions! Might be buggy...should look into this more 




1436




4




  
 50
  




 





 





 





95



 		if($params->{query} =~ /WHERE\s+(.*)/i) {  




1437




4





 





 





 





 





66



 			$num_question_marks =()= $1 =~ /=\s*?\?/g; 




1438




 





 





 





 





 





 



 		} 




1439




 





 





 





 





 





 



   




1440




4





 





 





 





 





19



 		@indices = 0..($#{$params->{vals}} - $num_question_marks); 




 




4





 





 





 





 





19



   




1441




 





 





 





 





 





 



 	} 




1442




 





 





 





 





 





 



 	else {  




1443




161





 





 





 





 





353



 		@indices = @{$params->{encrypt}}; 




 




161





 





 





 





 





544



   




1444




 





 





 





 





 





 



 	} 




1445




 





 





 





 





 





 



   




1446




165





 





 





 





 





952



 	for my $index (@indices) { 




1447




80





 





 





 





 





207



    		@{$params->{vals}}[$index] = $self->_encrypt( @{$params->{vals}}[$index] ); 




 




80





 





 





 





 





45655



   




 




80





 





 





 





 





325



   




1448




 





 





 





 





 





 



 	} 




1449




 





 





 





 





 





 



 } 




1450




 





 





 





 





 





 



   




1451




 





 





 





 





 





 



 sub _encrypt {  




1452




80





 





 




  
80
  




 





205



 	my ($self, $text) = @_; 




1453




 





 





 





 





 





 



   




1454




80




  
 50
  




 





 





 





2269



     if ($self->use_old_crypt) { 




1455



  
0
  




 





 





 





 





0



         return $self->old_crypt->encrypt($text); 




1456




 





 





 





 





 





 



     } 




1457




 





 





 





 





 





 



   




1458




80





 





 





 





 





2285



     return $self->crypt->encrypt($text);  




1459




 





 





 





 





 





 



 } 




1460




 





 





 





 





 





 



   




1461




 





 





 





 





 





 



 sub _decrypt {  




1462




63





 





 




  
63
  




 





214



 	my ($self, $text) = @_; 




1463




 





 





 





 





 





 



      




1464




63




  
 50
  




 





 





 





1477



     if ($self->use_old_crypt) { 




1465




0





 





 





 





 





0



         return $self->old_crypt->decrypt($text); 




1466




 





 





 





 





 





 



     } 




1467




 





 





 





 





 





 



   




1468




63





 





 





 





 





1452



 	return $self->crypt->decrypt($text);  




1469




 





 





 





 





 





 



 } 




1470




 





 





 





 





 





 



   




1471




 





 





 





 





 





 



 sub _parse_conf {  




1472




140





 





 




  
140
  




 





1693



 	my ($self) = @_; 




1473




 





 





 





 





 





 



   




1474




 





 





 





 





 





 



 	#load in configuration if it exists 




1475




140




  
100
  




 





 





 





2008



 	if($self->conf) {  




1476




 





 





 





 





 





 



   




1477




 





 





 





 





 





 



 		#no need to read in settings again if conf hasn't changed, unless dsn, user, or password is unset 




1478




137




  
 50
  



  
100
  




 





 





5854



 		return if $self->conf eq $self->prev_conf and $self->dsn and $self->user and $self->password; 




 




 





 




  
 66
  




 





 





 



   




 




 





 




  
 66
  




 





 





 



   




1479




 





 





 





 





 





 



   




1480




137





 





 





 





 





11175



 		my $config = Config::Any->load_files({files =>[$self->conf],use_ext => 1  });  




1481




 





 





 





 





 





 



   




1482




137





 





 





 





 





1633771



 		for my $c (@$config){ 




1483




137





 





 





 





 





1399



   			for my $file (keys %$c){ 




1484




137





 





 





 





 





912



      			for my $attribute (keys %{$c->{$file}}){ 




 




137





 





 





 





 





1031



   




1485




412




  
 50
  




 





 





 





3562



 					if($self->can($attribute)) {  




1486




412





 





 





 





 





4279



 						$self->$attribute($c->{$file}->{$attribute}); 




1487




 





 





 





 





 





 



 					} 




1488




 





 





 





 





 





 



    				} 




1489




 





 





 





 





 





 



   			} 




1490




 





 





 





 





 





 



 		} 




1491




 





 





 





 





 





 



   




1492




137





 





 





 





 





11354



 		$self->prev_conf($self->conf); 




1493




 





 





 





 





 





 



 	} 




1494




 





 





 





 





 





 



 } 




1495




 





 





 





 





 





 



   




1496




 





 





 





 





 





 



 sub _validate_connect_info {  




1497




140





 





 




  
140
  




 





801



 	my ($self) = @_; 




1498




140




  
 50
  



  
 66
  




 





 





10536



 	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
  




 





 





 



   




1499




 





 





 





 





 





 



 		unless (defined $self->dsn and defined $self->user and defined $self->password) or defined $self->dbh; 




1500




 





 





 





 





 





 



 } 




1501




 





 





 





 





 





 



   




1502




 





 





 





 





 





 



 =head1 AUTHOR 




1503




 





 





 





 





 





 



   




1504




 





 





 





 





 





 



 Adam Hopkins, C<<  >> 




1505




 





 





 





 





 





 



   




1506




 





 





 





 





 





 



 =head1 BUGS 




1507




 





 





 





 





 





 



   




1508




 





 





 





 





 





 



 Please report any bugs or feature requests to C, or through 




1509




 





 





 





 





 





 



 the web interface at L.  I will be notified, and then you'll 




1510




 





 





 





 





 





 



 automatically be notified of progress on your bug as I make changes. 




1511




 





 





 





 





 





 



   




1512




 





 





 





 





 





 



 =head1 SUPPORT 




1513




 





 





 





 





 





 



   




1514




 





 





 





 





 





 



 You can find documentation for this module with the perldoc command. 




1515




 





 





 





 





 





 



   




1516




 





 





 





 





 





 



     perldoc DBIx::Raw 




1517




 





 





 





 





 





 



   




1518




 





 





 





 





 





 



   




1519




 





 





 





 





 





 



 You can also look for information at: 




1520




 





 





 





 





 





 



   




1521




 





 





 





 





 





 



 =over 4 




1522




 





 





 





 





 





 



   




1523




 





 





 





 





 





 



 =item * RT: CPAN's request tracker (report bugs here) 




1524




 





 





 





 





 





 



   




1525




 





 





 





 





 





 



 L 




1526




 





 





 





 





 





 



   




1527




 





 





 





 





 





 



 =item * AnnoCPAN: Annotated CPAN documentation 




1528




 





 





 





 





 





 



   




1529




 





 





 





 





 





 



 L 




1530




 





 





 





 





 





 



   




1531




 





 





 





 





 





 



 =item * CPAN Ratings 




1532




 





 





 





 





 





 



   




1533




 





 





 





 





 





 



 L 




1534




 





 





 





 





 





 



   




1535




 





 





 





 





 





 



 =item * Search CPAN 




1536




 





 





 





 





 





 



   




1537




 





 





 





 





 





 



 L 




1538




 





 





 





 





 





 



   




1539




 





 





 





 





 





 



 =back 




1540




 





 





 





 





 





 



   




1541




 





 





 





 





 





 



   




1542




 





 





 





 





 





 



 =head1 ACKNOWLEDGEMENTS 




1543




 





 





 





 





 





 



   




1544




 





 





 





 





 





 



 Special thanks to Jay Davis who wrote a lot of the original code that this module is based on. 




1545




 





 





 





 





 





 



   




1546




 





 





 





 





 





 



 =head1 LICENSE 




1547




 





 





 





 





 





 



   




1548




 





 





 





 





 





 



 This library is free software; you can redistribute it and/or modify 




1549




 





 





 





 





 





 



 it under the same terms as Perl itself. 




1550




 





 





 





 





 





 



   




1551




 





 





 





 





 





 



 =cut 




1552




 





 





 





 





 





 



   




1553




 





 





 





 





 





 



 1;

=item

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

=item

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

=item

B - A where clause to help decide what row to update. Any bind values can be passed in with C

=back

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
to update the row with in a hash, where the keys are the column names and the values are the new values. This function
might be useful for submitting forms easily.

    my %updated_person = (
        name => 'Billy',
        age => '32',
        favorite_color => 'blue',
    );

    my $num_rows_updated = $db->update(href => \%updated_person, table => 'people', id => 1);

    # or in list context
    my ($num_rows_updated) = $db->update(href => \%updated_person, table => 'people', id => 1);

Note that above for "id", the column must actually be named id for it to work. If you have a primary key or unique
identifying column that is named something different than id, then you can use the C parameter:

    my $num_rows_updated = $db->update(href => \%updated_person, table => 'people', pk => {name => 'person_id', val => 1});

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:

    my $num_rows_updated = $db->update(href => \%updated_person, table => 'people', where => 'name=? AND favorite_color=? AND age=?', vals => ['Joe', 'green', 61]);

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:

    my $num_rows_updated = $db->update(href => \%updated_person, table => 'people', where => 'name=? AND favorite_color=? AND age=?', vals => ['Joe', 'green', 61], id => 1);

Alternatively, you could just put the C or C in your where clause.

If you need to have literal SQL into your update query, then you just need to pass in a scalar reference. For example:

    "UPDATE people SET name='Billy', update_time=NOW() WHERE id=1"

If we had this:

    my %updated_person = (
        name => 'Billy',
        update_time => 'NOW()',
    );

    my $num_rows_updated = $db->update(href => \%updated_person, table => 'people', id => 1);

This would effectively evaluate to:

    my $num_rows_updated = $db->raw(query => "UPDATE people SET name=?, update_time=? WHERE id=?", vals => ['Billy', 'NOW()', 1]);

However, this will not work. Instead, we need to do:

    my %updated_person = (
        name => 'Billy',
        update_time => \'NOW()',
    );

    my $num_rows_updated = $db->update(href => \%updated_person, table => 'people', id => 1);

Which evaluates to:

    my $num_rows_updated = $db->raw(query => "UPDATE people SET name=?, update_time=NOW() WHERE id=?", vals => ['Billy', 1]);

And this is what we want.

=head3 update encrypt

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
instead of the indices for the order in which the columns are listed:

    my %updated_person = (
        name => 'Billy',
        age => '32',
        favorite_color => 'blue',
    );

    my $num_rows_updated = $db->update(href => \%updated_person, table => 'people', id => 1, encrypt => ['name', 'favorite_color']);

Note we do not ecnrypt age because it is most likely stored as an integer in the database.

=cut

sub update {
	my $self = shift;
	my $params = $self->_params(@_);

	croak "href and table are required for update" unless $params->{href} and $params->{table};

	my @vals;
	my $string = '';
    my @encrypt;
	while(my ($key,$val) = each %{$params->{href}}) {
		my $append = '?';
		if (ref $val eq 'SCALAR') {
			$append = $$val;
		}
		else {
            # TODO: write update encrypt tests
            if ((defined $params->{encrypt} and $params->{encrypt} eq '*')
                    or ($params->{encrypt} and first { $_ eq $key } @{$params->{encrypt}})) {
                push @encrypt, scalar(@vals);
            }

			push @vals, $val;
		}

		$string .= "$key=$append,";
	}

	$string = substr $string, 0, -1;

	$params->{vals} = [] unless $params->{vals};
	my $where = '';
	if($params->{where}) {
		$where = " WHERE $params->{where}";
		push @vals, @{$params->{vals}};
	}

	if($params->{id}) {
		if($where eq '') {
			$where = " WHERE id=? ";
		}
		else {
			$where .= " AND id=? ";
		}

		push @vals, $params->{id};
	}
	elsif($params->{pk}) {
		my $name = $params->{pk}->{name};
		my $val = $params->{pk}->{val};
		if($where eq '') {
			$where = " WHERE $name=? ";
		}
		else {
			$where .= " AND $name=? ";
		}

		push @vals, $val;
	}

	$params->{query} = "UPDATE $params->{table} SET $string $where";
	$params->{vals} = \@vals;

    if ($params->{encrypt} and @encrypt) {
        $params->{encrypt} = \@encrypt;
	    $self->_crypt_encrypt($params);
    }

	$self->_query($params);

    return unless defined wantarray;
    return wantarray ? ($self->sth->rows()) : $self->sth->rows();
}

=head2 insert_multiple

=over

=item

B - the array reference of array references, where each inner array reference holds the values to be inserted for one row

=item

B - the name of the table that the rows are to be inserted into 




1192




 





 





 





 





 





 



   




1193




 





 





 





 





 





 



 =item  




1194




 





 





 





 





 





 



   




1195




 





 





 





 





 





 



 B - The names of the columns that values are being inserted for 




1196




 





 





 





 





 





 



   




1197




 





 





 





 





 





 



 =back 




1198




 





 





 





 





 





 



   




1199




 





 





 





 





 





 



 L can be used to insert multiple rows with one query. For instance: 




1200




 





 





 





 





 





 



   




1201




 





 





 





 





 





 



     my $rows = [ 




1202




 





 





 





 





 





 



         [ 




1203




 





 





 





 





 





 



             1, 




1204




 





 





 





 





 





 



             'Joe', 




1205




 





 





 





 





 





 



             23, 




1206




 





 





 





 





 





 



         ], 




1207




 





 





 





 





 





 



         [ 




1208




 





 





 





 





 





 



             2, 




1209




 





 





 





 





 





 



             'Ralph, 




1210




 





 





 





 





 





 



             50, 




1211




 





 





 





 





 





 



         ], 




1212




 





 





 





 





 





 



     ]; 




1213




 





 





 





 





 





 



   




1214




 





 





 





 





 





 



     $db->insert_multiple(table => 'people', columns => [qw/id name age/], rows => $rows); 




1215




 





 





 





 





 





 



   




1216




 





 





 





 





 





 



 This can be translated into the SQL query: 




1217




 





 





 





 





 





 



   




1218




 





 





 





 





 





 



     INSERT INTO people (id, name, age) VALUES (1, 'Joe', 23), (2, 'Ralph', 50); 




1219




 





 





 





 





 





 



   




1220




 





 





 





 





 





 



 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 




1221




 





 





 





 





 





 



 try to speed things up! 




1222




 





 





 





 





 





 



   




1223




 





 





 





 





 





 



 =cut 




1224




 





 





 





 





 





 



   




1225




 





 





 





 





 





 



 sub insert_multiple { 




1226




1





 





 




  
1
  



  
1
  




49



 	my $self = shift; 




1227




1





 





 





 





 





5



 	my $params = $self->_params(@_); 




1228




 





 





 





 





 





 



   




1229




1





 





 





 





 





10



 	while(my ($key, $val) = each %$params) {  




1230




3





 





 





 





 





85



 		print "$key=$val\n"; 




1231




 





 





 





 





 





 



 	} 




1232




 





 





 





 





 





 



   




1233




1




  
 50
  



  
 33
  




 





 





24



 	croak "columns, table, and rows are required for insert_multiple" unless $params->{columns} and $params->{table} and $params->{rows}; 




 




 





 




  
 33
  




 





 





 



   




1234




 





 





 





 





 





 



   




1235




1





 





 





 





 





3



 	my $values_string = ''; 




1236




1





 





 





 





 





2



 	my @vals; 




1237




 





 





 





 





 





 



   




1238




1





 





 





 





 





4



 	my $columns = join ',', @{$params->{columns}}; 




 




1





 





 





 





 





9



   




1239




1





 





 





 





 





7



 	my $row_string = '?,' x @{$params->{columns}}; 




 




1





 





 





 





 





4



   




1240




1





 





 





 





 





4



 	$row_string = substr $row_string, 0, -1; 




1241




 





 





 





 





 





 



   




1242




1





 





 





 





 





2



 	for my $row (@{$params->{rows}}) {  




 




1





 





 





 





 





7



   




1243




2





 





 





 





 





13



 		push @vals, @$row; 




1244




2





 





 





 





 





13



 		$values_string .= "($row_string),";		 




1245




 





 





 





 





 





 



 	} 




1246




 





 





 





 





 





 



   




1247




1





 





 





 





 





9



 	$values_string = substr $values_string, 0, -1; 




1248




 





 





 





 





 





 



   




1249




1





 





 





 





 





6



 	$params->{query} = "INSERT INTO $params->{table} ($columns) VALUES $values_string"; 




1250




1





 





 





 





 





9



 	print $params->{query} . "\n"; 




1251




1





 





 





 





 





4



 	$params->{vals} = \@vals; 




1252




 





 





 





 





 





 



   




1253




1





 





 





 





 





5



 	$self->_query($params); 




1254




 





 





 





 





 





 



 }  




1255




 





 





 





 





 





 



   




1256




 





 





 





 





 





 



 =head2 sth 




1257




 





 





 





 





 





 



   




1258




 





 





 





 





 





 



 L returns the statement handle from the previous query. 




1259




 





 





 





 





 





 



   




1260




 





 





 





 





 





 



     my $sth = $db->sth; 




1261




 





 





 





 





 





 



   




1262




 





 





 





 





 





 



 This can be useful if you need a statement handle to perform a function, like to get 




1263




 





 





 





 





 





 



 the id of the last inserted row. 




1264




 





 





 





 





 





 



   




1265




 





 





 





 





 





 



 =cut 




1266




 





 





 





 





 





 



   




1267




 





 





 





 





 





 



 =head2 dbh 




1268




 





 





 





 





 





 



   




1269




 





 





 





 





 





 



 L returns the database handle that L is using. 




1270




 





 





 





 





 





 



   




1271




 





 





 





 





 





 



     my $dbh = $db->dbh; 




1272




 





 





 





 





 





 



   




1273




 





 





 





 





 





 



 L can also be used to set a new database handle for L to use. 




1274




 





 





 





 





 





 



   




1275




 





 





 





 





 





 



     $db->dbh($new_dbh); 




1276




 





 





 





 





 





 



   




1277




 





 





 





 





 





 



 =cut 




1278




 





 





 





 





 





 



   




1279




 





 





 





 





 





 



 =head2 dsn 




1280




 





 





 





 





 





 



   




1281




 





 





 





 





 





 



 L returns the dsn that was provided. 




1282




 





 





 





 





 





 



   




1283




 





 





 





 





 





 



     my $dsn = $db->dsn; 




1284




 





 





 





 





 





 



   




1285




 





 





 





 





 





 



 L can also be used to set a new C. 




1286




 





 





 





 





 





 



   




1287




 





 





 





 





 





 



     $db->dsn($new_dsn); 




1288




 





 





 





 





 





 



   




1289




 





 





 





 





 





 



 When setting a new C, it's likely you'll want to use L. 




1290




 





 





 





 





 





 



   




1291




 





 





 





 





 





 



 =cut 




1292




 





 





 





 





 





 



   




1293




 





 





 





 





 





 



 =head2 user 




1294




 





 





 





 





 





 



   




1295




 





 





 





 





 





 



 L returns the user that was provided. 




1296




 





 





 





 





 





 



   




1297




 





 





 





 





 





 



     my $user = $db->user; 




1298




 





 





 





 





 





 



   




1299




 





 





 





 





 





 



 L can also be used to set a new C. 




1300




 





 





 





 





 





 



   




1301




 





 





 





 





 





 



     $db->user($new_user); 




1302




 





 





 





 





 





 



   




1303




 





 





 





 





 





 



 When setting a new C, it's likely you'll want to use L. 




1304




 





 





 





 





 





 



   




1305




 





 





 





 





 





 



 =cut 




1306




 





 





 





 





 





 



   




1307




 





 





 





 





 





 



 =head2 password 




1308




 





 





 





 





 





 



   




1309




 





 





 





 





 





 



 L returns the password that was provided. 




1310




 





 





 





 





 





 



   




1311




 





 





 





 





 





 



     my $password = $db->password; 




1312




 





 





 





 





 





 



   




1313




 





 





 





 





 





 



 L can also be used to set a new C. 




1314




 





 





 





 





 





 



   




1315




 





 





 





 





 





 



     $db->password($new_password); 




1316




 





 





 





 





 





 



   




1317




 





 





 





 





 





 



 When setting a new C, it's likely you'll want to use L. 




1318




 





 





 





 





 





 



   




1319




 





 





 





 





 





 



 =cut 




1320




 





 





 





 





 





 



   




1321




 





 





 





 





 





 



 =head2 conf 




1322




 





 





 





 





 





 



   




1323




 





 





 





 





 





 



 L returns the conf file that was provided. 




1324




 





 





 





 





 





 



   




1325




 





 





 





 





 





 



     my $conf = $db->conf; 




1326




 





 





 





 





 





 



   




1327




 





 





 





 





 





 



 L can also be used to set a new C file. 




1328




 





 





 





 





 





 



   




1329




 





 





 





 





 





 



     $db->conf($new_conf); 




1330




 





 





 





 





 





 



   




1331




 





 





 





 





 





 



 When setting a new C, it's likely you'll want to use L. 




1332




 





 





 





 





 





 



   




1333




 





 





 





 





 





 



 =cut 




1334




 





 





 





 





 





 



   




1335




 





 





 





 





 





 



 =head2 connect 




1336




 





 





 





 





 





 



   




1337




 





 





 





 





 





 



 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: 




1338




 





 





 





 





 





 



   




1339




 





 





 





 





 





 



     #now there is a new dbh with the same DBIx::Raw object using the same settings 




1340




 





 





 





 





 





 



     $db->connect; 




1341




 





 





 





 





 





 



   




1342




 





 





 





 





 





 



 Or you can change the connect info.  




1343




 





 





 





 





 





 



 For example, if you update C, C, C: 




1344




 





 





 





 





 





 



   




1345




 





 





 





 





 





 



     $db->dsn('new_dsn'); 




1346




 





 





 





 





 





 



     $db->user('user'); 




1347




 





 





 





 





 





 



     $db->password('password'); 




1348




 





 





 





 





 





 



   




1349




 





 





 





 





 





 



     #get new dbh but keep same DBIx::Raw object 




1350




 





 





 





 





 





 



     $db->connect; 




1351




 





 





 





 





 





 



   




1352




 





 





 





 





 





 



 Or if you update the conf file: 




1353




 





 





 





 





 





 



   




1354




 





 





 





 





 





 



     $db->conf('/path/to/new_conf.pl'); 




1355




 





 





 





 





 





 



      




1356




 





 





 





 





 





 



     #get new dbh but keep same DBIx::Raw object 




1357




 





 





 





 





 





 



     $db->connect; 




1358




 





 





 





 





 





 



   




1359




 





 





 





 





 





 



 =cut 




1360




 





 





 





 





 





 



   




1361




 





 





 





 





 





 



 sub connect {  




1362




70





 





 




  
70
  



  
1
  




536



 	my ($self) = @_; 




1363




 





 





 





 





 





 



   




1364




70





 





 





 





 





632



 	$self->_parse_conf; 




1365




70





 





 





 





 





7010



 	$self->_validate_connect_info; 




1366




70





 




  
 33
  




 





 





3926



 	return $self->dbh(DBI->connect($self->dsn, $self->user, $self->password) or croak($DBI::errstr)); 




1367




 





 





 





 





 





 



 } 




1368




 





 





 





 





 





 



   




1369




 





 





 





 





 





 



 sub _params {  




1370




321





 





 




  
321
  




 





924



 	my $self = shift; 




1371




 





 





 





 





 





 



   




1372




321





 





 





 





 





854



 	my %params; 




1373




321




  
100
  




 





 





 





2312



 	unless($self->keys->{$_[0]}) { 




1374




43





 





 





 





 





270



 		$params{query} = shift; 




1375




43





 





 





 





 





188



 		$params{vals} = [@_]; 




1376




 





 





 





 





 





 



 	} 




1377




 





 





 





 





 





 



 	else {  




1378




278





 





 





 





 





3020



 		%params = @_; 




1379




 





 





 





 





 





 



 	} 




1380




 





 





 





 





 





 



   




1381




321





 





 





 





 





1669



 	return \%params; 




1382




 





 





 





 





 





 



 } 




1383




 





 





 





 





 





 



   




1384




 





 





 





 





 





 



 sub _query { 




1385




321





 





 




  
321
  




 





857



 	my ($self, $params) = (@_); 




1386




 





 





 





 





 





 



   




1387




321




  
 50
  




 





 





 





7884



 	$self->sth($self->dbh->prepare($params->{query})) or $self->_perish($params); 




1388




 





 





 





 





 





 



   




1389




321




  
100
  




 





 





 





27852



 	if($params->{'vals'}){ 




1390




227




  
 50
  




 





 





 





840



   		$self->sth->execute(@{$params->{'vals'}}) or $self->_perish($params); 




 




227





 





 





 





 





6579



   




1391




 





 





 





 





 





 



 	} 




1392




 





 





 





 





 





 



 	else { 




1393




94




  
 50
  




 





 





 





13226



   		$self->sth->execute() or $self->_perish($params); 




1394




 





 





 





 





 





 



 	} 




1395




 





 





 





 





 





 



 } 




1396




 





 





 





 





 





 



   




1397




 





 





 





 





 





 



 sub _perish {  




1398



  
0
  




 





 




  
0
  




 





0



 	my ($self, $params) = @_; 




1399



  
0
  




 





 





 





 





0



 	croak "ERROR: Can't prepare query.\n\n$DBI::errstr\n\nquery='" . $params->{query} . "'\n"; 




1400




 





 





 





 





 





 



 } 




1401




 





 





 





 





 





 



   




1402




 





 





 





 





 





 



 sub _crypt_decrypt {  




1403




31





 





 




  
31
  




 





279



 	my ($self, $params) = @_; 




1404




31





 





 





 





 





139



 	my @keys; 




1405




31




  
100
  




 





 





 





144



 	if($params->{decrypt} eq '*') {  




1406




8




  
100
  




 





 





 





56



 		if($params->{href}) {  




1407




6





 





 





 





 





42



 			@keys = keys %{$params->{href}}; 




 




6





 





 





 





 





39



   




1408




 





 





 





 





 





 



 		} 




1409




 





 





 





 





 





 



 		else {  




1410




2





 





 





 





 





6



 			@keys = 0..$#{$params->{return_values}}; 




 




2





 





 





 





 





13



   




1411




 





 





 





 





 





 



 		} 




1412




 





 





 





 





 





 



 	} 




1413




 





 





 





 





 





 



 	else {  




1414




23





 





 





 





 





94



 		@keys = @{$params->{decrypt}}; 




 




23





 





 





 





 





82



   




1415




 





 





 





 





 





 



 	} 




1416




 





 





 





 





 





 



   




1417




31




  
100
  




 





 





 





168



 	if($params->{href}) { 




1418




24





 





 





 





 





158



 		for my $key (@keys) { 




1419




47




  
 50
  




 





 





 





3164



 			$params->{href}->{$key} = $self->_decrypt($params->{href}->{$key}) if $params->{href}->{$key}; 




1420




 





 





 





 





 





 



 		} 	 




1421




 





 





 





 





 





 



 	} 




1422




 





 





 





 





 





 



 	else {  




1423




7





 





 





 





 





49



 		for my $index (@keys) { 




1424




12




  
 50
  




 





 





 





767



 			$params->{return_values}->[$index] = $self->_decrypt( $params->{return_values}->[$index] ) if $params->{return_values}->[$index]; 




1425




 





 





 





 





 





 



 		} 




1426




 





 





 





 





 





 



 	} 




1427




 





 





 





 





 





 



 } 




1428




 





 





 





 





 





 



   




1429




 





 





 





 





 





 



 sub _crypt_encrypt {  




1430




165





 





 




  
165
  




 





573



 	my ($self, $params) = @_; 




1431




165





 





 





 





 





353



 	my @indices;  




1432




 





 





 





 





 





 



   




1433




165




  
100
  




 





 





 





785



 	if($params->{encrypt} eq '*') {  




1434




4





 





 





 





 





18



 		my $num_question_marks = 0; 




1435




 





 





 





 





 





 



 		#don't want to encrypt where conditions! Might be buggy...should look into this more 




1436




4




  
 50
  




 





 





 





95



 		if($params->{query} =~ /WHERE\s+(.*)/i) {  




1437




4





 





 





 





 





66



 			$num_question_marks =()= $1 =~ /=\s*?\?/g; 




1438




 





 





 





 





 





 



 		} 




1439




 





 





 





 





 





 



   




1440




4





 





 





 





 





19



 		@indices = 0..($#{$params->{vals}} - $num_question_marks); 




 




4





 





 





 





 





19



   




1441




 





 





 





 





 





 



 	} 




1442




 





 





 





 





 





 



 	else {  




1443




161





 





 





 





 





353



 		@indices = @{$params->{encrypt}}; 




 




161





 





 





 





 





544



   




1444




 





 





 





 





 





 



 	} 




1445




 





 





 





 





 





 



   




1446




165





 





 





 





 





952



 	for my $index (@indices) { 




1447




80





 





 





 





 





207



    		@{$params->{vals}}[$index] = $self->_encrypt( @{$params->{vals}}[$index] ); 




 




80





 





 





 





 





45655



   




 




80





 





 





 





 





325



   




1448




 





 





 





 





 





 



 	} 




1449




 





 





 





 





 





 



 } 




1450




 





 





 





 





 





 



   




1451




 





 





 





 





 





 



 sub _encrypt {  




1452




80





 





 




  
80
  




 





205



 	my ($self, $text) = @_; 




1453




 





 





 





 





 





 



   




1454




80




  
 50
  




 





 





 





2269



     if ($self->use_old_crypt) { 




1455



  
0
  




 





 





 





 





0



         return $self->old_crypt->encrypt($text); 




1456




 





 





 





 





 





 



     } 




1457




 





 





 





 





 





 



   




1458




80





 





 





 





 





2285



     return $self->crypt->encrypt($text);  




1459




 





 





 





 





 





 



 } 




1460




 





 





 





 





 





 



   




1461




 





 





 





 





 





 



 sub _decrypt {  




1462




63





 





 




  
63
  




 





214



 	my ($self, $text) = @_; 




1463




 





 





 





 





 





 



      




1464




63




  
 50
  




 





 





 





1477



     if ($self->use_old_crypt) { 




1465




0





 





 





 





 





0



         return $self->old_crypt->decrypt($text); 




1466




 





 





 





 





 





 



     } 




1467




 





 





 





 





 





 



   




1468




63





 





 





 





 





1452



 	return $self->crypt->decrypt($text);  




1469




 





 





 





 





 





 



 } 




1470




 





 





 





 





 





 



   




1471




 





 





 





 





 





 



 sub _parse_conf {  




1472




140





 





 




  
140
  




 





1693



 	my ($self) = @_; 




1473




 





 





 





 





 





 



   




1474




 





 





 





 





 





 



 	#load in configuration if it exists 




1475




140




  
100
  




 





 





 





2008



 	if($self->conf) {  




1476




 





 





 





 





 





 



   




1477




 





 





 





 





 





 



 		#no need to read in settings again if conf hasn't changed, unless dsn, user, or password is unset 




1478




137




  
 50
  



  
100
  




 





 





5854



 		return if $self->conf eq $self->prev_conf and $self->dsn and $self->user and $self->password; 




 




 





 




  
 66
  




 





 





 



   




 




 





 




  
 66
  




 





 





 



   




1479




 





 





 





 





 





 



   




1480




137





 





 





 





 





11175



 		my $config = Config::Any->load_files({files =>[$self->conf],use_ext => 1  });  




1481




 





 





 





 





 





 



   




1482




137





 





 





 





 





1633771



 		for my $c (@$config){ 




1483




137





 





 





 





 





1399



   			for my $file (keys %$c){ 




1484




137





 





 





 





 





912



      			for my $attribute (keys %{$c->{$file}}){ 




 




137





 





 





 





 





1031



   




1485




412




  
 50
  




 





 





 





3562



 					if($self->can($attribute)) {  




1486




412





 





 





 





 





4279



 						$self->$attribute($c->{$file}->{$attribute}); 




1487




 





 





 





 





 





 



 					} 




1488




 





 





 





 





 





 



    				} 




1489




 





 





 





 





 





 



   			} 




1490




 





 





 





 





 





 



 		} 




1491




 





 





 





 





 





 



   




1492




137





 





 





 





 





11354



 		$self->prev_conf($self->conf); 




1493




 





 





 





 





 





 



 	} 




1494




 





 





 





 





 





 



 } 




1495




 





 





 





 





 





 



   




1496




 





 





 





 





 





 



 sub _validate_connect_info {  




1497




140





 





 




  
140
  




 





801



 	my ($self) = @_; 




1498




140




  
 50
  



  
 66
  




 





 





10536



 	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
  




 





 





 



   




1499




 





 





 





 





 





 



 		unless (defined $self->dsn and defined $self->user and defined $self->password) or defined $self->dbh; 




1500




 





 





 





 





 





 



 } 




1501




 





 





 





 





 





 



   




1502




 





 





 





 





 





 



 =head1 AUTHOR 




1503




 





 





 





 





 





 



   




1504




 





 





 





 





 





 



 Adam Hopkins, C<<  >> 




1505




 





 





 





 





 





 



   




1506




 





 





 





 





 





 



 =head1 BUGS 




1507




 





 





 





 





 





 



   




1508




 





 





 





 





 





 



 Please report any bugs or feature requests to C, or through 




1509




 





 





 





 





 





 



 the web interface at L.  I will be notified, and then you'll 




1510




 





 





 





 





 





 



 automatically be notified of progress on your bug as I make changes. 




1511




 





 





 





 





 





 



   




1512




 





 





 





 





 





 



 =head1 SUPPORT 




1513




 





 





 





 





 





 



   




1514




 





 





 





 





 





 



 You can find documentation for this module with the perldoc command. 




1515




 





 





 





 





 





 



   




1516




 





 





 





 





 





 



     perldoc DBIx::Raw 




1517




 





 





 





 





 





 



   




1518




 





 





 





 





 





 



   




1519




 





 





 





 





 





 



 You can also look for information at: 




1520




 





 





 





 





 





 



   




1521




 





 





 





 





 





 



 =over 4 




1522




 





 





 





 





 





 



   




1523




 





 





 





 





 





 



 =item * RT: CPAN's request tracker (report bugs here) 




1524




 





 





 





 





 





 



   




1525




 





 





 





 





 





 



 L 




1526




 





 





 





 





 





 



   




1527




 





 





 





 





 





 



 =item * AnnoCPAN: Annotated CPAN documentation 




1528




 





 





 





 





 





 



   




1529




 





 





 





 





 





 



 L 




1530




 





 





 





 





 





 



   




1531




 





 





 





 





 





 



 =item * CPAN Ratings 




1532




 





 





 





 





 





 



   




1533




 





 





 





 





 





 



 L 




1534




 





 





 





 





 





 



   




1535




 





 





 





 





 





 



 =item * Search CPAN 




1536




 





 





 





 





 





 



   




1537




 





 





 





 





 





 



 L 




1538




 





 





 





 





 





 



   




1539




 





 





 





 





 





 



 =back 




1540




 





 





 





 





 





 



   




1541




 





 





 





 





 





 



   




1542




 





 





 





 





 





 



 =head1 ACKNOWLEDGEMENTS 




1543




 





 





 





 





 





 



   




1544




 





 





 





 





 





 



 Special thanks to Jay Davis who wrote a lot of the original code that this module is based on. 




1545




 





 





 





 





 





 



   




1546




 





 





 





 





 





 



 =head1 LICENSE 




1547




 





 





 





 





 





 



   




1548




 





 





 





 





 





 



 This library is free software; you can redistribute it and/or modify 




1549




 





 





 





 





 





 



 it under the same terms as Perl itself. 




1550




 





 





 





 





 





 



   




1551




 





 





 





 





 





 



 =cut 




1552




 





 





 





 





 





 



   




1553




 





 





 





 





 





 



 1;

=item

B - The names of the columns that values are being inserted for

=back

L can be used to insert multiple rows with one query. For instance:

    my $rows = [
        [
            1,
            'Joe',
            23,
        ],
        [
            2,
            'Ralph,
            50,
        ],
    ];

    $db->insert_multiple(table => 'people', columns => [qw/id name age/], rows => $rows);

This can be translated into the SQL query:

    INSERT INTO people (id, name, age) VALUES (1, 'Joe', 23), (2, 'Ralph', 50);

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
try to speed things up!

=cut

sub insert_multiple {
	my $self = shift;
	my $params = $self->_params(@_);

	while(my ($key, $val) = each %$params) {
		print "$key=$val\n";
	}

	croak "columns, table, and rows are required for insert_multiple" unless $params->{columns} and $params->{table} and $params->{rows};

	my $values_string = '';
	my @vals;

	my $columns = join ',', @{$params->{columns}};
	my $row_string = '?,' x @{$params->{columns}};
	$row_string = substr $row_string, 0, -1;

	for my $row (@{$params->{rows}}) {
		push @vals, @$row;
		$values_string .= "($row_string),";
	}

	$values_string = substr $values_string, 0, -1;

	$params->{query} = "INSERT INTO $params->{table} ($columns) VALUES $values_string";
	print $params->{query} . "\n";
	$params->{vals} = \@vals;

	$self->_query($params);
}

=head2 sth

L returns the statement handle from the previous query.

    my $sth = $db->sth;

This can be useful if you need a statement handle to perform a function, like to get
the id of the last inserted row.

=cut

=head2 dbh

L returns the database handle that L is using.

    my $dbh = $db->dbh;

L can also be used to set a new database handle for L to use.

    $db->dbh($new_dbh);

=cut

=head2 dsn

L returns the dsn that was provided.

    my $dsn = $db->dsn;

L can also be used to set a new C.

    $db->dsn($new_dsn);

When setting a new C, it's likely you'll want to use L.

=cut

=head2 user

L returns the user that was provided.

    my $user = $db->user;

L can also be used to set a new C.

    $db->user($new_user);

When setting a new C, it's likely you'll want to use L.

=cut

=head2 password

L returns the password that was provided.

    my $password = $db->password;

L can also be used to set a new C.

    $db->password($new_password);

When setting a new C, it's likely you'll want to use L.

=cut

=head2 conf

L returns the conf file that was provided.

    my $conf = $db->conf;

L can also be used to set a new C file.

    $db->conf($new_conf);

When setting a new C, it's likely you'll want to use L.

=cut

=head2 connect

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:

    #now there is a new dbh with the same DBIx::Raw object using the same settings
    $db->connect;

Or you can change the connect info.
For example, if you update C, C, C:

    $db->dsn('new_dsn');
    $db->user('user');
    $db->password('password');

    #get new dbh but keep same DBIx::Raw object
    $db->connect;

Or if you update the conf file:

    $db->conf('/path/to/new_conf.pl');

    #get new dbh but keep same DBIx::Raw object
    $db->connect;

=cut

sub connect {
	my ($self) = @_;

	$self->_parse_conf;
	$self->_validate_connect_info;
	return $self->dbh(DBI->connect($self->dsn, $self->user, $self->password) or croak($DBI::errstr));
}

sub _params {
	my $self = shift;

	my %params;
	unless($self->keys->{$_[0]}) {
		$params{query} = shift;
		$params{vals} = [@_];
	}
	else {
		%params = @_;
	}

	return \%params;
}

sub _query {
	my ($self, $params) = (@_);

	$self->sth($self->dbh->prepare($params->{query})) or $self->_perish($params);

	if($params->{'vals'}){
  		$self->sth->execute(@{$params->{'vals'}}) or $self->_perish($params);
	}
	else {
  		$self->sth->execute() or $self->_perish($params);
	}
}

sub _perish {
	my ($self, $params) = @_;
	croak "ERROR: Can't prepare query.\n\n$DBI::errstr\n\nquery='" . $params->{query} . "'\n";
}

sub _crypt_decrypt {
	my ($self, $params) = @_;
	my @keys;
	if($params->{decrypt} eq '*') {
		if($params->{href}) {
			@keys = keys %{$params->{href}};
		}
		else {
			@keys = 0..$#{$params->{return_values}};
		}
	}
	else {
		@keys = @{$params->{decrypt}};
	}

	if($params->{href}) {
		for my $key (@keys) {
			$params->{href}->{$key} = $self->_decrypt($params->{href}->{$key}) if $params->{href}->{$key};
		}
	}
	else {
		for my $index (@keys) {
			$params->{return_values}->[$index] = $self->_decrypt( $params->{return_values}->[$index] ) if $params->{return_values}->[$index];
		}
	}
}

sub _crypt_encrypt {
	my ($self, $params) = @_;
	my @indices;

	if($params->{encrypt} eq '*') {
		my $num_question_marks = 0;
		#don't want to encrypt where conditions! Might be buggy...should look into this more
		if($params->{query} =~ /WHERE\s+(.*)/i) {
			$num_question_marks =()= $1 =~ /=\s*?\?/g;
		}

		@indices = 0..($#{$params->{vals}} - $num_question_marks);
	}
	else {
		@indices = @{$params->{encrypt}};
	}

	for my $index (@indices) {
   		@{$params->{vals}}[$index] = $self->_encrypt( @{$params->{vals}}[$index] );
	}
}

sub _encrypt {
	my ($self, $text) = @_;

    if ($self->use_old_crypt) {
        return $self->old_crypt->encrypt($text);
    }

    return $self->crypt->encrypt($text);
}

sub _decrypt {
	my ($self, $text) = @_;

    if ($self->use_old_crypt) {
        return $self->old_crypt->decrypt($text);
    }

	return $self->crypt->decrypt($text);
}

sub _parse_conf {
	my ($self) = @_;

	#load in configuration if it exists
	if($self->conf) {

		#no need to read in settings again if conf hasn't changed, unless dsn, user, or password is unset
		return if $self->conf eq $self->prev_conf and $self->dsn and $self->user and $self->password;

		my $config = Config::Any->load_files({files =>[$self->conf],use_ext => 1  });

		for my $c (@$config){
  			for my $file (keys %$c){
     			for my $attribute (keys %{$c->{$file}}){
					if($self->can($attribute)) {
						$self->$attribute($c->{$file}->{$attribute});
					}
   				}
  			}
		}

		$self->prev_conf($self->conf);
	}
}

sub _validate_connect_info {
	my ($self) = @_;
	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"
		unless (defined $self->dsn and defined $self->user and defined $self->password) or defined $self->dbh;
}

=head1 AUTHOR

Adam Hopkins, C<<  >>

=head1 BUGS

Please report any bugs or feature requests to C, or through
the web interface at L.  I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.

=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc DBIx::Raw


You can also look for information at:

=over 4

=item * RT: CPAN's request tracker (report bugs here)

L

=item * AnnoCPAN: Annotated CPAN documentation

L

=item * CPAN Ratings

L

=item * Search CPAN

L

=back


=head1 ACKNOWLEDGEMENTS

Special thanks to Jay Davis who wrote a lot of the original code that this module is based on.

=head1 LICENSE

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut

1;