• Publicidad

Variables globales con threads

Así que programas sin strict y las expresiones regulares son otro modo de hablar. Aquí encontrarás respuestas de nivel avanzado, no recomendable para los débiles de corazón.

Variables globales con threads

Notapor Moraita » 2009-03-11 07:43 @363

¡Hola!

Intentaré exponer el problema con la mínima información que sea suficiente para no liar el tema,
a ver si consigo explicarme...

Tengo un proceso A que contiene dos threads.
El thread X escucha constantemente señales que llegan aunque no las encola, solo se queda con la última.

El thread Y chequea si ha habido señal en cuyo caso se pone a trabajar (ejecuta el trabajo duro). Al acabar el trabajo chequea si hubo una señal (la última) para volver a empezar.

Para simplificarme el trabajo, decidí hacer lo siguiente:
1) jugar con threads... me creé un proceso con dos threads donde uno escucha y el otro ejecuta al haber recibido una señal
2) me creé un proceso B independiente que hace la tarea del thread Y, al ser grande prefería verlo funcionar solo... (éste tiene sus variables, subrutinas, conexiones a BD...)
3) insertar el código de mi proceso B en el proceso A y que funcione como un todo ---> ¡¡¡aquí empieza la fiesta!!!

Este es el código de los threads funcionando correctamente:

Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
#!/usr/bin/perl
use strict;
use warnings;
use File::Basename;

use IPC::SysV qw(ftok S_IRUSR S_IWUSR);

use threads ();
use threads::shared ();
my $signal : shared = 0;

my @http_params = '';
my @partition_params = '';

######################
#inizialize variables#
######################

my $script = basename($0);
my $TOKEN;
my $buffer;

## Creación del token
if ($script eq 'partition1.pl') {
print "partition 1 running\n";
$TOKEN = ftok('/tmp/',1);
print "Token: $TOKEN\n";
}

else {
print "no partition defined\n";
$TOKEN = ftok('/tmp/',5);
print "Token: $TOKEN\n";
}
our $id = shmget($TOKEN, 200, S_IRUSR|S_IWUSR) or die $!;
print "shm key $id\n";


######
#main#
######

my $httpPublisher = threads->new(\&listenToSignal, @http_params);
my $httpConsumer = threads->new(\&updateCube, @partition_params);

my @returned_data_http = $httpPublisher->join;
my @returned_data_update = $httpConsumer->join;

#############
#subroutines#
#############

sub listenToSignal{
while ('para siempre') {
lock($signal);
if ($signal eq 0){
sleep 1; # sleep
shmread($id, $buffer, 0, 160) or die $!; # Read message
substr($buffer, index($buffer, "\0")) = ''; # Clean buffer. buffer is full of \0 chars
next if !$buffer; # wait until something comes

print "Listening thread......got signal for partition $buffer \n";
shmwrite($id, '', 0, 160) or die $!; # set IPC shared var to 0

$signal = $buffer;
}
}
}#end sub

sub updateCube{
while ('para siempre') {
lock($signal);
if ($signal > 0){
$signal = 0;
sleep 20; #code for update comes here
my $timestamp = `date "+%H:%M.%S"`;
print "Done update... ready to receive another update \n";

}
}
}
Coloreado en 0.004 segundos, usando GeSHi 1.0.8.4


Y esto es lo que hago ahora y no sé por dónde ir. Necesito sugerencias o explicaciones de porqué no me funciona.
Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
#!/usr/bin/perl

use strict;
use warnings;
use File::Basename;
use Essbase;
use DBI;
use strict;
use Env;

use FindBin ();
use lib "$FindBin::Bin";
use Properties;

use IPC::SysV qw(ftok S_IRUSR S_IWUSR);

use threads ();
use threads::shared ();
my $signal : shared = 0;
#my $signal : shared = 0;
my @http_params = '';
my @partition_params = '';

######################
#inizialize variables#
######################

my $script = basename($0);
my $TOKEN;
my $buffer;

my $partition;

## Creación del token
if ($script eq 'ccx_partition1.pl') {
print "partition 1 running\n";
$TOKEN = ftok('/tmp/',1);
print "Token: $TOKEN\n";
$partition = 1;
}

else {
print "no partition defined\n";
$TOKEN = ftok('/tmp/',5);
print "Token: $TOKEN\n";
$partition = 1;
}
our $id = shmget($TOKEN, 200, S_IRUSR|S_IWUSR) or die $!;
print "shm key $id\n";

##############################
#define variables for process#
##############################

my($dbh_sre,$dbh_ess,$array_ref,$dimensions,@updateTypes,$maxlCodeForDimensions, $row_refs,$openSessionEss,$i,$cmd,$execution,@maxlScripts);

#.....aqui vienen todas las variables de conexion a base de datos etc....


########################
#access to SRE database#
########################
sre_Initialize( );


######
#main#
######

my $httpPublisher = threads->new(\&listenToSignal, @http_params);
my $httpConsumer = threads->new(\&updateCube, @partition_params);

my @returned_data_http = $httpPublisher->join;
my @returned_data_update = $httpConsumer->join;

#############
#subroutines#
#############

