[PERL] Erreure dans code. Algo?

Marsh Posté le 15-12-2011 à 17:27:32

Bonjour, :hello:

J'ai fait un code qui simule le lancement en multithread de 9 jobs.
Ces jobs sont hiérarchisés comme suit:
1-->4,5-->7-->8 Donc 8 a pour père 7 qui a pour pere 4 et 5 qui ont pour père 1
2-->6-->8 Donc 8 a pour père 6 qui a pour père 2
3-->8,9 Donc 9 a pour père 3
Donc, 8 a pour père direct 7, 6 et 3.

Il fonctionne car mon tableau final contient bien l'ensemble de mes jobs (de 1 a 9) mais mon probleme vient du fait que mon tableau contenant la liste des jobs "en cour de traitement " n'est pas vide a la fin du programme :pfff: . En effet, les jobs 7 et 8 sont toujours présent dedans.
Je ne vois pas pourquoi car mon code gère (il me semble) bien la destruction de ces valeurs.

Si un curieux a le courage de se plonger dedans et parvient a trouver l’erreur, je suis preneur

Merci,
Benjamin

Voici le code:

Code :

#!/usr/bin/perl -w
use strict;
use warnings;
use diagnostics;
use Data::Dumper;
use Parallel::ForkManager;
use IPC::Shareable;
####################### PACKAGES ###########################
package Job;
my @listJob = ();
my @tabProc = ();
sub new {
my ($class, $ID_PROCESS, $ALIAS, $PERE, $FILS, $LOCK, $TYPE, $STARTED) = @_;
my $this = {};
bless($this, $class);
$this->{ID_PROCESS} = $ID_PROCESS;
$this->{ALIAS} = $ALIAS;
$this->{PERE} = $PERE;
$this->{FILS} = $FILS;
$this->{LOCK} = $LOCK;
$this->{TYPE} = $TYPE;
$this->{STARTED} = $STARTED;
push(@listJob,$ID_PROCESS);
push(@tabProc,$this);
return $this;
}
sub getID {
my ($this) = @_;
return $this->{ID_PROCESS};
}
sub getAlias {
my ($this) = @_;
return $this->{ALIAS};
}
sub getPere {
my ($this) = @_;
return $this->{PERE};
}
sub getFils {
my ($this) = @_;
return $this->{FILS};
}
sub getLock {
my ($this) = @_;
return $this->{LOCK};
}
1;
####################### FIN PACKAGES ###########################
####################### MAIN ###########################
my $pere;
my $fils;
my $LEVEL=0;
$pere = undef;
$fils = "4,5";
my $proc1 = new Job( "1", "alias1", $pere, $fils, "0", "unknown", "0" );
$pere = undef;
$fils = "6";
my $proc2 = new Job( "2", "alias2", $pere, $fils, "0", "unknown", "0" );
$pere = undef;
$fils = "8,9";
my $proc3 = new Job( "3", "alias3", $pere, $fils, "0", "unknown", "0" );
$pere = "1";
$fils = "7";
my $proc4 = new Job( "4", "alias4", $pere, $fils, "0", "unknown", "0" );
$pere = "1";
$fils = "7";
my $proc5 = new Job( "5", "alias5", $pere, $fils, "0", "unknown", "0" );
$pere = "2";
$fils = "8";
my $proc6 = new Job( "6", "alias6", $pere, $fils, "0", "unknown", "0" );
$pere = "4,5";
$fils = "8";
my $proc7 = new Job( "7", "alias7", $pere, $fils, "0", "unknown", "0" );
$pere = "7,6,3";
$fils = undef;
my $proc8 = new Job( "8", "alias8", $pere, $fils,, "0", "unknown", "0" );
$pere = "3";
$fils = undef;
my $proc9 = new Job( "9", "alias9", $pere, $fils, "0", "unknown", "0" );
print "listJob : @listJob\n";
print Data::Dumper::Dumper @tabProc;
foreach my $row (@tabProc)
{
if ($row->{PERE} eq undef)
{
$row->{PERE} = "NULL";
}else
{
$row->{PERE} =~ s/,/ /g;
}
if ($row->{FILS} eq undef)
{
$row->{FILS} = "NULL";
}
else
{
$row->{FILS} =~ s/,/ /g;
}
if ($row->{PERE} eq "NULL" )
{
$row->{TYPE} = "PERE-0";
}
else
{
if ($row->{FILS} eq "NULL" )
{
$row->{TYPE} = "FILS";
}
else
{
$row->{TYPE} = "PERE";
}
$row->{STARTED} = 0;
}
$LEVEL+=1;
}
print Data::Dumper::Dumper @tabProc;
print "LEVEL : $LEVEL\n";
my $RETOUR;
my @tabProc_temp=();
my @tabProcEnCours;
my @tabProcFini;
my $i=0;
my %options = (
create => 1,
exclusive => 0,
mode => 0644,
destroy => 0,
);
print "tabProcFini: @tabProcFini\n";
print "tabProcEnCours: @tabProcEnCours\n";
print "tabProc_temp: @tabProc_temp\n";
tie @tabProc_temp, 'IPC::Shareable', 'tie1', \%options;
tie @tabProcEnCours, 'IPC::Shareable', 'tie2', \%options;
tie @tabProcFini, 'IPC::Shareable', 'tie3', \%options;
@tabProcEnCours=();
@tabProcFini=();
@tabProc_temp=@tabProc; #tabProc_temp contient la copie de la liste des processus existants.
print "tabProc_temp: @tabProc_temp\n";
my $pm = new Parallel::ForkManager(10);
while( @tabProc_temp ) #Tant que le tableau des processus n'est pas vide
{
$i=0;
foreach my $row (@tabProc_temp) #pour chaque processus
{
# print "tabProcEnCours: @tabProcEnCours\n";
# print "tabProcFini: @tabProcFini\n";
my $ID = $row->{ID_PROCESS};
my $LOCK = $row->{LOCK};
my $TYPE = $row->{TYPE};
my $PERE = $row->{PERE};
print "PROCESS $ID lets work on it! \n";
my %hashEncours = map{$_ => 1} (@tabProcEnCours);
# print "ID : $ID\n";
# print "tabProc_temp : \n";
# print Data::Dumper::Dumper @tabProc_temp;
print "tabProcFini : @tabProcFini\n";
print "tabProcEnCours : @tabProcEnCours\n\n";
if (exists $hashEncours{$ID}) #si le processus est en cour de traitemet
{
print "PROCESS $ID already forked! \n";
print "PROCESS ","$ID Let's try another process \n\n";
}else
{
if ($LOCK == "0" ) #si le processus est bloqué (dans ce test code, il ne l'est jamais)
{
$RETOUR = "Not OK";
if ($RETOUR eq "OK" ) #si le retout est OK (dans ce test code, il ne l'est jamais)
{
print "PROCESS","$ID is Running \n";
push(@tabProcFini,$ID);
print "\n";
}
else
{
print "PROCESS ","$ID is Stopped \n\n";
if ($TYPE eq "PERE-0" ) #si le processus en cour de traitement est tout en haut de l'arbre (donc que lui meme n'a pas de pere)
{
$pm->start and next; # je lance un fork
my $ID_inFork = $ID;
(tied @tabProcEnCours)->shlock;
push(@tabProcEnCours,$ID_inFork); #j'ajoute le processus dans le tableau des processus en cour de traitement
(tied @tabProcEnCours)->shunlock;
sleep 3; # je fais un sleep pour simuler le temps de traitement du processus
(tied @tabProc_temp)->shlock;
@tabProc_temp = @tabProc_temp[0..($i-1),($i+1)..$#tabProc_temp]; #j'enleve le processus du talbeau contenant la liste des processus
(tied @tabProc_temp)->shunlock;
(tied @tabProcFini)->shlock;
push(@tabProcFini,$ID_inFork); # j'ajoute le processus dans le tableau contenant les processus fini
(tied @tabProcFini)->shunlock;
(tied @tabProcEnCours)->shlock;
@tabProcEnCours = @tabProcEnCours[0..($i-1),($i+1)..$#tabProcEnCours]; #j'enleve le processus du talbeau contenant la liste des processus en cour
(tied @tabProcEnCours)->shunlock;
# print "tabProc_temp : \n";
# print Data::Dumper::Dumper @tabProc_temp;
# print "tabProcFini : @tabProcFini\n";
# print "tabProcEnCours : @tabProcEnCours\n\n";
print "PROCESS ","$ID_inFork well started outside \n\n";
$pm->finish;
}else
{
my @tab1 = split(/ /,$PERE);
my $tailletab1 = scalar @tab1;
my @tab2=@tabProcFini;
my %hash = map{$_ => 1} (@tab1, @tab2);
#print "hash : \n";
#print Data::Dumper::Dumper %hash;
my @tab = keys %hash;
my $nombre_elements_commun = @tab1 + @tab2 - @tab;
#print "tab1 : @tab1`\n";
#print "tab2 : @tab2`\n";
#print "tab : @tab`\n";
#print "tailletab1 : $tailletab1`\n";
#print "nombre_elements_commun : $nombre_elements_commun`\n";
if($nombre_elements_commun == $tailletab1)
{
$pm->start and next; # je lance un fork
my $ID_inFork = $ID;
my $PERE_inFork =$PERE;
(tied @tabProcEnCours)->shlock;
push(@tabProcEnCours,$ID_inFork); #j'ajoute le processus dans le tableau des processus en cour de traitement
(tied @tabProcEnCours)->shunlock;
print "PROCESS ","$ID_inFork Parents: $PERE_inFork \n";
print "PROCESS ","$ID_inFork Les elements de la liste \"PERE\" du process $ID_inFork sont tous présents dans le tableau \@tabProcFini \n\n";
sleep 3; # je fais un sleep pour simuler le temps de traitement du processus
(tied @tabProc_temp)->shlock;
@tabProc_temp = @tabProc_temp[0..($i-1),($i+1)..$#tabProc_temp]; #j'enleve le processus du talbeau contenant la liste des processus
(tied @tabProc_temp)->shunlock;
(tied @tabProcFini)->shlock;
push(@tabProcFini,$ID_inFork); # j'ajoute le processus dans le tableau contenant les processus fini
(tied @tabProcFini)->shunlock;
(tied @tabProcEnCours)->shlock;
@tabProcEnCours = @tabProcEnCours[0..($i-1),($i+1)..$#tabProcEnCours]; #j'enleve le processus du talbeau contenant la liste des processus en cour
(tied @tabProcEnCours)->shunlock;
#print "INSIDE ID_inFork : $ID_inFork\n";
#print "tabProc_temp : \n";
#print Data::Dumper::Dumper @tabProc_temp;
#print "INSIDE tabProcFini : @tabProcFini\n";
#print "INSIDE tabProcEnCours : @tabProcEnCours\n\n";
print "PROCESS ","$ID_inFork well started inside\n\n";
$pm->finish;
}else
{
# print "PROCESS $ID PERE = $PERE \n";
print "PROCESS ","$ID Les elements de la liste \"PERE\" du process $ID NE sont PAS tous présents dans le tableau \@tabProcFini \n";
print "PROCESS ","$ID Let's try another process \n\n";
}
}
$RETOUR = "OK";
if ($RETOUR ne "OK" )
{
print "PROCESS","$ID not started \n";
exit(1);
}
}
}
else
{
print "$ID Locked !!! \n";
push(@tabProcFini,$ID);
print "\n";
}
}
sleep 1;
$i++;
#print "tabProc_temp : @tabProc_temp\n";
# print "tabProc_temp : \n";
# print Data::Dumper::Dumper @tabProc_temp;
# print "tabProcFini : @tabProcFini\n";
# print "tabProcEnCours : @tabProcEnCours\n\n";
}
}
$pm->wait_all_children;
print "tabProc_temp : \n";
print Data::Dumper::Dumper @tabProc_temp;
print "tabProcFini : @tabProcFini\n";
print "tabProcEnCours : @tabProcEnCours\n\n";

Message édité par Super_carotte le 15-12-2011 à 17:49:12

Marsh Posté le 15-12-2011 à 17:27:32

Marsh Posté le 16-12-2011 à 12:03:32

J'ai trouvé l'erreure.
Elle est due a mon $i qui ne fonctionne pas correctement.

En effet, en remplaçant:

Code :

(tied @tabProcEnCours)->shlock;
@tabProcEnCours = @tabProcEnCours[0..($i-1),($i+1)..$#tabProcEnCours]; #j'enleve le processus du talbeau contenant la liste des processus en cour
(tied @tabProcEnCours)->shunlock;

Par:

Code :

(tied @tabProcEnCours)->shlock;
my %hashTabProcEnCours = map{$_ => 1} (@tabProcEnCours);
delete $hashTabProcEnCours{$ID_inFork};
@tabProcEnCours=keys(%hashTabProcEnCours);
(tied @tabProcEnCours)->shunlock;

ça fonctionne

Message édité par Super_carotte le 16-12-2011 à 12:05:16

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed

Name *

Email *

URL

Message *