[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

SF.net SVN: ledger-smb:[4149] branches/1.3



Revision: 4149
          http://ledger-smb.svn.sourceforge.net/ledger-smb/?rev=4149&view=rev
Author:   tshvr
Date:     2011-12-05 12:02:58 +0000 (Mon, 05 Dec 2011)
Log Message:
-----------
let LedgerSMB reuse already acquired dbh-handle,avoid msg:Issuing rollback() due to DESTROY without explicit disconnect() of DBD::Pg::db handle

Modified Paths:
--------------
    branches/1.3/LedgerSMB/File.pm
    branches/1.3/LedgerSMB/Form.pm
    branches/1.3/LedgerSMB.pm

Modified: branches/1.3/LedgerSMB/File.pm
===================================================================
--- branches/1.3/LedgerSMB/File.pm	2011-12-05 11:16:58 UTC (rev 4148)
+++ branches/1.3/LedgerSMB/File.pm	2011-12-05 12:02:58 UTC (rev 4149)
@@ -108,6 +108,8 @@
    x_info         =>  '%'
 };
 
+my $logger = Log::Log4perl->get_logger('LedgerSMB::File');
+
 =head1 METHODS
 
 =over
@@ -171,14 +173,23 @@
     my ($self, $args)  = @_;
     my $dbobject;
     my $rc = 0; # Success
