popufare/server/scripts/RideLogicDBI.pm

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;