I am a the beginning of a maintenance contract, I’ve never done Perl before and this is what I found.
I have:
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;
}
}
To use this I have something like
( $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;
When I run this on a server with Centos 5.6 I get:
rs ->$VAR1 = {
'nivel_acceso' => '{"",NL,NL,NL,NL,"","","","","","","","","","","","","","","","","","","","","","","","",""}',
'correo' => 'xxxx@gmail.com',
'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}'
};
When I run it on Centos 5.7 what I get is:
rs ->$VAR1 = {
'nivel_acceso' => [ 'NL', 'NL', 'NL', 'NL', 'NL', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '' ],
'correo' => 'rigoaj@hotmail.com',
'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 is perl5 (revision 5 version 8 subversion 8) but the in 5.7 is 64 bits while the one in 5.6 is 32.
Both servers are running postgresql-8.1, the rpms installed are:
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
As of DBI and DBD:Pg:
5.6
DBI 1.52
DBD::Pg 1.49
5.7
DBI 1.52
DBD::Pg 2.18.1
I have no idea why the difference. Your hints, tips and explanations are all welcome.
I’m modestly confident that you have a version difference between the two machines in the software stack, which consists of:
At least one and possibly several of those layers are different. You state that the server is PostgreSQL 8.1 on both; that suggests the issue is in the client-side library or DBD::Pg. It is relatively unlikely to be an issue with either the version of Perl or the version of DBI, but that might depend a bit on how different the two versions (of Perl and DBI) are. It is very unlikely that the difference is due to the o/s version.
The older code (on Centos 5.6) is returning a string form of the data in the arrays. The newer code is handling the arrays more naturally. That still doesn’t explain the difference between
$rs->uaa->[0]in the new and the first (empty) field in the old, but does account for most of the rest.Perl DBI is unusually demanding in the sheer number of versions that could be relevant. However, I think your problems stem from the old
DBD::Pgmodule.According to http://search.cpan.org/,
I recommend upgrading to the same more recent version on both machines, or bringing the older version into line with the new version on the older machine. The DBI version is less likely to be the source of the trouble, but it would still be good to upgrade to the most current version.