jck000 has asked for the wisdom of the Perl Monks concerning the following question:

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]

Replies are listed 'Best First'.
Re: Postgres sth disappears w/Zeus ModPerl
by perrin (Chancellor) on Apr 21, 2009 at 19:11 UTC
    You really shouldn't do this yourself. DBI has it built-in. Look at connect_cached and prepare_cached. These have more safeguards built in.
[reply]
      I had tried prepare_cached. Same results.
[reply]
        There's an optional argument to prepare_cached which will just create a new statement if the old one doesn't work. You may also want to ask on the dbi-users list where someone may have seen this before.
[reply]
Re: Postgres sth disappears w/Zeus ModPerl
by Anonymous Monk on Apr 21, 2009 at 15:38 UTC
[reply]
Re: Postgres sth disappears w/Zeus ModPerl
by moritz (Cardinal) on Apr 21, 2009 at 15:36 UTC
    The error is in line 42 of your code, obviously.

    Or to elaborate a bit more, if you see errors from some code, providing that code could help us discovering the error.

[reply]

      Updated original message with code.
[reply]

Back to Seekers of Perl Wisdom