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:
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";
}
}
}
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.005 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.
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;
}
}
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.004 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:
Using perl Syntax Highlighting
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
