Forum |  HardWare.fr | News | Articles | PC | S'identifier | S'inscrire | Shop Recherche
1219 connectés 

  FORUM HardWare.fr
  Programmation
  Perl

  [PERL] Erreure dans code. Algo?

 
 


 Mot :   Pseudo :  
 
Bas de page
Auteur Sujet :

[PERL] Erreure dans code. Algo?

n°2116820
Super_caro​tte
Posté le 15-12-2011 à 17:27:32  profilanswer
 

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)  :D  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 :
  1. #!/usr/bin/perl -w
  2. use strict;
  3. use warnings;
  4. use diagnostics;
  6. use Data::Dumper;
  7. use Parallel::ForkManager;
  8. use IPC::Shareable;
  10. ####################### PACKAGES ###########################
  11. package Job;
  12. my @listJob = ();
  13. my @tabProc = ();
  14. sub new {
  16.    my ($class, $ID_PROCESS, $ALIAS, $PERE, $FILS, $LOCK, $TYPE, $STARTED) = @_;
  17.    my $this = {};
  18.    bless($this, $class);
  19.  
  21.    $this->{ID_PROCESS} = $ID_PROCESS;
  22.    $this->{ALIAS} = $ALIAS;
  23.    $this->{PERE} = $PERE;
  24.    $this->{FILS} = $FILS;
  25.    $this->{LOCK} = $LOCK;
  26.    $this->{TYPE} = $TYPE;
  27.    $this->{STARTED} = $STARTED;
  28.  
  29.  
  30.   push(@listJob,$ID_PROCESS); 
  31.   push(@tabProc,$this);
  33. return $this;
  34.    }
  35.  
  36.  
  37. sub getID {
  38. my ($this) = @_;
  39. return $this->{ID_PROCESS};
  40. }
  41. sub getAlias {
  42. my ($this) = @_;
  43. return $this->{ALIAS};
  44. }
  45. sub getPere {
  46. my ($this) = @_;
  47. return $this->{PERE};
  48. }
  49. sub getFils {
  50. my ($this) = @_;
  51. return $this->{FILS};
  52. }
  53. sub getLock {
  54. my ($this) = @_;
  55. return $this->{LOCK};
  56. }
  57. 1;
  58. ####################### FIN PACKAGES ###########################
  62. ####################### MAIN ###########################
  63. my $pere;
  64. my $fils;
  65. my $LEVEL=0;
  67. $pere = undef;
  68. $fils = "4,5";
  69. my $proc1 = new Job( "1", "alias1", $pere, $fils, "0", "unknown", "0" );
  71. $pere = undef;
  72. $fils = "6";
  73. my $proc2 = new Job( "2", "alias2", $pere, $fils, "0", "unknown", "0" );
  75. $pere = undef;
  76. $fils = "8,9";
  77. my $proc3 = new Job( "3", "alias3", $pere, $fils, "0", "unknown", "0" );
  79. $pere = "1";
  80. $fils = "7";
  81. my $proc4 = new Job( "4", "alias4", $pere, $fils, "0", "unknown", "0" );
  83. $pere = "1";
  84. $fils = "7";
  85. my $proc5 = new Job( "5", "alias5", $pere, $fils, "0", "unknown", "0" );
  87. $pere = "2";
  88. $fils = "8";
  89. my $proc6 = new Job( "6", "alias6", $pere, $fils, "0", "unknown", "0" );
  91. $pere = "4,5";
  92. $fils = "8";
  93. my $proc7 = new Job( "7", "alias7", $pere, $fils, "0", "unknown", "0" );
  95. $pere = "7,6,3";
  96. $fils = undef;
  97. my $proc8 = new Job( "8", "alias8", $pere, $fils,, "0", "unknown", "0" );
  99. $pere = "3";
  100. $fils = undef;
  101. my $proc9 = new Job( "9", "alias9", $pere, $fils, "0", "unknown", "0" );
  104. print "listJob : @listJob\n";
  105. print Data::Dumper::Dumper @tabProc;
  109. foreach my $row (@tabProc)
  110. {
  111.  if ($row->{PERE} eq undef)
  112.  {
  113.   $row->{PERE} = "NULL";
  114.  }else
  115.  {
  116.   $row->{PERE} =~ s/,/ /g;
  117.  }
  119.  if ($row->{FILS} eq undef)
  120.  {
  121.   $row->{FILS} = "NULL";
  122.  }
  123.  else
  124.  {
  125.   $row->{FILS} =~ s/,/ /g;
  126.  }
  128.  if ($row->{PERE} eq "NULL" )
  129.  {
  130.   $row->{TYPE} = "PERE-0";
  131.  }
  132.  else
  133.  {
  134.   if ($row->{FILS} eq "NULL" )
  135.   {
  136.    $row->{TYPE} = "FILS";
  137.   }
  138.   else
  139.   {
  140.    $row->{TYPE} = "PERE";
  141.   }
  143.   $row->{STARTED} = 0;
  144.  }
  145.  $LEVEL+=1;
  146. }
  148. print Data::Dumper::Dumper @tabProc;
  149. print "LEVEL : $LEVEL\n";
  153. my $RETOUR;
  154. my @tabProc_temp=();
  155. my @tabProcEnCours;
  156. my @tabProcFini;
  157. my $i=0;
  158. my %options = (
  159.     create    => 1,
  160.     exclusive => 0,
  161.     mode      => 0644,
  162.     destroy   => 0,
  163. );
  165. print "tabProcFini: @tabProcFini\n";
  166. print "tabProcEnCours: @tabProcEnCours\n";
  167. print "tabProc_temp: @tabProc_temp\n";
  169. tie @tabProc_temp, 'IPC::Shareable', 'tie1', \%options;
  170. tie @tabProcEnCours, 'IPC::Shareable', 'tie2', \%options;
  171. tie @tabProcFini, 'IPC::Shareable', 'tie3', \%options;
  172. @tabProcEnCours=();
  173. @tabProcFini=();
  174. @tabProc_temp=@tabProc;  #tabProc_temp contient la copie de la liste des processus existants.
  177. print "tabProc_temp: @tabProc_temp\n";
  179. my $pm = new Parallel::ForkManager(10);
  181. while( @tabProc_temp )  #Tant que le tableau des processus n'est pas vide
  182. {
  183. $i=0;
  185.  foreach my $row (@tabProc_temp)  #pour chaque processus
  186.  {
  188.   # print "tabProcEnCours: @tabProcEnCours\n";
  189.   # print "tabProcFini: @tabProcFini\n";
  190.   my $ID = $row->{ID_PROCESS};
  191.   my $LOCK = $row->{LOCK};
  192.   my $TYPE = $row->{TYPE};
  193.   my $PERE = $row->{PERE};
  195.   print "PROCESS $ID lets work on it! \n";
  196.   my %hashEncours = map{$_ => 1} (@tabProcEnCours);
  198.   # print "ID : $ID\n";
  199.   # print "tabProc_temp : \n";
  200.   # print Data::Dumper::Dumper @tabProc_temp;
  201.    print "tabProcFini : @tabProcFini\n";
  202.    print "tabProcEnCours : @tabProcEnCours\n\n";
  204.   if (exists $hashEncours{$ID})  #si le processus est en cour de traitemet
  205.   {
  206.    print "PROCESS $ID already forked! \n";
  207.    print "PROCESS ","$ID Let's try another process \n\n";
  208.   }else
  209.   {
  210.    if ($LOCK == "0" ) #si le processus est bloqué (dans ce test code, il ne l'est jamais)
  211.    {
  212.     $RETOUR = "Not OK";
  213.     if ($RETOUR eq "OK" ) #si le retout est OK (dans ce test code, il ne l'est jamais)
  214.     {
  215.      print "PROCESS","$ID is Running \n";
  216.      push(@tabProcFini,$ID);
  217.      print "\n";
  218.     }
  219.     else
  220.     {
  221.      print "PROCESS ","$ID is Stopped \n\n";
  223.      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)
  224.      {
  225.       $pm->start and next; # je lance un fork
  226.       my $ID_inFork = $ID;
  227.       (tied @tabProcEnCours)->shlock;
  228.       push(@tabProcEnCours,$ID_inFork);  #j'ajoute le processus dans le tableau des processus en cour de traitement
  229.       (tied @tabProcEnCours)->shunlock;
  231.       sleep 3;  # je fais un sleep pour simuler le temps de traitement du processus
  233.       (tied @tabProc_temp)->shlock;
  234.       @tabProc_temp = @tabProc_temp[0..($i-1),($i+1)..$#tabProc_temp]; #j'enleve le processus du talbeau contenant la liste des processus
  235.       (tied @tabProc_temp)->shunlock;
  237.       (tied @tabProcFini)->shlock;
  238.       push(@tabProcFini,$ID_inFork);  # j'ajoute le processus dans le tableau contenant les processus fini
  239.       (tied @tabProcFini)->shunlock;
  241.       (tied @tabProcEnCours)->shlock;
  242.       @tabProcEnCours = @tabProcEnCours[0..($i-1),($i+1)..$#tabProcEnCours]; #j'enleve le processus du talbeau contenant la liste des processus en cour
  243.       (tied @tabProcEnCours)->shunlock;
  245.       # print "tabProc_temp : \n";
  246.       # print Data::Dumper::Dumper @tabProc_temp;
  247.       # print "tabProcFini : @tabProcFini\n";
  248.       # print "tabProcEnCours : @tabProcEnCours\n\n";
  249.       print "PROCESS ","$ID_inFork well started outside \n\n";
  250.       $pm->finish;
  252.      }else
  253.      {
  255.       my @tab1 = split(/ /,$PERE);
  256.       my $tailletab1 = scalar @tab1;
  257.       my @tab2=@tabProcFini;
  258.       my %hash = map{$_ => 1} (@tab1, @tab2);
  259.       #print "hash : \n";
  260.       #print Data::Dumper::Dumper %hash;
  261.       my @tab = keys %hash;
  262.       my $nombre_elements_commun = @tab1 + @tab2 - @tab;
  263.       #print "tab1 : @tab1`\n";
  264.       #print "tab2 : @tab2`\n";
  265.       #print "tab : @tab`\n";
  266.       #print "tailletab1 : $tailletab1`\n";
  267.       #print "nombre_elements_commun : $nombre_elements_commun`\n";
  268.       if($nombre_elements_commun == $tailletab1)
  269.       {
  270.        $pm->start and next; # je lance un fork
  271.        my $ID_inFork = $ID;
  272.        my $PERE_inFork =$PERE;
  274.        (tied @tabProcEnCours)->shlock;
  275.        push(@tabProcEnCours,$ID_inFork); #j'ajoute le processus dans le tableau des processus en cour de traitement
  276.        (tied @tabProcEnCours)->shunlock;
  280.        print "PROCESS ","$ID_inFork Parents: $PERE_inFork \n";
  281.        print "PROCESS ","$ID_inFork Les elements de la liste \"PERE\" du process $ID_inFork sont tous présents dans le tableau \@tabProcFini \n\n";
  282.        sleep 3; # je fais un sleep pour simuler le temps de traitement du processus
  284.        (tied @tabProc_temp)->shlock;
  285.        @tabProc_temp = @tabProc_temp[0..($i-1),($i+1)..$#tabProc_temp]; #j'enleve le processus du talbeau contenant la liste des processus
  286.        (tied @tabProc_temp)->shunlock;
  288.        (tied @tabProcFini)->shlock;
  289.        push(@tabProcFini,$ID_inFork);  # j'ajoute le processus dans le tableau contenant les processus fini
  290.        (tied @tabProcFini)->shunlock;
  292.        (tied @tabProcEnCours)->shlock;
  293.        @tabProcEnCours = @tabProcEnCours[0..($i-1),($i+1)..$#tabProcEnCours]; #j'enleve le processus du talbeau contenant la liste des processus en cour
  294.        (tied @tabProcEnCours)->shunlock;
  296.        #print "INSIDE ID_inFork : $ID_inFork\n";
  297.        #print "tabProc_temp : \n";
  298.        #print Data::Dumper::Dumper @tabProc_temp;
  299.        #print "INSIDE tabProcFini : @tabProcFini\n";
  300.        #print "INSIDE tabProcEnCours : @tabProcEnCours\n\n";
  302.        print "PROCESS ","$ID_inFork well started inside\n\n";
  303.        $pm->finish;
  304.       }else
  305.       {
  306.        # print "PROCESS $ID PERE =  $PERE \n";
  307.        print "PROCESS ","$ID Les elements de la liste \"PERE\" du process $ID NE sont PAS tous présents dans le tableau \@tabProcFini \n";
  308.        print "PROCESS ","$ID Let's try another process \n\n";
  309.       }
  310.      }
  311.      $RETOUR = "OK";
  312.      if ($RETOUR ne "OK" )
  313.      {
  314.       print "PROCESS","$ID not started \n";
  315.       exit(1);
  316.      }
  317.     }
  318.    }
  319.    else
  320.    {
  321.     print "$ID Locked !!! \n";
  322.     push(@tabProcFini,$ID);
  323.     print "\n";
  324.    }
  326.   }
  327.   sleep 1;
  328.   $i++;
  329.   #print "tabProc_temp : @tabProc_temp\n";
  330.   # print "tabProc_temp : \n";
  331.   # print Data::Dumper::Dumper @tabProc_temp;
  332.   # print "tabProcFini : @tabProcFini\n";
  333.   # print "tabProcEnCours : @tabProcEnCours\n\n";
  334.  }
  335. }
  336. $pm->wait_all_children;
  337. print "tabProc_temp : \n";
  338. print Data::Dumper::Dumper @tabProc_temp;
  339. print "tabProcFini : @tabProcFini\n";
  340. print "tabProcEnCours : @tabProcEnCours\n\n";


Message édité par Super_carotte le 15-12-2011 à 17:49:12
mood
Publicité
Posté le 15-12-2011 à 17:27:32  profilanswer
 

n°2116916
Super_caro​tte
Posté le 16-12-2011 à 12:03:32  profilanswer
 

J'ai trouvé l'erreure.
Elle est due a mon $i qui ne fonctionne pas correctement.
 
En effet, en remplaçant:

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


 
Par:

Code :
  1. (tied @tabProcEnCours)->shlock;
  2. my %hashTabProcEnCours = map{$_ => 1} (@tabProcEnCours);
  3. delete $hashTabProcEnCours{$ID_inFork};
  4. @tabProcEnCours=keys(%hashTabProcEnCours);
  5. (tied @tabProcEnCours)->shunlock;


 
ça fonctionne  :D  
 


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

Aller à :
Ajouter une réponse
  FORUM HardWare.fr
  Programmation
  Perl

  [PERL] Erreure dans code. Algo?

 

Sujets relatifs
[algo] Toutes les combinaisons d'un tableau à 2 dimensions?Bluegriffon - probleme de code
[C#] erreur dans le codecode défaillant
Mise à jour automatique de code / script[Algo] + [Python] Analyse d'une formule
Code A Provenance de train + numeroPop-up facebook, un code quelque part ?
Code de presentation[jQuery] Code non exécuté
Plus de sujets relatifs à : [PERL] Erreure dans code. Algo?

Forum MesDiscussions.Net, Version 2010.2
(c) 2000-2011 Doctissimo
Page générée en 0.101 secondes

Copyright © 1997-2022 Hardware.fr SARL (Signaler un contenu illicite / Données personnelles) / Groupe LDLC / Shop HFR