Hi

I have a problem trying to create a persistent object and maintain a dbh and sths for fixed sqls. They seem to work for several requests then the stored sths disappear from the object that contains them. Naturally, when that happens, the module tries to re-create the sth and I gets an error from postgres. The dbh never disappears, however, sth values disappear. I ping the DB using the dbh and get a successful response. I've tested extensively and tracked the process with PID. All of the requests hit the same process. Here's the error. dbdpg_1 seems to be an internal statement to dbd or postgress. Not mine.

DBD::Pg::st execute failed: ERROR:  prepared statement "dbdpg_1" already exists

Thanks in advance for you help
Jack

package System::Db2;

#
# CPAN modules
#
use DBI;
use Cache::FileCache;
use Data::Dumper;
use Exporter;
use base qw(Exporter);

#
# MySys modules
#
use Conf::MySys::Database qw($CONFIG );
use Conf::MySys::Settings qw($DEBUG %CACHE_SETTINGS);
use System::Exceptions::DBI;
use System::Logger2;
use System::Logger2::FreeForm;

my $PID=$$;
my $exceptions = System::Exceptions::DBI->new();

#
# Declarations
#
use constant {
    RETURN_ARRAY         => 1,
    RETURN_ARRAYREF      => 2,
    RETURN_HASHREF       => 3,
    RETURN_ARRAY_HASHREF => 4,
    RETURN_RV            => 5,
    YES                  => 1,
    NO                   => 0,
    MINUTE               => 60,             #  1 Minute
    FIVE                 => 300,            #  5 Minutes
    TEN                  => 600,            # 10 Minutes
    QUARTER              => 900,            # 15 Minutes
    THIRD                => 1200,           # 20 Minutes
    HALF                 => 1800,           # 30 Minutes
    HOUR                 => 3600,           #  1 Hour
    DAY                  => 86400,          #  1 Day
    WEEK                 => 604800,         #  1 Week
    MONTH                => 2419200,        #  1 Month(4 weeks)
  };

@EXPORT=qw( RETURN_ARRAY RETURN_ARRAYREF RETURN_HASHREF RETURN_ARRAY_H
+ASHREF RETURN_RV YES NO MINUTE FIVE TEN QUARTER THIRD HALF HOUR DAY W
+EEK MONTH);
use vars qw( @EXPORT $AUTOLOAD );

my $DEBUG;
our ($DBH, $STH);  ### Global  
#my ($DBH, $STH);  ### Not Global  

use strict;

my $CacheObj = Cache::FileCache->new( \%CACHE_SETTINGS );

=head1 NAME

  System::Db2 - Data access base module


=head1 DESCRIPTION

  This module prepares static SQL statements once, storing then in $se
+lf and executing
  them repeatedly.


=head1 USAGE

  use System::Db2;

  $db2 = System::Db2->new({ methods => \%methods} );

  NOTE: Refer to System::Db2::Skeleton for details on how to use it an
+d how to define
        methods.

=head2 Methods

=over 4

=item I<PACKAGE>->new(I<{HASH}>)

  Connects to the DB


=cut

sub new {
  my $class = shift;
  my $args  = shift;

  my $self  = bless( {}, ref($class) || $class );

  $DEBUG = $args->{DEBUG} if $args->{DEBUG};  ### Set DEBUG from modul
+es

  $self->{methods}    = $args->{methods};

  $self->connect_to_db;

  return $self;
}
=item I<PACKAGE>->DESTROY

  Finish SQL statemets and disconnect


=cut

sub DESTROY ($) {
  my $self = shift;

#  if (defined $self->{methods}) {
#    foreach (keys %{$self->{methods}}) {
#      $STH->{'_sth_'.$_}->finish if (defined $STH->{'_sth_'.$_}) ;
#    }
#  }

# 
# This is a copy of $dbh which is global so we don't want to destroy i
+t.
#
#  if (defined $self->{'_dbh'}) { 
#    $self->{_dbh}->disconnect(); 
#  }
}

sub connect_to_db {
  my $self = shift;

  $DBH = undef;
  $STH = undef;

  my ( $dsn );

### Default User

    $dsn   = 'dbi:Pg:dbname='.$CONFIG->{DB_NAME}.';host='.$CONFIG->{DB
+_HOST};
    $DBH = DBI->connect( $dsn,
                         $CONFIG->{DB_USER},
                         $CONFIG->{DB_PASS} ,
                         { RaiseError         => 0,
                           PrintError         => 0,
                           PrintWarn          => 0,
                           ShowErrorStatement => 1,
                           HandleError        => sub {
                                                       my ( $error, $d
+bh) = @_;
                                                       $exceptions->tr
+ap_error($_[0])
                                                     }
                         }
                       );

}

=item I<PACKAGE>->AUTOLOAD

  Executes when trying to access undefined methods.  This method figur
+es out if you're
  asking for a statement handle or trying to define one.  It's called 
+recursively to
  create a handle that doesn't exist then to execute it.  Additionally
+, when searching
  for data, it will check FileCache first, if it doesn't exist, it wil
+l search the DB,
  if found, it will then store in FileCache.


=cut