sub listenToSignal{
while ('para siempre') {
lock($signal);
if ($signal eq 0){
sleep 1; # sleep
shmread($id, $buffer, 0, 160) or die $!; # Read message
substr($buffer, index($buffer, "\0")) = ''; # Clean buffer. buffer is full of \0 chars
next if !$buffer; # wait until something comes
print "Listening thread......got signal for partition $buffer \n";
shmwrite($id, '', 0, 160) or die $!; # set IPC shared var to 0

$signal = $buffer;
}
}
}#end sub

sub updateCube{
while ('para siempre') {
lock($signal);
if ($signal > 0){
$signal = 0;
# sleep 20; #code for update comes here
print "Done update... ready to receive another update \n";

$row_refs = sre_do('SQL_SELECT_UPDATE_TYPES','fetch',$partition);

}
}
}



############
#subrutines#
############


sub sre_Initialize
{
# get an sre handle
$dbh_sre=DBI->connect ($sreDabase_string, $sreDBUser, $sreDBPass,{PrintError => 0, RaiseError => 1});

print "sre database connected \n";
}
sub sre_Deinitialize
{
# disconnect from sre
$dbh_sre->disconnect;
print "sre database disconnected\n";
}

sub sre_do
{
#execute sql statement
my $results = '';
my ($sql_code,$op_type, $var1, $var2, $var3,$var4)=@_;

my $sql=$param->get($sql_code);

if ($var1 ne ''){$sql =~ s/VAR1/'$var1'/;}
if ($var2 ne ''){$sql =~ s/VAR2/'$var2'/;}
if ($var3 ne ''){$sql =~ s/VAR3/'$var3'/;}
if ($var4 ne ''){$sql =~ s/VAR4/'$var4'/;}

print "\nselect to be run: $sql \n";
print "tipo de statement: $op_type \n";
my $sth =$dbh_sre->prepare($sql) or print " $logScript: ERROR accesing r_cube_ctrl and temp_load_ctrl while collecting rows to process: couldn't prepare $DBI::errstr";
$sth->execute() or print " $logScript: ERROR executing sql while collecting rows to process: couldn't prepare $DBI::errstr";
if ($op_type eq 'fetch'){
$results = $sth->fetchall_arrayref({}) or print " $logScript: ERROR fetching results while collecting rows to process: couldn't prepare $DBI::errstr";
my $count = scalar (@$results);
print " $logScript: $count rows found\n";
$sth->finish;
return $results;
}
else{
$sth->finish;
# $dbh_sre->commit or die $dbh_sre->errstr;
}
}
Coloreado en 0.003 segundos, usando GeSHi 1.0.8.4



Bien, si os fijais,
1) he insertado una nueva línea de código en el thread Y (sub updateCube):
$row_refs = sre_do('SQL_SELECT_UPDATE_TYPES','fetch',$partition);
2) he añadido tambien todas las variables de mi proceso B como variables globales de mi proceso A:
my($dbh_sre,$dbh_ess,$array_ref,$dimensions,@updateTypes,$maxlCodeForDimensions, $row_refs,$openSessionEss,$i,$cmd,$execution,@maxlScripts);
#... aquí vienen todas las variables de conexión a base de datos etc...
3) he añadido las subrutinas de mi proceso B en mi proceso A (al final)
#... no os he copiado todas...

Total, que a la altura de la instrucción:
Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
if ($var2 ne ''){$sql =~ s/VAR2/'$var2'/;}
Coloreado en 0.001 segundos, usando GeSHi 1.0.8.4

me dice;
Código: Seleccionar todo
Use of uninitialized value in string ne at .....


¿Alguna sugerencia?
Puede ser un principio del fin que no veo que esté cerca :(..
Gracias
Moraita
Perlero nuevo
Perlero nuevo
 
Mensajes: 36
Registrado: 2008-10-29 10:25 @475

Publicidad

Notapor explorer » 2009-03-11 08:24 @392

Y, en vez de modificar la sentencia SQL con sustituciones, ¿no sería mejor usar el binding del prepare() y luego el execute() del DBI?
JF^D Perl programming & Raku programming. Grupo en Telegram: https://t.me/Perl_ES
Avatar de Usuario
explorer
Administrador
Administrador
 
Mensajes: 14480
Registrado: 2005-07-24 18:12 @800
Ubicación: Valladolid, España

Notapor Moraita » 2009-03-11 09:02 @418

Tienes razón, explorer.

Utilizaré el bind, ¡¡¡perdón por mi código cutre!!!

De todas formas he introducido la conexión a la base de datos en el thread Y y de momento funciona correctamente...

Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
sub updateCube{

        sre_Initialize( );
.........
Coloreado en 0.001 segundos, usando GeSHi 1.0.8.4


Seguiré con mi guerra y cuando consiga que funcione la lógica del thread Y me pondré a optimizar código... utilizar el bind, etc...
¡Gracias por estar ahí!
Moraita
Perlero nuevo
Perlero nuevo
 
Mensajes: 36
Registrado: 2008-10-29 10:25 @475


Volver a Avanzado

¿Quién está conectado?

Usuarios navegando por este Foro: No hay usuarios registrados visitando el Foro y 7 invitados

cron