Super_carotte | Merci Gilou! Ton code fonctionne parfaitement. Comme je l'esperai, ça a permis de supprimer une erreure qui arivait de temps en temps a savoir: si je mettai un sleep a 1 (pour simuler le lancement d'un job) la hiérarchisation ne fonctionnait plus.
Encore merci !
Cordialement,
Benjamin Pleumeckers.
Pour les curieux, 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
- {
- my $ID = $row->{ID_PROCESS};
- my $LOCK = $row->{LOCK};
- my $TYPE = $row->{TYPE};
- my $PERE = $row->{PERE};
- print "tabProcFini : @tabProcFini\n";
- print "tabProcEnCours : @tabProcEnCours\n";
- print "PROCESS $ID lets work on it! \n";
- my %hashEncours = map{$_ => 1} (@tabProcEnCours);
- 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";
- 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 1; # je fais un sleep pour simuler le temps de traitement du processus
- (tied @tabProc_temp)->shlock;
- my @indextoremove = ();
- foreach my $row_inFork (0..$#tabProc_temp) {
- push(@indextoremove, $row_inFork) if ($tabProc_temp[$row_inFork]->{ID_PROCESS} == $ID_inFork )
- }
- foreach ((reverse @indextoremove)) {
- splice(@tabProc_temp, $_, 1);
- }
- (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;
- my %hashTabProcEnCours = map{$_ => 1} (@tabProcEnCours);
- delete $hashTabProcEnCours{$ID_inFork};
- @tabProcEnCours=keys(%hashTabProcEnCours);
- (tied @tabProcEnCours)->shunlock;
- 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);
- my @tab = keys %hash;
- my $nombre_elements_commun = @tab1 + @tab2 - @tab;
- 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 1; # je fais un sleep pour simuler le temps de traitement du processus
- (tied @tabProc_temp)->shlock;
- my @indextoremove = ();
- foreach my $row_inFork (0..$#tabProc_temp) {
- push(@indextoremove, $row_inFork) if ($tabProc_temp[$row_inFork]->{ID_PROCESS} == $ID_inFork )
- }
- foreach ((reverse @indextoremove)) {
- splice(@tabProc_temp, $_, 1);
- }
- (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;
- my %hashTabProcEnCours = map{$_ => 1} (@tabProcEnCours);
- delete $hashTabProcEnCours{$ID_inFork};
- @tabProcEnCours=keys(%hashTabProcEnCours);
- (tied @tabProcEnCours)->shunlock;
- print "PROCESS ","$ID_inFork well started inside\n\n";
- $pm->finish;
- }else
- {
- 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 "PROCESS","$ID is Locked !!! \n";
- push(@tabProcFini,$ID);
- print "\n";
- }
- }
- sleep 1;
- #$i++;
- #print "tabProc_temp : \n";
- #print Data::Dumper::Dumper @tabProc_temp;
- }
- }
- $pm->wait_all_children;
- print "tabProc_temp : \n";
- print Data::Dumper::Dumper @tabProc_temp;
- print "tabProcFini : @tabProcFini\n";
- print "tabProcEnCours : @tabProcEnCours\n\n";
|
|