Я являюсь началом контракта на обслуживание, я никогда раньше не делал 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' => '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}'
};
Когда я запускаю его на Centos 5.7, я получаю:
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 в Centos 5.6 - это perl5 (версия 5, версия 8, subversion 8), в Centos 5.7 - это perl5 (версия 5, версия 8, subversion 8), но в 5.7 - 64 бита, а в 5.6 - 32.
На обоих серверах работает postgresql-8.1, установлены rpms:
5,6
PostgreSQL-8.1.22-1.el5_5.1
PostgreSQL-вно-8.1.22-1.el5_5.1
PostgreSQL-документы-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-пл-8.1.22-1.el5_5.1
PostgreSQL-питон-8.1.22-1.el5_5.1
PostgreSQL-сервера 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-разви-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 :: Pg 1.49
5,7
DBI 1,52
DBD :: Pg 2.18.1
Понятия не имею, почему разница. Ваши советы, подсказки и объяснения приветствуются.