2012-07-09 61 views
1

我正在嘗試爲Oracle Connection編寫一個包裝(請參閱Ora包)。 我使用它像下面這樣:用於連接到Oracle數據庫的模塊

 $fine->dbconnect()or die $_; 
     my $h = $fine->execSql("update qot set qot_sup_xpressfeed='$s' where qot_id=$h->{$k}->{'QOT_ID'}") ; 
     print "update qot set qot_sup_xpressfeed='$s' where qot_id=$h->{$k}->{'QOT_ID'}"; 
     $fine->dbdisconnect() or die $_; 

而這裏奧拉類:

package Ora; 

use strict; 
use warnings; 
use DBI; 
use DBD::Oracle; 
use DBD::Oracle qw(:ora_types); 
use Utils; 
sub new 
{ 
    my ($class, $dbname, $user) = @_; 
    my $self = { 
     _dbname => lc($dbname), 
     _user => lc($user), 
     # _sth => {} 
    }; 

    bless $self, $class; 
    return $self; 
} 

sub dbconnect 
{ 
     use Ora::Ora_db; 
     my ($this) = @_; 
     my $dberror = ""; 
     my $dbdriver; 
     my $OS = $^O; 
     $ENV{'ORACLE_SID'} = $this->{_dbname}; 
     $ENV{'ORACLE_TERM'} = "vt220"; 
     if ($OS =~ /linux/) 
     { 
      $ENV{'ORACLE_HOME'} = "/opt/oracle/product/10.2"; 
       $ENV{'ORACLE_BASE'} = "/opt/oracle"; 
       $ENV{'TNS_ADMIN'} = "/opt/oracle/product/10.2/network/admin"; 
       $ENV{'ORA_NLS33'} = "/opt/oracle/product/10.2/ocommon/nls/admin/data"; ## TODO: Weg, wenn nur noch 1 Client!! 
       $ENV{'NLS_LANG'} = "GERMAN_GERMANY.WE8ISO8859P1"; 
     } 

     $dbdriver = DBI->install_driver('Oracle') 
     or return("DB-Treiber konnte nicht geladen werden"); 
     my $utils=new Utils(); 
     $utils->meldung('Basis',"Starte DB-Verbindung|". $this->{_dbname}); 
     my $oradb = new Ora_db($this->{_dbname}); 
     $this->{_connection} = $dbdriver->connect(
      $this->{_dbname}, 
      "QF", 
      $oradb->getParam() , 
      { 
       RaiseError => 1, 
       AutoCommit => 0 
      }) || die "Database connection not made: $DBI::errstr"; 

    return 1; 
} 
sub dbdisconnect 
{ 
    my ($this) = (@_); 
    return($this->{_connection}->disconnect); 
} 
sub execSql 
{ 
    my ($this, $mysql, $key) = (@_); 
    my $sth; 
    my $i=0; 
    my @rs_to; # 2dim Array! 

    $sth = $this->{_connection}->prepare($mysql) || die "$mysql -> ".$this->{_connection}->errstr; 
    $sth->execute() or die "Fehler bei sth->execute: ".$this->{_connection}->errstr; 
    ##my $rs = $this->_toArray($sth); 
    my $rs = $this->_toHash($sth, $key); 
    $sth->finish(); 
    $this->{_connection}->commit; 

    return $rs; 
} 

sub _toHash 
{ 
    my ($this, $sth, $key) [email protected]_; 
    $sth->fetchall_hashref($key)or die($_); 
} 

但我發現了這個錯誤:

Assertion i == (((((SV *) (name_av))->sv_flags & 0x00008000)) ? Perl_mg_size(my_perl, (SV *) name_av) : ((XPVAV*) (name_av)->sv_any)->xav_fill)+1 failed: file "DBI.xs", line 1844 at /usr/lib/perl5/site_perl/5.8.7/i586-linux-thread-multi/DBI.pm line 1999. 
Issuing rollback() for database handle being DESTROY'd without explicit disconnect(). 

誰能給我任何線索我做錯了什麼?

TIA, Greetings r。

回答

0

我明白了......這解決了我的問題!

my $rs ; 
    $rs = $this->_toHash($sth, $key) if ($key); 

    $sth->finish(); 
    $this->{_connection}->commit; 

    return $rs; 

問候&謝謝!