###################
#
# Cette fonction me permet de decouper un fichier en:
#
# - le path
# - le nom du fichier
# - la langue
# - le suffixe
#
###################
sub decoupage_info
{
 local ($name_info) = @_;
 local ($sans_suf_info,$langue_info,$file_suf_info,$le_path_solo_info,$file_solo_info) = ('','','','');
 if($name_info =~ m#(.+?)(\.([^/.]+))?\.(html|\+|sgml|js2?)$#){$sans_suf_info = $1;$langue_info = $3;$file_suf_info = $4;}
 if(!$Les_Langues_H{lc($langue_info)})
  {
   $sans_suf_info .= $2;
   $langue_info = "MONO";
  }
 if($sans_suf_info =~ /(.*\/)(.*)$/)
  {$le_path_solo_info = $1; $file_solo_info = $2;}
  
 return ($le_path_solo_info,$file_solo_info,$langue_info,$file_suf_info);
  
}

###################
#
# Affiche la date
#
###################
sub duration
{
 local $Date =  `date '+%H:%M:%S'`;
 $Date =~ s/\n//g;
 print "($Date)";
}

###################
#
# Fonction d'affichage pour le debugage
#
###################
sub aff_debug
{
 local ($cont) = @_;
 &duration();
 print "$cont\n";
}

###################
#
# Fonction de debbugage pour les liens up, next et back
#
###################
sub debug_lien
{
 local (*s) = @_;
 foreach $key (keys (%s))
  {
   print "=> $key BACK=($s{$key}{'Back'}) UP=($s{$key}{'Up'}) NEXT=($s{$key}{'Next'})\n";
  }
}

###################
#
# On cree les repertoires Destination
#
# Simple fonction pour creer des repertoires
#
###################

sub creation_repertoires
{
 local ($inf) = @_;
 $inf =~ s|.*$Source/||;
 $inf =~ s|.*$Dest/||;
# print "$inf<-\n";
 local (@rep) = split(/\//,$inf);
 
 $Rep_info = $inf;
 $Rep_info =~ s/(.*\/).*/$1/;
 
 if(-e "$Dest/$Rep_info"){return}
 
 local ($i_sw) = 0;
 local ($sw) = 0;
 local ($test) = '';

 while($rep[$i_sw+1])
  {
   if($sw == 0)
    {
     $sw = 1
    }
   else
    {
     $test .= "/$rep[$i_sw++]"
     }
#   print "++$Dest$test\n";
   if(!-e "$Dest$test")
    {
#	 if(-d "$Source$test")
      {
	   print "Je cree $Dest$test\n" if ($debug);
	   mkdir("$Dest$test",0755);
	  }
    }
  }
}

###################
#
# Lecture des langues
#
# On cree simplement une hash table contenant les differents suffixes
# Des langues traites dans le repertoire courant
#
###################
sub make_langue
{
 local (%s) = @_;
 local (@Cont) = split(/<\/PM.LANG>/,$s{$Tag_Langages});
 local($i_Cont_l,$i_Cont) = (0,0);
 local(@Les_Langues_Suf) = [];
 local(%Les_Langues_H) = ();
 while($Cont[$i_Cont])
  {
   $Cont[$i_Cont] =~ /^.*\s*TYPE\s*=\s*(.*?)>(.*)$/is;
   if(!$Les_Langues_H{lc($1)})
    {
  	 $Les_Langues_Suf[$i_Cont_l++] = $1;
     $Les_Langues_V{lc($1)} = $2;
     $Les_Langues_H{lc($1)} = $i_Cont_l;
    }
#   print "Les langues sont : $1 - $2;\n";
   $i_Cont++; 
  }
 return([@Les_Langues_Suf],{%Les_Langues_H});
}

###################
#
# Relativise les liens
#
# L'option -a declanche l'appel de cette fonction,
# Qui n'a pour but que de relativiser les liens des pages
# Traitees. L'ensemble des TAGS geres se trouvant dans le tableau
# nomme @TAGS
#
###################
sub make_relatif
{
 local ($absolute_file,$path,$tag) = @_;

 local $nb2 = split (/\//,$Dest);
 local($relatif_file) = $absolute_file;

 $path =~ s/^$Dest\/(.*)\/.*/$1/;
 local $nb = split (/\//,$path);
 local ($l_point) = "";
 for(local($i) = $nb; $i > 0; $i--)
  {
   $l_point = "../$l_point";
  }
  
 while($relatif_file =~ /($tag\s*=\s*"\/(.*?)")/is)
  {
   local ($le_tout,$l_abs) = ($1,$2);
   local ($l_abs2) = "$l_point$l_abs";
   $absolute_file =~ s/\Q"\/$l_abs\E/"$l_abs2/is;
   $relatif_file =~ s/\Q$le_tout\E//is;
  }

 while($l_point ne "")
  {
   $absolute_file =~ s/"((\.\.\/)*)\Q$l_point$path\E\//"$1/g;
#   print "a remplacer $1 $l_point$path\n";
   $l_point =~ s/..\///;
   $path =~ s/\/[^\/]*$//;
  }

 return $absolute_file;
}

###################
#
# Cette fonction a pour but d'eliminer les ../ en trop
#
###################
sub elimine_points
{
 local ($path) = @_;
 $path =~ s/\/\//\//g;
# print "avant : $path\n";
 while($path =~ /^(.*\/)?([^\.\/].*\/\.\.\/)(.*)$/)
  {
   $path = "$1$3";
  }
# print "apres : $path\n";
 return $path;
}


###################
#
# Retrouve le repertoire minimal en commun 
# Dans une serie des fichiers
#
###################
sub rep_min
{
 local ($Rep_min,$file,$mode) = @_;
 $file = replace($file,2) if (!$mode);
 if(!($file =~ /.*\/.*/) && !$mode){return ''}
 if($Rep_min eq '' && !$mode)
  {$Rep_min = $file;
   $Rep_min =~ s/(.*\/).+/$1/;
   return $Rep_min;
  }
 if($Rep_min eq '' && $mode == 1){return '';}
 if($file =~ /$Rep_min.*/i)
  {return $Rep_min}
 if($Rep_min =~ /(.*)\/.+/){$Rep_min = $1}
 elsif($Rep_min =~ /(.*)\/$/){$Rep_min = $1}
 elsif($Rep_min =~ /(.*)$/){return ''}
# $Rep_min =~ s/(.*\/).+/$1/;
 
 return rep_min($Rep_min,$file,1);
}

###################
#
# Elimine le repertoire source 
# Pour un fichier donne
#
###################
sub replace
{ local ($File_name,$Externe) = @_;
#  print "$File_name <=> $Externe\n";
  if($Externe > 0)
   {
    if(!($File_name =~ /.*$Source(.*)/i))
     {
	  if($Externe == 1)
       {
	    print "Le fichier $File_name ne peut pas etre habille\n";
	    return '';
	   }
	  else
	   {
	    return $File_name;
	   }
     }
    else
     {
      $File_name = $1;
      $File_name =~ s/^\///;
     }
   }
 return $File_name; 
}

###################
#
# Effectue l'affichage
# En verifiant le mode
# (Web ou pas)
#
###################
sub affiche
{
 local ($text) = @_;
 print "$text";
 if($internet)
  {
   print "<BR>";
   flush(STDOUT);
  }
}


sub remplace_nom_parallele
{
 local ($dest,$Parallele) = @_;
 if($dest =~ /(.+)\.(.+?)\.(html?|sgml)/)
  {
   local ($ok,$i_mono,$my_langue) = (0,0,$2);
   while($Les_Langues_Suf[$i_mono])
    {
     if($my_langue eq $Les_Langues_Suf[$i_mono])
	  {
	   $ok = 1;
	  }
	 $i_mono++;
	}
   if($ok eq "1")
    {
     $dest =~ s/(.+)\.(.+?)\.(html|sgml)/$1.$Parallele.$2.$3/;
    }
   else
    {
     $dest =~ s/(.+)\.(.+?)\.(html|sgml)/$1.$2.$Parallele.$3/;
    }
  }
 else
  {
   $dest =~ s/(.*).(html|sgml|\+)/$1.$Parallele.$2/;
  }

 return $dest;
}

sub error
{
 local ($mess) = @_;
 print "$mess\n";
}

sub point
{
 print ".\n" if ($debug);
}
return 1;
