package RideLogicDBI; use strict; use DBI; use POSIX; our $debug = 0; our $PACKAGE = 'RideLogicDBI'; require Exporter; #use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); use vars qw( @ISA ); #$VERSION = "0.01"; @ISA = qw(Exporter); #@EXPORT = qw( debug_print ); #@EXPORT_OK = qw( debug_print ); #%EXPORT_TAGS = ( DEFAULT => [ qw( &debug_print ) ] ); #our @ISA = qw(Exporter); our %CON ; our $data_source; our $username; our $password; our $attr_href; my $PACKAGE_NAME = "RideLogicDBI"; my %session; my %session_active; my %session_inactive; my %session_ref_count; my %query; my %query_usage; sub debug_print { print "SESSION:\n"; foreach my $k (keys(%session)) { print "$k "; foreach my $t (keys(%{$session{$k}})) { print " ($t ", $session{$k}->{$t}, ")"; } print "\n"; } print "\n"; print "SESSION_ACTIVE:\n"; foreach my $k (keys(%session_active)) { print "$k "; foreach my $t (keys(%{$session_active{$k}})) { print " ($t ", $session_active{$k}->{$t}, ")"; } print "\n"; } print "\n"; print "SESSION_INACTIVE:\n"; foreach my $k (keys(%session_inactive)) { print "$k "; foreach my $t (keys(%{$session_inactive{$k}})) { print " ($t ", $session_inactive{$k}->{$t}, ")"; } print "\n"; } print "\n"; print "SESSION_REF_COUNT:\n"; foreach my $k (keys(%session_ref_count)) { print "$k ", $session_ref_count{$k}, "\n"; } } sub construct_key { my ($a, $b, $c, $h) = @_; my $h_k = ""; if (defined($h)) { foreach my $t (sort(keys(%$h))) { my ($x, $y) = ($t, $h->{$t}); $x =~ s/([\\:])/\\$1/g; $y =~ s/([\\:])/\\$1/g; $h_k .= ":$x:$y"; } } $a =~ s/([\\:])/\\$1/g; $b =~ s/([\\:])/\\$1/g; $c =~ s/([\\:])/\\$1/g; return "$a:$b:$c$h_k"; } # remove from inactive hash # add to active hash # return session key sub activate_from_inactive_pool { my $k = shift; my $href = $session_inactive{$k}; my ($ref, $v) = each %$href; delete $href->{$ref}; delete $session_inactive{$k} if (scalar(keys(%{$href}))==0); my $session_key = $k . ":" . $ref; $session_active{$k}->{$ref} = 1; $session{$session_key}->{'active_timestamp'} = strftime "%a %b %e %H:%M:%S %Y", localtime; return $session_key; } sub deactivate_from_active_pool { my $session_key = shift; my $orig_sess = $session_key; $session_key =~ m/(.*):(\d+)$/; my ($k, $ref) = ($1, $2); delete $session_active{$k}->{$ref}; delete $session_active{$k} if !scalar(keys(%{$session_active{$k}})); $session_inactive{$k} = {} if !exists($session_inactive{$k}); $session_inactive{$k}->{$ref} = 1; } sub create_new_db_session { my ($k, $dsn, $user, $pass, $attr) = @_; my $ref = "0"; my $dbh = DBI->connect($dsn, $user, $pass, $attr); return undef if (!$dbh); my $dbh_ref = \$dbh; if (!exists($session_ref_count{$k})) { $session_ref_count{$k} = 1; } else { $ref = $session_ref_count{$k}++; } my $session_key = $k . ":" . $ref; $session{$session_key} = {}; $session{$session_key}->{'dbh_ref'} = $dbh_ref; $session{$session_key}->{'active_timestamp'} = strftime "%a %b %e %H:%M:%S %Y", localtime; $session{$session_key}->{'lock_active'} = 0; $query{$session_key} = {}; $query_usage{$session_key} = {}; $session_active{$k}->{$ref} = 1; return $session_key; } sub connect { my ($class_name, $dsn, $user, $pass, $attr) = @_; my $k = construct_key($dsn, $user, $pass, $attr); my $session_key = ( exists($session_inactive{$k}) ? activate_from_inactive_pool($k) : create_new_db_session($k, $dsn, $user, $pass, $attr) ); return undef if !$session_key; my $class = {}; $class->{'key'} = $session_key; $class->{'dbh_ref'} = $session{$session_key}->{'dbh_ref'}; $class->{'active_timestamp'} = $session{$session_key}->{'active_timestamp'}; bless($class, $class_name); my $dbh_ref = $session{$session_key}->{'dbh_ref'}; if ( !( defined($$dbh_ref) && $$dbh_ref->ping) ) { $$dbh_ref = DBI->connect($dsn, $user, $pass, $attr); $query{$session_key} = {}; $query_usage{$session_key} = {}; return undef if !$$dbh_ref; } return $class; } sub DESTROY { my $self = shift; deactivate_from_active_pool($self->{'key'}); } sub prepare { my $self = shift; my $query = shift; my $session_key = $self->{'key'}; my $dbh = ${$self->{'dbh_ref'}}; if ( !defined($query{$session_key}->{$query}) ) { $query{$session_key}->{$query} = $dbh->prepare($query); $query_usage{$session_key}->{$query} = 0; } $query_usage{$session_key}->{$query}++; return $query{$session_key}->{$query}; } sub begin_work { my $self = shift; my $dbh = ${$self->{'dbh_ref'}}; $dbh->begin_work(); } sub finish { my $self = shift; my $r = shift; my $dbh = ${$self->{'dbh_ref'}}; if ($r) { $dbh->commit(); } else { $dbh->rollback(); } } sub rollback { my $self = shift; my $dbh = ${$self->{'dbh_ref'}}; $dbh->rollback(); } sub commit { my $self = shift; my $dbh = ${$self->{'dbh_ref'}}; $dbh->commit(); } sub last_insert_id { my $self = shift; my $dbh = ${$self->{'dbh_ref'}}; return $dbh->last_insert_id(undef, undef, undef, undef); } sub raise_error { my $self = shift; my $val = shift; my $dbh = ${$self->{'dbh_ref'}}; return $dbh->{RaiseError} = $val; } sub rows { my $self = shift; my $dbh = ${$self->{'dbh_ref'}}; return $dbh->rows; } sub errstr { my $self = shift; my $dbh = ${$self->{'dbh_ref'}}; return $dbh->errstr; } sub lock_active { my $self = shift; my $v = shift; $self->{'lock_active'} = $v if defined($v); return $self->{'lock_active'}; } sub disable_locking { my $self = shift; return $self->lock_active(1); } sub enable_locking { my $self = shift; return $self->lock_active(0); } sub get_query_usage_ref { my $self = shift; my $s = $self->{'key'}; return $query_usage{$s}; } return 1;