1

我正在尝试为 Oracle Connection 编写一个包装器（请参阅 Ora 包）。我正在使用它，如下所示：

        $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 $_;

这里是 Ora 类：

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) =@_;
    $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，问候河。

4

1 回答 1

0

我明白了...这解决了我的问题！

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

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

    return $rs;

问候和感谢！

于 2012-07-09T09:49:22.233 回答