为什么这个 Perl 代码在不同的机器上运行时返回不同的数据类型？

Question

我是维护合同的新手，我以前从未使用过 Perl，这就是我发现的。

我有：

sub record {
    my ( $dbh, $sth, $sql, %rs, %arg, @alias, $key, %default );
    %default = ( db => '*', tabla => '*', campos => '*', condicion => '', campos => '*', alias => '*', visible => 'si' );
    %arg = @_;

    if ( $arg{campos} ) { $default{alias} = $arg{campos}; }
    foreach $key ( keys %default ) {
        if ( !exists $arg{$key} ) { $arg{$key} = $default{$key}; }
        if ( exists $arg{$key} && $arg{$key} eq '' ) { $arg{$key} = $default{$key}; }
        if ( $arg{$key} eq '*' ) { &msj( "Error !!!", "$key is needed" ); return; }
    }

    @alias = split /,/, $arg{alias};

    $dbh = DBI->connect( "dbi:Pg:dbname=$arg{db}; host=$ipserver; port=5432", "postgres", "xxxx" ) or die "Error: $DBI::errstr";

    if ( !$DBI::errstr ) {
        $sql = "SELECT $arg{campos} FROM $arg{tabla} $arg{condicion}";
        if ( $arg{visible} eq 'si' ) { &msj( "Consulta a la base de datos $arg{db}", $sql ); }
        $sth = $dbh->prepare($sql) or die "No se ha preparado: $DBI::errstr";
        $sth->execute;
        @rs{@alias} = ();
        if ( $DBI::rows > 0 ) {
            $sth->bind_columns( map { \$rs{$_} } @alias );
        }
        return ( \%rs, sub { $sth->fetch() } );
        $sth->finish;
        $dbh->disconnect;
    } else {
        &mensaje( "Error !!!!", "No access to $arg{db}" );
        exit;
    }
   }

要使用这个，我有类似的东西

( $rs, $fetch ) = record( db => "infodfsisadmon", tabla => "login", condicion => "where usuario='$FORM{usuario}' and clave='$FORM{clave}'", campos => "acceso,referencia,id_modulo,uaa,nivel_acceso,privilegios,activo,correo", visible => "si" );
# Show me the record
print "rs ->" . Dumper $rs;

当我在 Centos 5.6 的服务器上运行它时，我得到：

rs ->$VAR1 = { 
    'nivel_acceso' => '{"",NL,NL,NL,NL,"","","","","","","","","","","","","","","","","","","","","","","","",""}', 
    'correo' => '[email protected]', 
    'privilegios' => '{ADM,ADMINISTRADOR,ADM,ADM,1:AMEI:2:AMEI:3:AMEI:4:AMEI:5:AMEI,"","","","","","","","","","","","","","","","","","","","","",""," ","",""}', 
    'acceso' => '{t,t,t,t,t,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f}', 
    'referencia' => '{/cgi-bin/infodf/nomina/index.cgi,/cgi-bin/infodf/contable/index0.cgi,/cgi-bin/infodf/presupuesto/index0.cgi,/cgi-bin/infodf/nomina_fonacot/index.cgi,/cgi-bin/infodf/recmat/index.cgi,"","","","","","","","","","","","","","","","","","","","","","","","",""}', 
    'id_modulo' => '{1,2,3,4,5,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0}', 
    'uaa' => '{"",002,002,002,002,"","","","","","","","","","","","","","","","","","","","","","","","",""}', 
    'activo' => '{t,t,t,t,t,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f}' 
    };

当我在 Centos 5.7 上运行它时，我得到的是：

rs ->$VAR1 = { 
    'nivel_acceso' => [ 'NL', 'NL', 'NL', 'NL', 'NL', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '' ], 
    'correo' => '[email protected]', 
    'privilegios' => [ 'ADM', 'ADMINISTRADOR', 'ADM', 'ADM', '1:AMEI:2:AMEI:3:AMEI:4:AMEI:5:AMEI', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', ' ', '', '' ], 
    'acceso' => [ 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ], 
    'referencia' => [ '/cgi-bin/infodf/nomina/index.cgi', '/cgi-bin/infodf/contable/index0.cgi', '/cgi-bin/infodf/presupuesto/index0.cgi', '/cgi-bin/infodf/nomina_fonacot/index.cgi', '/cgi-bin/infodf/recmat/index.cgi', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '' ], 
    'id_modulo' => [ 1, 2, 3, 4, 5, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ], 
    'uaa' => [ 'CONS', '002', '002', '002', '002', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '' ], 
    'activo' => [ 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ] 
};

Perl on Centos 5.6 is perl5 (revision 5 version 8 subversion 8) on Centos 5.7 是 perl5（修订版 5 版本 8 颠覆 8），但 5.7 中的是 64 位，而 5.6 中的是32.

两台服务器都运行 postgresql-8.1，安装的 rpm 为：

5.6
postgresql-8.1.22-1.el5_5.1
postgresql-contrib-8.1.22-1.el5_5.1
postgresql-docs-8.1.22-1.el5_5.1
postgresql-jdbc-8.1.407-1jpp.4
postgresql-libs-8.1.22-1.el5_5.1
postgresql-odbc-08.01.0200-3.1
postgresql-pl-8.1.22-1.el5_5.1
postgresql-python-8.1.22-1.el5_5.1
postgresql-server-8.1.22-1.el5_5.1
postgresql-test-8.1.22-1.el5_5.1

5.7
postgresql-8.1.23-1.el5_7.3
postgresql-devel-8.1.23-1.el5_7.3
postgresql-libs-8.1.23-1.el5_7.3
postgresql-server-8.1.23-1.el5_7.3

自 DBI 和 DBD:Pg:
5.6
DBI 1.52
DBD::页 1.49

5.7
DBI 1.52
DBD::Pg 2.18.1

我不知道为什么会有区别。欢迎您提供提示、技巧和解释。

Answer 1

我有信心两台机器之间的软件堆栈存在版本差异，其中包括：

• Perl
• DBI
• DBD::Pg (PostgreSQL)
• PostgreSQL 客户端库（ODBC 或其他）
• PostgreSQL DBMS

至少这些层中的一层或可能有几层是不同的。您声明服务器在两者上都是 PostgreSQL 8.1；这表明问题出在客户端库或 DBD::Pg 中。相对而言，Perl 版本或 DBI 版本不太可能出现问题，但这可能在一定程度上取决于两个版本（Perl 和 DBI）的差异程度。差异不太可能是由于操作系统版本造成的。

旧代码（在 Centos 5.6 上）返回数组中数据的字符串形式。较新的代码可以更自然地处理数组。这仍然无法解释新字段中的 $rs->uaa->[0] 与旧字段中的第一个（空）字段之间的区别，但确实解释了其余大部分字段。

---

Perl DBI 对于相关版本的绝对数量要求异常高。但是，我认为您的问题源于旧的 DBD::Pg 模块。

根据http://search.cpan.org/，

• DBD::Pg ：CPAN 上的最新版本是 2.99.9_1 从 2011 年 6 月开始； 2.18是2011年5月起； 1.49 不在 CPAN 上，但 1.32 的日期是 2004 年 2 月，2.5.0 的日期是 2008 年 3 月）。
• DBI：CPAN最新版本为1.616，从2010年12月开始； 1.52 不在 CPAN 上，但 1.53 已在 2006 年 11 月发布。

我建议在两台机器上升级到相同的更新版本，或者使旧版本与旧机器上的新版本保持一致。 DBI 版本不太可能成为问题的根源，但升级到最新版本仍然会很好。