sub AUTOLOAD {
  my $self        = shift;
  my @pass_values = @_;
  my ($meth)   = $AUTOLOAD =~ /.*::([\w_]+)/;

  my ($sthname,
      $sth,
      $argsref,
      @bind_values,
      $cnt,
      $rv,
      $return_value,
      $disp_ping);

#
# Process statement handles calls
#
  $disp_ping=$DBH->ping;
  unless ( $DBH && $disp_ping) {
    connect_to_db;
  }

### Statement Handle STH
  if ($AUTOLOAD =~ /.*::_sth_([\w_]+)/) {
    $sth = '_sth_' . $1;

    return if $STH->{$sth};  ### If it's already defined, return

    if ( ! exists $self->{methods}{$1} ) {
      return 0;
    }

    if ( ! exists $self->{methods}{$1}->{sql} ) {
      return 0;
    }

    $STH->{$sth} = $DBH->prepare($self->{methods}{$1}->{sql});

    return;

### Method
  } elsif (defined $self->{methods}{$meth}) {

    $sth = '_sth_' . $meth;
    $self->$sth();                 ### Turn into sth and call it to tr
+igger AUTOLOAD

    if ( $self->{methods}{$meth}->{cache} ) {
      $return_value = $self->search_cache($meth, @pass_values);
      return $return_value if $return_value;
    }

    $return_value = $self->execute_db($meth, @pass_values);

    if ( $return_value &&
         $self->{methods}{$meth}->{cache} ) {
      $self->save_into_cache($meth, @pass_values, $return_value);
    }

    return $return_value;
  }

}

=item I<PACKAGE>->execute_db

  Executes a SQL statement against the DB.  


=cut

sub execute_db {
  my $self        = shift;
  my $meth        = shift;
  my @pass_values = @_;

  my ($sthname,
      $sth,
      $argsref,
      @bind_values,
      $cnt,
      $rv,
      $return_value);

  $sth = '_sth_' . $meth;

  @bind_values = ();
  foreach (@pass_values) {
    push @bind_values, $_;       ### Build argument list
  }

  $rv = $STH->{$sth}->execute(@bind_values);

  if ($self->{methods}{$meth}->{ret_type} == RETURN_ARRAY) {

    my @ret;
    while (my (@ref) = $STH->{$sth}->fetchrow_array) {
      push @ret, @ref
    }
    return @ret;

  } elsif ($self->{methods}{$meth}->{ret_type} == RETURN_ARRAYREF) {

    my $ret = $STH->{$sth}->fetchrow_arrayref;
    if ((!defined $ret) || (ref $ret eq 'ARRAY')) {
      return $ret;
    }

  } elsif ($self->{methods}{$meth}->{ret_type} == RETURN_HASHREF) {

    my $ret = $STH->{$sth}->fetchrow_hashref;
    if ((!defined $ret) || (ref $ret eq 'HASH')) {
      return $ret;
    }

  } elsif ($self->{methods}{$meth}->{ret_type} == RETURN_ARRAY_HASHREF
+) {

    my @ret;
    while (my $ref = $STH->{$sth}->fetchrow_hashref) {
      push @ret, $ref;
    }

    return \@ret;

  } elsif ($self->{methods}{$meth}->{ret_type} == RETURN_RV) {

    return $rv;

  }

}

=item I<PACKAGE>->search_cache

  Search the cache for data.  It will build a key and do a search.  If
+ it's available
  and has not expired, it will retrieve it.


=cut

sub search_cache {
  my $self        = shift;
  my $meth        = shift;
  my $pass_values = shift;

  my $key = $self->get_cache_key($meth,
                                 $pass_values);

  return( $CacheObj->get($key) );
}

=item I<PACKAGE>->save_into_cache

  Save data into cache using the generated key and the expire value of
+ this SQL 
  statement.


=cut

sub save_into_cache {
  my $self        = shift;
  my $meth        = shift;
  my $pass_values = shift;
  my $data        = shift;

  my $key = $self->get_cache_key($meth,
                                 $pass_values);

  $CacheObj->set($key,
                 $data,
                 $self->{methods}{$meth}->{expire});

}

=item I<PACKAGE>->get_cache_key

  Create a cache key.  The cache key will be constructed using the met
+hod name and 
  each value supplied to the query.
 

=cut

sub get_cache_key {
  my $self        = shift;
  my $meth        = shift;
  my $pass_values = shift;

  my $key = $meth . '_';

  if ( ref $pass_values eq 'ARRAY' ) {
    foreach ( @$pass_values ) {
      $key .= $_ . '_';
    }
  } else {
    $key .= $pass_values . '_';
  }

  return $key;
}

1;
[download]

---

---

Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!

Titles consisting of a single word are discouraged, and in most cases are disallowed outright.

Read Where should I post X? if you're not absolutely sure you're posting in the right place.

Please read these before you post! —

• How do I compose an effective node title?
• How do I post a question effectively?
• Markup in the Monastery

Posts may use any of the Perl Monks Approved HTML tags:

a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr

You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)

	For:		Use:
	&		&
	<		&lt;
	>		&gt;
	[		&#91;
	]		&#93;

Link using PerlMonks shortcuts! What shortcuts can I use for linking?

See Writeup Formatting Tips and other pages linked from there for more info.