view release on metacpan or  search on metacpan

lib/Pepper/DB.pm  view on Meta::CPAN

use Scalar::Util qw(blessed);

# time to grow up
use strict;
use warnings;

# create ourself and connect to the database
sub new {
	my ($class,$args) = @_;
	# $args should have:
	#	'config' => the system configuration from Pepper::Utilities,

	my $config = $$args{config};

	# if $connect_to_database is empty, go with the main 'information_schema' system database
	$$config{connect_to_database} ||= "information_schema";

	# cannot do a thing without the %$config - hard death
	if (ref($config) ne 'HASH' || !$$config{database_username} || !$$config{database_password}) {
		die "Cannot create DB object and continue without valid config hash.\n";
	}
	
	# default DB server is localhost
	$$config{database_server} ||= '127.0.0.1';
	
	# make the object
	my $self = bless {
		'config' => $config, 
		'database_server' => $$config{database_server},
		'current_database' => $$config{connect_to_database},
		'created' => time(),
		'connect_time' => 1,
	}, $class;

	# now connect to the database and get a real DBI object into $self->{dbh}
	$self->connect_to_database();

	return $self;
}

# special method to connect or re-connect to the database
sub connect_to_database {
	my $self = shift;
	
	# only do this if $self->{dbh} is not already a DBI object
	return if $self->{dbh} && blessed($self->{dbh}) =~ /DBI/ && 
		( ( time()-$self->{connect_time} ) < 5 || $self->{dbh}->ping );

	my ($username, $password, $credentials, $dsn);

	# make the connection - fail and log if cannot connect
	
	# can support Mysql/MariaDB
	$dsn = 'DBI:mysql:database='.$self->{current_database}.';host='.$self->{database_server}.';port=3306';
	$self->{dbh} = DBI->connect($dsn, $self->{config}{database_username}, $self->{config}{database_password},{ 
		PrintError => 0, 
		RaiseError => 0, 
		AutoCommit => 0,
		ShowErrorStatement => 1,
		HandleError => \&dbi_error_handler,
		mysql_enable_utf8 => 8
	});

	# let's automatically reconnect if the connection is timed out
	$self->{dbh}->{mysql_auto_reconnect} = 1;
	# note that this doesn't seem to work too well

	# let's use UTC time in DB saves
	$self->do_sql(qq{set time_zone = '+0:00'});

	# Set Long to 1000000 for long text...may need to adjust this
	$self->{dbh}->{LongReadLen} = 1000000;

	# no pings for the first 5 seconds
	$self->{connect_time} = time();
	
	# $self->{dbh} is now ready to go
}

# method to change the current working database for a connection
sub change_database {
	# required argument is the database they want to switch into
	my ($self,$database_name) = @_;

	# nothing to do if that's not specified
	return if !$database_name;

	# no funny business
	return 'Bad Name' if $database_name =~ /[^a-z0-9\_]/i;

	# put in object attribute
	$self->{current_database} = $database_name;

	# make sure we are connected to the DB
	$self->connect_to_database();

	# pretty easy
	$self->{dbh}->do(qq{use $database_name});

}


# comma_list_select: same as list_select, but returns a commafied list rather than an array
sub comma_list_select {
	# grab args
	my ($self,$sql,$bind_values) = @_;

	# rely on our brother upstairs
	my $results = $self->list_select($sql,$bind_values);

	# nothing found?  just return
	if (!$$results[0]) {
		return;
	} else { # otherwise, return our comma-separated version of this
		return join(',',@$results);
	}
}

# utility method to commit changes; I know DBI does it.  This is how I want to do it.
sub commit {
	my $self = shift;