+    $logger->debug("begin");
+    $logger->trace("self=".Data::Dumper::Dumper(\$self)." args=".Data::Dumper::Dumper(\$args)." ref=".ref($args->{base}));
     if (ref $args->{base} eq 'Form'){
          #$ENV{LSMB_NOHEAD} = 1;
          use LedgerSMB::Locale;
-         my $lsmb = LedgerSMB->new();
+         #HV trying to avoid msg:Issuing rollback() due to DESTROY without explicit disconnect() of DBD::Pg::db handle
+         # new LedgerSMB will acquire dbh_handle.This newly created dbh_handle will be unset in merge() with dbh_handle from Form
+         $logger->debug("LedgerSMB->new begin");
+         my $lsmb = LedgerSMB->new($args->{base}->{dbh});
+         $logger->debug("LedgerSMB->new end");
+         $logger->debug("LedgerSMB->merge begin");
          $lsmb->merge($args->{base});
+         $logger->debug("LedgerSMB->merge end");
          if ((ref $args->{locale}) =~ /^LedgerSMB::Locale/){
              $lsmb->{_locale} = $args->{locale};
              $dbobject = LedgerSMB::DBObject->new({base => $lsmb});
+             $logger->debug("\$dbobject->{dbh}=$dbobject->{dbh}");
          } else {
              $rc | 2; # No locale
          }
@@ -189,6 +200,7 @@
     else {
         $rc | 4; # Incorrect base type
     }
+    $logger->debug("end");
     if (!$dbobject->{dbh}){
         $rc | 1; # No database handle
     }

Modified: branches/1.3/LedgerSMB/Form.pm
===================================================================
--- branches/1.3/LedgerSMB/Form.pm	2011-12-05 11:16:58 UTC (rev 4148)
+++ branches/1.3/LedgerSMB/Form.pm	2011-12-05 12:02:58 UTC (rev 4149)
@@ -129,9 +129,8 @@
 
     if($self->{header})
     {
-     $logger->trace("self->{header}=$self->{header}");
      delete $self->{header};
-     $logger->trace("self->{header} unset!!");
+     $logger->error("self->{header} unset!!");
     }
     if ( substr( $self->{action}, 0, 1 ) !~ /( |\.)/ ) {
         $self->{action} = lc $self->{action};
@@ -1286,6 +1285,7 @@
 
 sub db_init {
     my ( $self, $myconfig ) = @_;
+    $logger->trace("begin");
 
     # Handling of HTTP Basic Auth headers
     my $auth = $ENV{'HTTP_AUTHORIZATION'};
@@ -1305,6 +1305,7 @@
     };
 
     $self->{dbh} = $self->dbconnect_noauto($dbconfig) || $self->dberror();
+    $logger->debug("acquired dbh \$self->{dbh}=$self->{dbh}");
     $self->{dbh}->{pg_server_prepare} = 0;
     my $dbh = $self->{dbh};
     my %date_query = (
@@ -1363,6 +1364,7 @@
     }
     LedgerSMB::Company_Config::initialize($self);
     $sth->finish();
+    $logger->trace("end");
 }
 
 =item $form->run_custom_queries($tablename, $query_type[, $linenum]);

Modified: branches/1.3/LedgerSMB.pm
===================================================================
--- branches/1.3/LedgerSMB.pm	2011-12-05 11:16:58 UTC (rev 4148)
+++ branches/1.3/LedgerSMB.pm	2011-12-05 12:02:58 UTC (rev 4149)
@@ -228,6 +228,8 @@
 sub new {
     #my $type   = "" unless defined shift @_;
     #my $argstr = "" unless defined shift @_;
+    (my $package,my $filename,my $line)=caller;
+
     my $type   = shift @_;
     my $argstr = shift @_;
     my %cookie;
@@ -236,22 +238,32 @@
     $type = "" unless defined $type;
     $argstr = "" unless defined $argstr;
 
-    $logger->debug("Begin LedgerSMB.pm");
+    $logger->debug("Begin called from \$filename=$filename \$line=$line \$type=$type \$argstr=$argstr ref argstr=".ref $argstr);
 
     $self->{version} = $VERSION;
     $self->{dbversion} = "1.3.8";
     
     bless $self, $type;
-    $logger->debug("LedgerSMB::new: \$argstr = $argstr");
-    my $query = ($argstr) ? new CGI::Simple($argstr) : new CGI::Simple;
-    # my $params = $query->Vars; returns a tied hash with keys that
-    # are not parameters of the CGI query.
-    my %params = $query->Vars;
-    for my $p(keys %params){
-        utf8::decode($params{$p});
-        utf8::upgrade($params{$p});
+
+    my $query;
+    my %params=();
+    if(ref($argstr) eq 'DBI::db')
+    {
+     $self->{dbh}=$argstr;
+     $logger->info("setting dbh from argstr \$self->{dbh}=$self->{dbh}");
     }
-    $logger->debug("LedgerSMB::new: params = ", Data::Dumper::Dumper(\%params));
+    else
+    {
+     $query = ($argstr) ? new CGI::Simple($argstr) : new CGI::Simple;
+     # my $params = $query->Vars; returns a tied hash with keys that
+     # are not parameters of the CGI query.
+     %params = $query->Vars;
+     for my $p(keys %params){
+         utf8::decode($params{$p});
+         utf8::upgrade($params{$p});
+     }
+    }
+    $logger->debug("params=", Data::Dumper::Dumper(\%params));
     $self->{VERSION} = $VERSION;
     $self->{_request} = $query;
 
@@ -325,9 +337,9 @@
          $ccookie =~ s/.*:([^:]*)$/$1/;
          if($ccookie ne 'Login') { $self->{company} = $ccookie; } 
     }
-    $logger->debug("LedgerSMB.pm: \$self->{company} = $self->{company}");
+    $logger->debug("\$self->{company} = $self->{company}");
 
-    $self->_db_init;
+    if(!$self->{dbh}){$self->_db_init;}
 
     LedgerSMB::Company_Config::initialize($self);
 
@@ -933,9 +945,9 @@
 sub _db_init {
     my $self     = shift @_;
     my %args     = @_;
+    $logger->debug("start");
     my $creds = LedgerSMB::Auth::get_credentials();
 
-    $logger->debug("start");
   
     $self->{login} = $creds->{login};
     if (!$self->{company}){ 
@@ -947,33 +959,35 @@
     # connection fails since this probably means bad credentials are entered.
     # Just in case, however, I think it is a good idea to include the DBI
     # error string.  CT
+    $logger->debug("before DBI->connect dbh=$self->{dbh}");
     $self->{dbh} = DBI->connect(
         "dbi:Pg:dbname=$dbname", "$creds->{login}", "$creds->{password}", { AutoCommit => 0 }
     ); 
-     my $dbh = $self->{dbh};
+    $logger->debug("after DBI->connect dbh=$self->{dbh}");
+     #my $dbh = $self->{dbh};
 
 
     if (($self->{script} eq 'login.pl') && ($self->{action} eq 
         'authenticate')){
-        if (!$dbh){
+        if (!$self->{dbh}){
             $self->{_auth_error} = $DBI::errstr;
         }
 
         return;
     }
-    elsif (!$dbh){
+    elsif (!$self->{dbh}){
         $self->_get_password;
     }
-    $dbh->{pg_server_prepare} = 0;
-    $dbh->{pg_enable_utf8} = 1;
+    $self->{dbh}->{pg_server_prepare} = 0;
+    $self->{dbh}->{pg_enable_utf8} = 1;
 
     # This is the general version check
-    my $sth = $dbh->prepare("
+    my $sth = $self->{dbh}->prepare("
             SELECT value FROM defaults 
              WHERE setting_key = 'version'");
     $sth->execute;
     my ($dbversion) = $sth->fetchrow_array;
-    $sth = $dbh->prepare("
+    $sth = $self->{dbh}->prepare("
             SELECT value FROM defaults 
              WHERE setting_key = 'role_prefix'");
     $sth->execute;
@@ -984,12 +998,12 @@
         $self->error("Database is not the expected version.  Was $dbversion, expected $self->{dbversion}.  Please re-run setup.pl against this database to correct.");
     }
 
-    $sth = $dbh->prepare('SELECT check_expiration()');
+    $sth = $self->{dbh}->prepare('SELECT check_expiration()');
     $sth->execute;
     ($self->{warn_expire}) = $sth->fetchrow_array;
    
     if ($self->{warn_expire}){
-        $sth = $dbh->prepare('SELECT user__check_my_expiration()');
+        $sth = $self->{dbh}->prepare('SELECT user__check_my_expiration()');
         $sth->execute;
         ($self->{pw_expires})  = $sth->fetchrow_array;
     }
@@ -1012,11 +1026,12 @@
     $self->{_roles} = [];
     $query = "select rolname from pg_roles 
                where pg_has_role(SESSION_USER, 'USAGE')";
-    $sth = $dbh->prepare($query);
+    $sth = $self->{dbh}->prepare($query);
     $sth->execute();
     while (my @roles = $sth->fetchrow_array){
         push @{$self->{_roles}}, $roles[0];
     }
+    $sth->finish();
     $logger->debug("end");
 }
 
@@ -1085,7 +1100,7 @@
 sub merge {
     (my $package,my $filename,my $line)=caller;
     my ( $self, $src ) = @_;
-    $logger->debug("begin caller \$filename=$filename \$line=$line");
+    $logger->debug("begin caller \$filename=$filename \$line=$line \$self->{dbh}=$self->{dbh}");
     for my $arg ( $self, $src ) {
         shift;
     }
@@ -1124,7 +1139,7 @@
         }
         $self->{$dst_arg} = $src->{$arg};
     }
-    $logger->debug("end");
+    $logger->debug("end caller \$filename=$filename \$line=$line \$self->{dbh}=$self->{dbh}");
 }
 
 sub type {

This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.