Vlink

Script Perl qui répare les liens locaux avant de publier.
usage: vv2l.pl [-cguls] [rep_a_traiter]
dernière moture _ Aout 2010
#!/usr/bin/perl

  # remd: vv2l comme Vaillant Verificateur De Liens - by asynchrone 
  *

  # remd:  Répare les liens locaux de votre espace de
  publication    *

  # (rep de pages perso, site) en les testant pour chaque
  fichier.   *

  # Il répare les erreurs d’affectation, de path (absolu ou
  relatif) *

  # UNIX/M$/LX, les fautes d’extensions, doublons, orthographe, etc. *

  # Vérif des encres et ré-attribution du 1er flag ou
  création (-c)  *

  # d'une encre #_top (si page existe sans flag). Corrige les fautes *

  # d'orthographes et les path
  erronés.                             
  *

  # Vers:4.3 => 6.6 | 08.2010  alain Adelmar Pessac
  aadelmar@free.fr *

  #     
  -------------------------------------------------------    
  *

  # (v: Version Vérif De Luxe (Unix-Like - Windows)  Alain
  Adelmar ) *

  # remd: autonome n'utilise que les modules standards  (facultatif)
  *

  #------------------------------------------------------------------*

  # usage:  vv2l.pl [-cu] [rep_source]
  [sous-rep(image)]            
  *

  #-----------------------------------                              
  *

  #
  options:                                                        
  *

  # -c (complet) effectuera des tests, logs et
  pré-réparation style  *

  #             
  marquer d'un tag "top" les pages html pas marquées  *

  # -g (gros site) pour les site dépassant les 50 pages ou 1000
  liens*

  #            
  cette option adapte la sortie formaté pour le choix  *

  # -u (update) insère la date de mise à jour, en gardant
  l'original *

  #            
  en commentaire, répare les
  liens.                   
  *

  # -l (light) essai de réparer par lui même et tri avant de
  proposer*

  #            a
  l'utilisateur. (peu simplifier le
  travail)          *

  # -s (silencieux) répare les liens sans intervention de user,
  fait *

  #            
  un rapport pour ce qu'il n'a pas
  réparrer.          
  *

  #------------------------------------------------------------------*

  # (script Perl pour environnement M$ et
  UNIX-LIKE)                
  *

  # créé par alain Adelmar (2008.11)   à
  Pessac 6 rue de Tunis 33600 *

  #*******************************************************************

  # $ID$: 

  # - Excellent conçu pour les gros site (>1000
  pages)              
  *

  # la meilleur version car elle fonctionne- enormisime - Alain A

  # version utf8- encore beaucoup de controle. Il fonctionne

  #  AAAA-pour Alain Adelmar Alias Asynchrone - AhAhAhAh!

  

  my $script = "vv2l.pl";

  my $vers = "6.6";

  #$Author: alain $:"Adelmar Alain";

  my $moi = 'Adelmar Alain <aadelmar@numericable.fr';

  

  #use strict;

  use File::Copy;

  #use warnings;

  

  use Cwd;

  my $dir = cwd;

  print "dir vaut :$dir\n";

  

  use locale;

  

  (my $sec,my $min,my $heure,my $mjour,my $mois,my $annee,my $sjour,my
  $ajour,my $isdst) =  localtime(time);

  my @lssjour = qw( Dim Lun Mar Mer Jeu Ven Sam);

  my @lssmois = qw ( Janvier Fevrier Mars Avril Mai Juin Juillet Aout
  Septembre Octobre Novembre Decembre );

  

  my $french_date_now = "$lssjour[$sjour] $mjour $lssmois[$mois] " .
  ($annee+=1900) . " - $heure:$min:$sec";

  my $fr_date_now = $french_date_now;

  my $datenum = 0;

  my $fr_dt_file = my $fr_date_file = "";

  my @tmpstat = "";

  my $mode = 8;

  my $format_d = 0;

  

  print "date/heure: $fr_date_now\n";

  

  my $lx = "*-" x 25;

  my $file = $0;

  print "file vaut $file\n";

  $fr_date_file = datefinefile($file, $mode, $format_d);

  $file = "";

  

  my $head_lbl= "script $0\nécris par $moi\nle
  $fr_dt_file\nexecuter le $french_date_now\n";

  my $head_lbl_console = "$lx\nscript:     
  $0\nle $fr_dt_file\nécris par:  $moi\nexecuter le:
  $french_date_now\n$lx\n";my $fr_num_file = my $nwligne = "";

  my $gnus = 0;

  

  my %pf = my %h_tencre = my %h_tag = my %h_rootf = my %h_lnkhttp = my
  %h_lnkftp = my %h_fst = "";

  my $f = my $fout = my $resp = my $rootfile = my $e = my $tout = my
  $contenu = my $l = "";

  my $d = my $srep = my $flg = my $rootfile_file = my $newsite = my
  $path_tmp = "";

  my @contenu  = my @pathf = my @ligne = my @nwcopim = my @nwcontenu
  = my @val = ();

  my $value = my $key = my $ext = my $hdl_file = my $troncfile = my $line
  = my $email = "";

  my $recap_lbl= "$0 écris par $moi \nle $fr_date_file\nexecuter
  $fr_date_now\n";

  my @cop = my @nwcop = ();

  my @ls_other_file = my @ls_file_meta = my @files = my @ls_tencre = (); 

  my $kf = my $err = my $ef = my $j = my $ere = my $ht = my $q = my $body
  = 0;

  my $u = my $i = my $ouvert = my $tronquage = my $index = my $tz = my $k
  = my $v = 0;

  my $b = my $hf = my $pa = my $repu = "";

  my $slx = "\n\n\n\n\n\n\n\n\n\n$lx";   # pour eviter le clear
  ou autre system nettoyage ecran 

  my $argv = "noting";

  my @vh = values(%pf);

  

  # pour l'adressage/les systeme UNIX, Linux, cygwin ou autre (/) et ceux
  de M$ (\)

  my @gnul = ( "\\", "\/");   #pas mal because $slash sera
  toujours bon, je suis trop fort

  my $cong= "this is a real gnu OS, congratulation\n";

  if ($dir =~ /^\//) {

    $gnus++;

    }

  my $slash = $gnul[$gnus];

  

  

  # -----------traitement argument - dossier a traiter et verification $d
  valide------ debut

  

  if (@ARGV) {

    if ($ARGV[0] =~ /^-/) {

      $ARGV[0] =~ s/-()/($1)/;

      ($argv = "c") if ($ARGV[0]=~ /^c/);   #
  pour complet

      ($argv = "g") if ($ARGV[0]=~ /^g/);   #
  pour gros site ou paquets de feuilles

      ($argv = "u") if ($ARGV[0]=~ /^u/);   #
  pour update

      ($argv = "l") if ($ARGV[0]=~ /^l/);   #
  pour light

      ($argv = "o") if ($ARGV[0]=~ /^o/);   #
  pour ortographe

      if ($ARGV[1] ne "") {

        $d = $ARGV[1];

        $srep = $ARGV[2];

        &verifd;

        }

      }

    else {

      $d = $ARGV[0];

      $srep = $ARGV[1];

      &verifd;

    }

  }

  else {

    print "usage: $script [-cou] [dossier_a_traiter]
  [sous-dossier_image]\n(made by $moi\n";

    #---------demander quel repertoire traiter et verifier si il
  existe

    print "$lx$lx\n";

    print "Indiquez le dossier a traiter:\n";

    chomp($d =<STDIN>);

    &verifd;

  }

  

  #-----------------------------------------------------------------------------
  fin

  

  #--------------- initialisation des variables -------------------------
  debut

  my @copim = my @lines = my @nwlines = ();

  my @nieme = ("zorro", "premier", "deuxieme", "troisieme", "quatrieme");

  my $userx = "";

  

  my $e_mailp = 'aadelmar@numericable.fr';

  my $etlencre = my $fp = my $ff = my $fe = 0;

  my $fileo = my $fileso = "";

  my $encre = my $lnknet = my $lnkbrut = my $lnkbrt = my $lnkt = "";

  my $cnta = my $cntlnkhttp = my $cnttl = my $encre_vue = my $cntlnkftp =
  0;

  my $z = my $eb = my $fr = my $ea = 0;

  my $firstline = "Editer par le script $script vers:$vers ce jour
  $fr_date_now :\n";

  my $psr = "Veuillez ré-entrer le nom simple du sous
  répertoire: expl: image\nil aura comme path $d\/image ou passer
  en tapant Enter\n";

  my $psr1 = "avez vous un sous-repertoire (pour les photos, icones,
  etc)\nsi oui lequel: (expl: images)\n";

  my $x_down = " " x 47;

  # $x_down = ("*-" x 24) .
  "||";                     
  # fioritures qui soulignes

  my $y = "__-__*" x
  15;                              
  # idem pour différencier

  my $al = "\t|     === A_l_a_i_n -\/\/-
  A_d_e_l_m_a_r ===      ||";   
  # pub perso

  #--- explication pour l'utilisateur

  my $lblo = "\n\tCe script $script va controler et réparer les
  liens locaux de chaque page HTML\n\tSans pour cela toucher à
  votre dossier de page-perso\n\til placera l integralite de son travail
  dans le repertoire courant\n\tdans un dossier nommer:\.\/newsite\n";

  

  #----------------- sortie formatée pour l'affichage
  fichiers/tags --------- ok

  

  format STDOUT_TOP =

  Page @<<

  $%

  

   n       
  lien                   
              
  n             
  lien

  ===
  ===============================            
  === ==============================

  .

  

  

  $rootfile_file = "vrl";

  $hdl_file = "VRL";

  my $o_ext = "log";

  &ouvre_file($rootfile_file, $hdl_file, $o_ext);

  

  #création et ouverture d'un rep temporaire pour placer le
  nouveau site -------------- debut

  $newsite = "$dir$slash" . "newsite";

  print "le newsite sera adresser comme : $newsite\n";

  &faitmoitmp;   #johnny, johnny

  # $path_tmp = "$tmp" . "$slash";  # cette ligne existe deja dans
  &faitmoitmp

  print "$lx$lx\n";

  #vrl est ouvert pour un log de constat d'encre possible en local

  &traite_d;

  &recup_all_tags;

  

  #-------------------------------(1 à partir de là on
  à tous les liens possible

  # stocké dans les hashages %h_tencre, %h_fst, %h_tag et %h_rootf

  &onyva;

  

  sub onyva {

    # passe en revue page/page, ligne/ligne, $lien/lien les copie
  crées dans $path_tmp

    opendir RC, "$path_tmp" or die "Ouverture de $path_tmp
  impossible $!";

    @files = (sort readdir RC);

    foreach $file(@files) {

      next if ($file =~ /\.log$/g);

      $fr_date_file = datefinefile($file, $mode,
  $format_d);

      

      #($troncfile, $ext)=split(/\./, $file);

      #$rootfile_file = "rap_$troncfile";

      #$hdl_file = "RAP";

      #my $o_ext = "log";

      #&ouvre_file($rootfile_file, hdl_file, $o_ext);

      print "$firstline$lx\n";

      #----------------------------------------------a
  là

    

      if ($file =~ /\.{1}s?h?x?t?m{1}l?$/i) {

        $kf++;

        print "$lx\nCe fichier est le $kf eme
  que vous traité\n";

        # faire ici le passage en pause

  

        ($troncfile, $ext)=split(/\./, $file);

        $rootfile_file = "rap_$troncfile";

        $hdl_file = "RAP";

        my $o_ext = "log";

        &ouvre_file($rootfile_file,
  $hdl_file, $o_ext);

        # attention de pas confondre rootfile
  ext et encre avec celle des liens

        $rootfile = $ext = $encre = "";

        $countpfl = $countpl = 0;

        print "$lx\n";

        &controle_file($file);

        &reparation($file);

        &compte_rendu;

        #close FSR || die "Fermeture de fsr
  impossible $!";

        push @rep, $file;

        }

      }

  

    close RAP || die "far toi encouler granda connassa rap $!";

    closedir RC || die "Fermeture de $path_tmp impossible (putain de
  merde) $!"; 

   
  #-------------------------------------------------------------------fin

    }

  

  sub controle_file {

    my ($file) = @_;

  

    #initialisation des variables

    my @contenu= "";

    $filesrc = "$path_tmp" . "$file";

    $fr_date_file = &datefinefile($file, $mode, $format_d);

    print RAP "\t$lx\n$file du $fr_date_file\n";

    #----------------------------------

    open FI, "$filesrc" or die "Ouverture du fichier $file
  impossible $!";

    @contenu = <FI>;

    close FI || die "Fermeture impossible $!";

    $countpl = 0;

    #--------------------------- voila regler ca et fermer les
  fichier ouverts

    

    foreach $line(@contenu) {

      $countpl++;     #compteur de
  ligne par file

      $fl = "file: $file \|ligne:$countpl ";  
  #ok preindication file origine ligne (pour RAP_a)

      $flplus = "$fl :lnknet:$lnknet encre:$encre
  rootfile:$rootfile ext:$ext\n";  # ceci n'est pas
  initialisé a deplacer

      $countpfl = 0;      # ok
  initialise compteur par lien de la ligne

      @ls_m = ($line =~ /href=\"(.*?)\"\>/ig);

      foreach (@ls_m) {

        $j++;   # que fait ce $j?

        $corrompu = $etlencre = 0;

        $encre = "";

        $lnkbrut = $_;

        # ok compteur par liens dans la ligne (3
  max)

        $countpfl++;

        # a degager quand tout tourne ca c'est
  du bla bla

        $oldlb = $lnkbrut;

        $q++;     #numero
  unique du lien 

        print RAP "$lx\n$fl lien brut: $lnkbrut
  c\'est le $nieme[$countpfl]\n";

        $err = "err $fl lkb:$lnkbrut l: $countpl
  n: $countpfl\n";

        print "$lnkbrut\t$countpl\n";

        if ($lnkbrut=~ /^mailto/) {

          ($kk, $email) = split(/:/,
  $lnkbrut);

          ($login, $fai) = split(/\@/,
  $email);

          $cnta++;

          $eb++;

          $v++;

          print RAP "login = $login et
  fai = $fai\n";

         
  #------------------------modification perso

          if ($email =~
  /^a.?adelmar\@numericable\.fr/) {

            $e_mailp =
  "aadelmar\@free\.fr";

            print RAP
  "erreur adresse corrigé $email deviens $e_mailp\n";

            $ea++;

            $line =~ 
  s/()\Q$email\E()/$1$e_mailp$2/;

            $v++;

            # a saquer
  because c'est line qu'il faut modifier

            $nwline = $line;

            print "line:
  $nwline\n";

            #$nwmot = 
  s/()$email()/($1)$e_mailp($2)/;

            print "modif
  d'adresse mail effectué sur $file fraction de ligne $mot
  $countpl\n";

            }

          push @adressemail,
  "$login\@$fai";

          &chklnk;

          $v++;

          }

        #--------lien vers news-groupes
  trouvé

        elsif ($lnkbrut=~ /^news/) {

          ($kk, $nws) =split(/:/,
  $lnkbrut);

          print RAP "news-groupes
  trouvé $nws\n";

          $eb++;  #pas sur

          &chklnk;

          $v++;

          }

        #--------------------http

        elsif ($lnkbrut=~ /^http:\/\//i) {

          $encre ="";

          ($lnkhttp, $encre) =
  split(/\#/, $lnkbrut);

          $cntlnkhttp++;

          $prlnkhttp = "$file
  ligne:$countpl\t$lnkhttp\t$encre";

          push @lnk_http, $prlnkhttp;

          # ou en hashage

          $h_lnkhttp{"$lnkhttp" .
  "_$cntlnkhttp"} = $encre;

          $eb++;  #pas sur

          $encre= "";

          &chklnk;

          $v++;

        }

        #------------------ftp

        elsif ($lnkbrut=~ /^ftp:\/\//i) {

          $encre= "";

          ($lnkftp, $encre) =
  split(/\#/, $lnkbrut);

          $cntlnkftp++;

          $prlnkftp = "$file
  ligne:$countpl\t$lnkftp\t$encre"; 

          push @lnk_ftp,
  $prlnkftp;    

          #-------------- ou en hashage

          $h_lnkftp{"$lnkftp" .
  "_$cntlnkftp"} = $encre;

          $eb++;  #pas sur

          $encre= "";

          &chklnk;

          $v++;

          }

        #-------------------local (ce qui nous
  interresse)

       
  #-----------------------------------------------------------------ici

        else {

        SCONTROL:if (exists ${{reverse
  %h_tencre}} {$lnkbrut}) {

        # *CB1 tout bon

        print RAP " *CB1 good tb $lnkbrut n\:$q
  nc\:$v\n";

            $v++;

            $eb++;

      }

      # *CB2 

          elsif (exists ${{reverse
  %h_fst}} {$lnkbrut}) {

            print RAP " *CB2
  good vfile $lnkbrut n\:$q nc\:$v\n";

            $v++;

            $eb++;

      }

          # *CB3(2/2) peut etre le
  lien ne pointe que sur encre

          elsif (exists ${{reverse
  %h_tag}} {$lnkbrut}) {

        # *CB3(1) si le nom de la page + le lien
  colle-------------------------pass 3 ok--v

            if(exists
  ${{reverse %h_tencre}} {"$file" . "$lnkbrut"}) {

             
  print RAP " *CB3(1) good sf $lnkbrut nlien\:$q nc\:$v\n";

              $v++;

             
  $eb++;

        }

       
  #------------------------------------------------------------------------------°

        # sinon 

            else {

          # *CB3(2)

          print "ceci est fortement
  improbable mais votre lien $lnkbrut doit etre reparrer\nufull:\n";

          print RAP " *CB3(2) good sf
  $lnkbrut nlien\:$q nc\:$v\n";

          &utilisateur_full;

        }

      }

      # *CB4 --apres la moulinette a bon liens on entre
  dans le vif------

      elsif ($lnkbrut =~ /[\/]|[\\]/) {

        # if ($lnknet =~ /[\/]|[\\]/) {

        $ef++;

        $v++;

        print RAP " *CB4a part a dp $lnkbrut
  nlien\:$q nc\:$v\n";

        &degage_path;

      }

      else {

        # assignation des valeurs lnknet et encre et
  stockage des parametres existants

        $ere++;

        &decortique_file;

        $fl = "file: $file \|ligne:$countpl ";

        $flplus = "$fl :lnknet:$lnknet encre:$encre
  rootfile: $rootfile ext:$ext\n";

        print RAP " *CB4 $flplus\n";

        #
  *CB4b(2/2)------------------------------------------------------------|
  pass 2 ok --v

        if ($lnkbrut=~ /^\#/) {

          $lnkbrut = "$file" . "$lnkbrut";

          print RAP "*CB4b $lnkbrut
  nlien\:$q nc\:$v\n";

         
  #---------------------------------------------------------------------------°

          # *CB4b1

          if (exists ${{reverse %h_tencre}}
  {$lnkbrut}) {

            print RAP "$flplus
  fff encre seule a reparrer $lnknet deviens $lnkbrut\n";

            &utilisateur_full;

            $v++;

            print RAP "*CB4b1
  $lnkbrut nlien\:$q nc\:$v\n";

            goto SCONTROL;

          }

          else {

           
  #---------------------------------------------------------------------|pass
  2 ok --v

            # *CB4b2

            print RAP "*CB4b2
  $flplus commence par dieze mais encre pas bonne $lnkbrut\n";

            $etlencre= 1;

            $lnknet = $file;

            ($rootfile,
  $ext)=split(/\./, $lnknet);

            &utilisateur_fe;

            $v++;

            goto SCONTROL;

          }

         
  #--------------------------------------------------------------------------------------°

        }

        # *CB4c ici on ce rend compte que file est
  bon mais y a autre chose qui pourri le lien

        elsif (exists ${{reverse %h_fst}} {$lnknet}) {

          my $q = 0;

          @val= ();

          @tr_encre_pf= ();

          @val = (values (%h_tencre));

          foreach (@val) {

            ($lknet_tmp,
  $encre_tmp)= split(/\#/, $_);

            if ("$lnknet" eq
  "$lknet_tmp") {

             
          if($encre_tmp eq "") {

               
          $rl = "$lknet_tmp";

               
          }

             
          else {

               
          $rl = "$lknet_tmp" . "\#" .
  "$encre_tmp";

               
          }

             
          push @tr_encre_pf, $rl;

             
          $q++

            }

          }

          print "$lx\n$flplus Pas bon\t
  $lnknet\t $encre :\n *CB4c \n";

          $y = 0;

          $a = $b = "";

          $na = $nb = 0;

          @tr_encre_pf = sort @tr_encre_pf;

          for (0 .. (@tr_encre_pf/2)) {

            for $i(0..1) {

          $u = $y + $i;

          #$pf{$i} = "$tr_file[$u]";

          $pf{$i} = $tr_encre_pf[$u];

            }

            $a = $pf{0};

            $na = $u - 1;

            $b = $pf{1};

            $nb = $u;

            write;

            #print "\t$_\t$y\n";

            $y += 2;

          }

          print "[enter] suprimera l encre
  mais pas le liens\n";

          chomp($encru = <STDIN>);

          # *CB4c1 passe

          if ($encru eq "") {

            print "rien ne sera
  fait\n";

            $lnkbrut = "$lnknet";

            print RAP " *CB4c1
  $lnkbrut nlien\:$q nc\:$v\n";

            $v++;

          }

          # *CB4c2 chiffre entrer
  -------------------------------------------- |pass 1 ok-----v

          elsif($encru =~/^\d/) {

            print RAP "votre
  choix num qui vaut $tr_encre_pf[$encru]\n";

            print "votre choix
  num qui vaut $tr_encre_pf[$encru]\n";

            $lnkbrut =
  $tr_encre_pf[$encru];

            print RAP " *CB4c2
  $lnkbrut nlien\:$q nc\:$v\n";

            $v++;

            &chklnk;

            goto SCONTROL;

          }

         
  #-----------------------------------------------------------------------------------°

          # *CB4c3 encre entrer a la main

          elsif($encru=~ /^\w/) {

            print RAP "vous avez
  entrer la chaine $encru\n";

            print "vous avez
  entrer la chaine $encru\n";

            $lnkbrut = "$encru";

            print RAP " *CB4c3
  $lnkbrut nlien\:$q nc\:$v\n";

            &chklnk;

            $v++;

            goto SCONTROL;

          }

          print "ici la fin du buzz
  encre\n";

        }

        # *CB4d ici on se rend compte que c'est
  l'extention qui daille

        elsif (exists ${{reverse %h_tencre}}
  {"$rootfile\.html\#$encre"}) {

          print RAP "ok c'etait l'extention
  qui daillait, donc ext=html\n";

          print RAP "gagne lien vers encre
  du meme fichier $lnkbrut nlien\:$q nc\:$v\n";

          $lnkbrut =
  "$rootfile\.html\#$encre";

          print RAP " *CB4d $lnkbrut
  nlien\:$q nc\:$v\n";

          &chklnk;

          $v++;

        }

        # *CB4e ici on se rend compte que c'est
  l'extention qui daille

        elsif (exists ${{reverse %h_fst}}
  {"$rootfile\.html"}) {

          print RAP "*CB4e $fl : ici c'est
  rootfile qui est ok\n";

          #
  *CB4e1-----------------------------------------------------| pass 5 ok
  ---v

          if($encre == 0) {

            $lnkbrut =
  "$rootfile\.html";

            print RAP " *CB4e1
  $lnkbrut nlien\:$q nc\:$v\n";

            print RAP "gagne lien
  vers $lnkbrut nlien\:$q nc\:$v\n";

            &chklnk;

            $v++;

          }

         
  #---------------------------------------------------------------------------°

          # *CB4e2

          else {

            # si cette
  construction est infructueuse faire lnknet=rootfile.html =>ufe

            $lnkbrut =
  "$rootfile\.html\#$encre";

            print RAP " *CB4e2
  $lnkbrut nlien\:$q nc\:$v\n";

            print RAP "aurai du
  etre traiter en CB4d look that $lnkbrut gagné $v\n";

            &chklnk;

            $v++;

            goto SCONTROLE;

          }

        }

        # *CB4f ici il n'y a que rootfile qui matche

        elsif (exists ${{reverse %h_rootf}}
  {$rootfile}) {

          print "quel lien match,
  choisissez:\n";

          $i = 0;

          while ( ($key, $value) = each
  %h_rootf) {

            if($value eq
  $rootfile) {

          $ch_ext = $key;

          ($kk, $ext_tmp)= split(/:/,
  $ch_ext);

          push @ls_ext, $ext_tmp;

          print "pour $rootfile\.$ext_tmp
  taper $i\n";

            }

            $i++;

          }

          $resp= <STDIN>;

          chomp $resp;

          $lnkbrut = "$rootfile\." .
  $ls_ext[$resp]; 

          print "vous avez valider
  $lnkbrut\n";

          print RAP " *CB4f $lnkbrut
  nlien\:$q nc\:$v\n";

          &chklnk;

          $v++;

          goto SCONTROL;

        }

        # *CB4g

        else {

          # si il y a une encre
  (reparrer)et aussi un faux nom de fichier creer un if

          # $p++;

          #
  *CB4g1----------------------------------------------------------------------Pass
  4 ok --v

          if ($encre eq "") {

            # Dernier else | sans
  encre ce liens part a uf: code erreur "desauf"

            print "$lx
  desauf\n$flplus\n";

            print RAP " *CB4g1
  (mais pas sorti) $lx desauf\n$flplus\n";

            &utilisateur_f;

          }

         
  #--------------------------------------------------------------------------------°

          # *CB4g2
  --------------------------------------------------------------------Pass
  6 ok--v

          else {

            # choisir un fichier
  puis une encre

            # Dernier else num:
  $p| avec encre ce liens part a ufull: code erreur deaafull

            print "$lx
  deaafull\n$flplus\n";

            print RAP "*CB4g2 $lx
  deaafull\n$flplus\n";

            &utilisateur_full;

           
  #-----------------------------------------------------------------------------------°

          }

        }

      }

        }

      }

      # $j = 1; # $j est le compteur de liens total

      push @nwcontenu, $line;

    }

  }    

  

  

  

  #-----------------------------Recup_all_tags----------------------------
  debut

  sub recup_all_tags {

    # --le handle est pour RAP

  

    foreach $likef(@nwlsfile) {

      $cf++;     #compteur de fichiers

      next if ($likef=~ /^\./);

      $file = $likef;

      $encre_vue = 0;

      # re-ajouter le path au nom de fichier

      $ftagsrc = "$path_tmp$slash$file";

      # vérif mode (html, tml, htm, xml, etc..)

      if ($file =~ /\.{1}s?h?x?t?m{1}l?$/i) {

        $fr_date_file = datefinefile($file,
  $mode, $format_d);

        (push @ls_h_fst, $file) unless (
  scalar(grep(/$file/, @ls_h_fst)) );

        (push @ls_tencre, $file) unless (
  scalar(grep(/$file/, @ls_tencre)) );

        @lines = @nwlines = "";

        open FT, "$ftagsrc" or die "Ouverture du
  fichier $file impossible $!";

        binmode(FT);

        $lpp = 0;

        @lines = <FT>;

        close FT || die "Fermeture impossible
  $!";

        # reconstruit les balises
  tronquées et sort sur @nwlines

        @nwlines =
  &reconstruire_ligne(@lines);

        

        foreach $line(@nwlines) {

             
      print "line\n";

          if ($line =~
  /<body\>/i) {

            $body = $lpp;

        # discutable si &cherche_encre pas $tz++
  et vice versa

           
  &cherche_encre($line);

        $tz++;

            push @copim,
  $line;

        $lpp++;

      }

          else {

        print "je vais passer a cherche_encre\n";

           
  &cherche_encre($line);

            push @copim,
  $line;

        $lpp++;

      }

        }

        # tout ce qui suit est faut jusqu'a
  &faitdcopies, mais pas grave car ne peut etre utiliser - a saquer

        if ($encre_vue == 0) {

          if ($argv eq "c") {

            #
  $copim[$body].= "<a name=\"_top\"\>\n"; # je ne comprend pas
  cette ligne surement une erreur

        $copim[$body] = "<a name=\"_top\"\>\n";

            print VRL "pour
  voir body trouvé\n$copim[$body]\n";

            }

          else {

            # ce else est
  à degagez quand testé

            print VRL "pour
  voir body trouvé\n$copim[$body]\n";

      }

        }

        if ($argv eq "u") {

          $copim[$body] .= "\n<--
  mise à jour du document par $script le $fr_date_now
  \ninitialement daté du " . $fr_date_file . "\n";

          print VRL "pour voir body
  trouvé\n$copim[$body]\n";

        }

        &faitdcopies;

        @copim = "";

        @nwlines = "";

        # detail des encres trouvées par
  fichiers

        print VRL "\npour $file $encre_vue encre
  trouvé\/s\nDétail:\n";

        #while ($une_encre =
  shift(@ls_encre_pf)) {

        #  print VRL ("\t$une_encre\n");

        #}

      }

      else {

        # on ne sait jamais peut etre un lien
  fait reference à un script donc

        # attention 

        (push @ls_h_fst, $file) unless (
  scalar(grep(/$file/, @ls_h_fst)) );

        (push @ls_tencre, $file) unless (
  scalar(grep(/$file/, @ls_tencre)) );

      }

    }

    

  

    #---passage de la liste contenant tous les liens @ls_tencre au
  tableau de hashage %h_tencre

    # ote les doublons

    my $i = 0;

    foreach $el (@ls_tencre) {

      $tmp{$el} = $i++;

      }

    @ls_tencre = keys %tmp;

    @ls_tencre = sort(@ls_tencre);

    foreach (@ls_tencre) { 

      $h_tencre{$i_h_tencre} = $_;

      $i_h_tencre++;

      }

    #--- idem pour les encres seules

    @ls_encre_pf = sort(@ls_encre_pf);

    foreach (@ls_encre_pf) { 

      $h_tag{$i_h_tag} = $_;

      $i_h_tag++;

      }

    #--- idem pour les fichiers seul

    @ls_h_fst = sort(@ls_h_fst);

    foreach (@ls_h_fst) { 

      $h_fst{$i_h_fst} = $_;

      $i_h_fst++;

      }

    #----------a degager quand pris en compte---voici les trois
  hachage

    print VRL "\n$lx\nvoici les trois hachage:\n$lx\nh_tencre\n";

  

    foreach $key (sort keys %h_tencre) {

      $val = $h_tencre{$key};

      print VRL "\t$val\n";

    }

    print VRL "\n$lx\nh_fst\n";

    my $i= 0;

    while (($zo, $ht) = each %h_fst) {

      ($rootf, $ext)= split(/\./, $ht);

      $h_rootf{"$i:$ext"}= $rootf;

      print VRL "\t$zo:$ht\n";

    }

    print VRL "\n$lx\nh_tag\n";

    while (($zo, $htag) = each %h_tag) {

      print VRL "\t$zo:$htag\n";

    }

  

    print VRL "\n$lx\n$moi vous remercie d\'utiliser $script
  vers:$vers \n- $fr_date_now\n";

    #-----------------------------------

    close VRL || die "double dremmer closure of $flg not
  possibilé $!";

  }

  

  #---------------------------------------------------------------------------------
  fin

  

  sub cherche_encre {

    my ($line)= @_;

  

    if ($line=~ /<a\sname=\"(.*?)\"/i) {

      $tag = $1;

      $encre_vue++;

      $fz = "$file#$tag";

      push @ls_tencre, $fz;

      push @ls_encre_pf, "#$tag";

      $tz++;

      print "encre tttrouvée ||| $tag|\n";

      }

    # si aucune encre trouvé peut etre interessant...

  }

  

  #---------------------------------------------------------- debut

  sub reparation {

    my ($file)= @_;

  

    $fcible = "$path_newsite" . "$file";

    open FR, ">$fcible" or die "Ouverture de $fcible impossible
  $!";

    print FR @nwcontenu;

    #réinitialisation des listes par fichiers

    @nwcontenu = "";  # ou @nwcontenu = @nwl = "";

    close FR || die "Fermeture de $fcible impossible $!";

  }

  

  sub utilisateur_f {

  

    $userx = "f";

    @val =();

    $a = $b = "";

    # @valalpha = "";  #en prevision du tri des concordances
  (voir 5 lignes plus bas)

    print RAP "uf:Ce liens n a pas de corresp $lnkbrut il par a
  user\n";

   # print "Choisissez un fichier vers lequel $lnkbrut pointera\n";

    print "$lx\nChanger fielname: $lnkbrut [num]|[Enter]|[q]
  quitter\n";

    @val = (values (%h_fst));

    @val = (sort @val);

   # # trier par ordre alphabétique par concordance, si
  option -l activé--------

   # if ($argv eq "l") {

   #   $deb_lkbrut = substr($lnkbrut, 0, 1);

   #   foreach $element(@val) {

   #     my $deb_ancre = substr($element, 0, 1);

   #     (push @valalpha, $element) if
  ($deb_ancre eq $deb_lkbrut);

   #     } 

   #   }

   # if (@valalpha ne "") {

   #   @val = @valalpha;

   #   }

   #
  #----------------------------------------------------------------------------

    $i = 0;

    $pair = 0;

    $ff++;

    foreach (@val) {

      $lknet_tmp = $_;

      $max = 40;

      DEBF:if($pair == $max) {

        &regarder($userx);

        }

      else {

        if($pair%2 == 0) {

          $na = $i;

          $a = $lknet_tmp;

          if($lknet_tmp eq
  "$val[$#val]") {

        $b = "n\/a";

            write;

            }

          $i++;

          $pair++;

          }

        else {

          $nb = $i;

          $b = $lknet_tmp;

          write;

          $pair++;

          $i++;

          }

        }

      }

    &regarder($userx);

  }

  

  

  sub utilisateur_fe {

  

    $userx = "fe";

    @val =();

    $a = $b = "";

    # @valalpha = "";  #en prevision du tri des concordances
  (voir 5 lignes plus bas)

    # ligne dessous a saquer quand bon

    print RAP "fe:pas de corresp pour $lnkbrut il par a user\n";

   # print "Choisissez une encre vers lequel $lnkbrut pointera\n";

    print "$lx\nChanger ancre: $lnkbrut [num]|[Enter]|[q] quitter\n";

    @val = (values (%h_tencre));

    @val = (sort @val);

   # # trier par ordre alphabétique par concordance, si
  option -l activé---------

   # if ($argv eq "l") {

   #   $deb_lkbrut = substr($lnkbrut, 0, 1);

   #   foreach $element(@val) {

   #     my $deb_ancre = substr($element, 0, 1);

   #     (push @valalpha, $element) if
  ($deb_ancre eq $deb_lkbrut);

   #     } 

   #   }

   # if (@valalpha ne "") {

   #   @val = @valalpha;

   #   }

   #
  #-----------------------------------------------------------------------------

    $pair = 0;

    $i = 0;

    foreach (@val) {

      #---pour limiter a lnknet

      $value = $_;

      ($lknet_tmp, $encre_tmp)= split(/\#/, $_);

      if($lknet_tmp eq $lnknet) {

        $max = 40;

        DEBFE:if($pair == $max) {

          &regarder($userx);

          }

        else {

          if($pair%2 == 0) {

            $na = $i;

            $a = $value;

            if($value eq
  "$val[$#val]") {

          $b = "n\/a";

             
  write;

              }

            $i++;

            $pair++;

            }

          else {

            $nb = $i;

            $b = $value;

            write;

            $pair++;

            $i++;

            }

          }

        }

      }

    &regarder($userx);

    }

  

  

  sub utilisateur_full {

  

    $userx = "full";

    @val = ();

    $a = $b = "";

    # @valalpha = "";  #en prevision du tri des concordances
  (voir 5 lignes plus bas)

    print RAP "ufull:Ce liens n a pas de corresp $lnkbrut il par a
  user\n";

    print "$lx\nChanger lien: $lnkbrut [num]|[Enter]|[q] quitter\n";

    @val = (values (%h_tencre));

    @val = (sort @val);

   # # trier par ordre alphabétique par concordance, si
  option -l activé---

   # if ($argv eq "l") {

   #   $deb_lkbrut = substr($lnkbrut, 0, 1);

   #   foreach $element(@val) {

   #     my $deb_ancre = substr($element, 0, 1);

   #     (push @valalpha, $element) if
  ($deb_ancre eq $deb_lkbrut);

   #     } 

   #   }

   # if (@valalpha ne "") {

   #   @val = @valalpha;

   #   }

   #
  #----------------------------------------------------------------------

    $i = 0;

    $pair = 0;

    foreach (@val) {

      $value = $_;

      $max = 40;

      DEBFULL:if($pair == $max) {

        &regarder($userx);

        }

      # ceci affiche les valeurs $values et les chiffres
  represantant les valeur indexés sur $i

      else {

        if($pair%2 == 0) {

          $na = $i;

          $a = $value;

          if($value eq "$val[$#val]") {

        $b = "n\/a";

            write;

            }

          $pair++;

          $i++;

          }

        else {

          $nb = $i;

          $b = $value;

          write;

          $pair++;

          $i++;

          }

        }

      }

    &regarder($userx);

  }

  

  

  

  sub faitdcopies {

    # les copies de fichier en meta langage doivent etre copier dans
  /newsite_x/tmp

    $copie = "$path_tmp" . "$file";

  

    #&reconstruire_ligne;

  

    print VRL "fichier $file,de $j lignes dont $k ligne href
  couper\n";

  

    open FC, ">$copie" or die "Ouverture de $copie impossible $!";

    print FC "@nwlines";

    #print FC "@copim";

    #---

    if ($argv eq "u") {

      print FC '<!-- fichier initial ' . "$file
  daté du $fr_date_file" . ' -->';

      }

    close FC || die "Fermeture de $copie impossible $!";

  

    @copim = "";

    @nwlines = @lines = "";

  

    $z++;

  }

  

  #------------------------------------------------------------------------verifd

  sub verifd {

  

    unless (-e $d) {

      print "Veuillez ré-entrer le chemin complet
  du dossier à traiter, expl:" . '/home/pub/monsite ou
  //perl//pub//toto' . "\n";

      chomp($d = <STDIN>);

    }

  }

  

  sub traite_d {

    #-----------ouverture lecture, assignation @lsfile, controle
  srep != sous_rep

    opendir R, "$d" or die "Ouverture de $d impossible $!";

    my @lsfile = (sort readdir R);

    closedir R or die "Fermeture du repertoire R impossible $!";

    foreach $file(@lsfile) {

  

      if ($file =~ /^\./) {

        print "voulez vous traiter ce fichier
  [o,n](n): $file\n";

        $point = <STDIN>;

        chomp $point;

        if($point =~ /^o/i) {

      push @ls_other_file, $fichiercible;

      }

        }

      # vérifier si un rep est $srep (donc juste
  rep_rootname ou plus bas) et le traiter à la place de
  &faitmoitmp

      if (-d "$d$slash$file") {

        my $sous_rep = $file;

        # vérifier si un rep est $srep
  (donc sous la forme /home/pub/foo/bar)et le traiter à la place
  de &faitmoitmp

        #demander a user si on traite $sous-rep

      }

      else {

        my $fichiersource = "$d$slash$file";

        #print "$lx\navant copy fichiersource
  vaut $fichiersource\n";

        my $fichiercible = "$path_tmp$file";

        #print "$lx\napres copy fichiercible
  vaut $fichiercible\n";

        if ($file =~ /\.{1}s?h?x?t?m{1}l?$/i) {

      push @h_fst, $file;

      push @ls_file_meta, $fichiercible;

      copy($fichiersource, $fichiercible) or die
  "impossibilité de copier $fichiersource sur $fichiercible $!";

      }

        else {

      push @h_fst, $file;

      my $fichiercible = "$path_newsite$file";

      push @ls_other_file, $fichiercible;

      copy($fichiersource, $fichiercible) or die
  "impossibilité de copier $fichiersource sur $fichiercible $!";

      }

        #copy($fichiersource, $fichiercible) or
  die "impossibilité de copier $fichiersource sur $fichiercible
  $!";

        # exec dos2unix "$d$slash$file"; # voir
  si ca marche

        push @nwlsfile, $file;

      }

    }

    # rend compte sur VRL

    print VRL "\n$lx\nliste des fichiers meta que recup_all
  recopiera dans $path_tmp\n";

    foreach (@ls_file_meta) {

      print VRL "$_\n";

      }

    print VRL "\n$lx\nliste des autre fichiers que recopier dans
  $path_newsite\n";

    foreach (@ls_other_file) {

      print VRL "$_\n";

      }

    print VRL "\n$lx\n";

  }

  

  

  #---------- choix du repertoire temporaire-------------\

  sub faitmoitmp {

    my $q = 0;

    if (-e $newsite) {

      while (-e $newsite) {

        $q++;

        $newsite = "$dir$slash" . "newsite" .
  "_$q";

      }

      mkdir $newsite or die "ouverture de $newsite
  impossible $!";

    }

    else {

      mkdir $newsite or die "ouverture de $newsite
  impossible $!";

    }

    $tmp = "$newsite$slash" . "tmp";

    mkdir $tmp or die "création de $tmp impossible $!";

    $path_tmp = "$tmp$slash";

    $path_newsite = "$newsite$slash";

    

    # ca ne veut rien dire si $srep est du style /home/pub/image ca
  marchera pas

    if (defined $srep) {

      if ($srep =~ /\w$/i) {

        $srep = "$path_newsite" . "$srep";

        mkdir $srep or die "ouverture de $srep
  impossible $!";

      }

    }

  

  

    print "Un dossier newsite contiendra vos pages
  corrigées\net $slash" . "newsite$slash" . "tmp contiendra les
  logs de synthése\n";

  }

  

  

  #--------------------------sous procedure qui modifie les portions de
  ligne

  sub chklnk {

    if($corrompu == 0) {

      $line =~ s/()\Q$oldlb\E()/$1$lnkbrut$2/;

      $oldlb = $lnkbrut;

      $corrompu++;

    }

    else {

      $line =~ s/()\Q$oldlb\E()/$1$lnkbrut$2/;

      $oldlb = $lnkbrut;

    }

      # $line =~ s/$oldlb/$lnkbrut/xmg;

      # $line =~ s/()\Q$oldlb\E()/$1$lnkbrut$2/;

  

  }

  

  

  #---------------------------------------------------------------degage_path

  sub degage_path {

    print RAP "DP: path trop long $err\n";

    &decortique_file;

    while ($lnknet =~ /$slash/) {

      @pathl = split(/$slash/, $lnknet);

      $fpointe = pop @pathl;

     # $presquesrep = pop @path1;

     # ($fpointe = $presquesrep) if ($presquesrep=~
  /$srep$/);   # laisse srep dans le nom si il exsiste

      if ($encre gt "") {

        $lnknet = $fpointe;

        $lnkbrut = "$lnknet" . "\#$encre";

        print RAP "Correction faite $lnkbrut par
  dp\n";

        print "Correction faite $lnkbrut par
  dp\n";

      }

      #

     
  #------------------------------------------------pass 4 ok -------v

      else {

        $lnkbrut = $lnknet = $fpointe;

        print RAP "Corriger: $lnkbrut par dp\n";

        print "Correction faite $lnkbrut par
  dp\n";

      }

     
  #-----------------------------------------------------------------°

    }

    $v++;

    $fr++;

    &chklnk;

    goto SCONTROL;

  }

  

  

  

  # lknet2lnkbrut-----------------debut (ne sert qu'a controler au
  debuggage)

  sub lknet2lnkbrut {

    print RAP "LKNET2LB: etat des liens en entrer:\nln: $lnknet\nlb:
  $lnkbrut\n";

    if($encre eq "") {

      $lnkbrut = "$lnknet";

    }

    else {

      $lnkbrut = "$lnknet" . "\#" . "$encre";

    }

    &chklnk;

    print RAP "LKNET2LB: etat des liens en sortie:\nln: $lnknet\nlb:
  $lnkbrut\n$lx\n";

    goto SCONTROL;

  }

  #--------------------------------- fin

  

  

  

  

  #----------------------------------------Compte rendu
  ---------------------------debut

  sub compte_rendu {

    

    if ($file =~ /\.{1}s?h?x?t?m{1}l?$/i) {

      $file_cr= "$path_tmp" . "frap_" . "$ir.log";

  

      open FRAP, ">$file_cr" or die "Ouverture de
  $file_cr impossible $!";

      print "$firstline$lx\n";

      print FRAP "Liens http de $file trouvé avec
  liste:\n";

      foreach $lk(@lnk_http) {

        print FRAP "adresse Web: $lk\n";

        }

      print FRAP "\n$lx\navec le hashage maintenant\n";

      while ( ($key, $value) = each %h_lnkhttp) {

        print FRAP "$key = $value\n";

        }

      print FRAP "\n$lx\n";

      print FRAP "liens ftp de $file trouvé:\n";

      foreach $lk(@lnk_ftp) {

        print FRAP "adresse ftp: $lk\n";

      }

      print FRAP "\n$lx\navec hashage now:\n";

      while ( ($key, $value) = each %h_lnkftp) {

        print FRAP "$key " . "=" . "$value\n";

      }

      print FRAP "$lx\n$lx\navec le nouveau hashage
  h_tencre\n";

      while ( ($key, $value) = each %h_tencre) {

        print FRAP "$key = $value\n";

        }

      #-----------login now----

      print FRAP "$lx\n\tlogin trouvé:\n";

      $login = join("\n", @adressemail);

      print FRAP "$login\n";

      if($ea >= 1) {

        print FRAP "$ea erreurs reparés
  par $e_mailp\n";

      }

      #------------stat

      print FRAP "$lx\n";

      print FRAP "Sur un total de $cnttl lignes
  controler\npour un total de $j liens controler :\n";

      print FRAP "$cntlnkhttp liens http: " . "\nnon
  controler\n" . "\n$cntlnkftp liens ftp:\nnon controler pour le
  moment\n";

      print FRAP "Les lnknet maintenant\n";

      print FRAP "$j liens controler sur $file\n";

      print FRAP "recap total de $j liens:\n$eb bon
  adressage\n$ef erreur adressage\n$fr erreur adressage fichier
  réparer\n$eb bonne encre\n$ere erreur encre\n$err encre
  reparrer\nerreur adresse web $ea\n";

      $filos = join("\n", @rep);

      print FRAP "effectuer sur les fichiers:\n" .
  "\n$filos\n$lx\n";  #ca marche

      print FRAP "fait le $fr_date_now\n";

      close FRAP || die "dreumer ca bloque $!";

      }

  

    # --------------------------------remise a zero de nwlines et
  incremente index rapport

    @nwcontenu = "";

    $ir++;

  }

  #-------------------------------------------------------------------------------------
  fin

  #-------------------------------------ouvre_log-- géant

  sub ouvre_file {

    my ($rootfile_file, $hdl_file, $ext)= @_;

    

    print "dans ouvre_file mon rootfile_file vaut $rootfile_file\n";

    my $i = 0;

  

    if ($rootfile_file eq "var_2vvl") {

        $flg = "$dir$slash$rootfile_file.$ext";

  

      while (-e $flg) {

        $flg = "$dir$slash$rootfile_file" .
  "_$i" . ".$ext";

        $i++;

        }

    }

  

    if ($path_tmp eq "") {

      $path_tmp = $dir;

    }

    $flg = "$path_tmp$slash$rootfile_file.$ext";

  

    while (-e $flg) {

      $flg = "$path_tmp$slash$rootfile_file" . "_$i" .
  ".$ext";

      $i++;

    }

    open $hdl_file, ">$flg" or die "Ouverture de $flg impossible
  $!";

    print $hdl_file "script: $script (V: $vers) - date:
  $fr_date_now\n$lx\n";

  }

  

  sub regarder {

    my $userx = @_;

    # print "$lx\nChanger lien: $lnkbrut [num]|[Enter]|[q]
  quitter\n";

    chomp($repu = <STDIN>);

    # si l'user ne veux pas ce prononcer| ou n'est pas dans les 40
  propositions pour uf et uef

    if($repu eq "") {

      #$max = $max + 40;

      $pair = 0;

      (goto DEBF and undef $repu) if ($userx eq "f");

      (goto DEBFE and undef $repu) if ($userx eq "fe");

      (goto DEBFULL and undef $repu) if ($userx eq "full");

  #    if ($userx eq "f") {

  #      undef $repu;

  #      goto DEBF;

  #    }

  #    elsif ($userx eq "fe") {

  #      undef $repu;

  #      goto DEBFE;

  #    }

  #    elsif ($userx eq "full") {

  #      undef $repu;

  #      goto DEBFULL;

  #    }

      }

    elsif($repu =~ /^\d/) {

      $lnkbrut = $val[$repu];

      print RAP "\n $userx important\n$lnkbrut\n";

      $lnkbrt = $lnkbrut;

      ($lnknet, $encre)= split(/\#/, $lnkbrt);

      print "Votre choix valider:\t $lnkbrut\n";

      $userx = "";

      $v++;

      &chklnk;

      undef $repu;

      goto SCONTROL;

    }

    elsif($repu =~ /^q$/i) {

      $userx = "";

      $v++;

      print "Ce programme va se fermer, retrouver les log
  dans /newsite/tmp \n";

      print RAP "Programme $script vers:$vers d\'
  $moi\nfermer par utilisateur à $fr_date_now,\nbonne
  journée\n";

      close RAP || die "far toi encouler granda connassa
  rap $!";

      closedir RC || die "Fermeture de $path_tmp
  impossible (putain de merde) $!";

    }

    else {

      print "Vous avez entrer $repu ca remplacera
  $lnkbrut\n";

      $lnkbrut = $repu;

      $lnkbrt = $lnkbrut;

      ($lnknet, $encre)= split(/\#/, $lnkbrt);

      &chklnk;

      undef $repu;

      $userx = "";

      $v++;

      goto SCONTROL;

    }

  }

  

  

  sub reconstruire_ligne {

    my ($lines) = @_;

  

  # on split tout ca a plat

    $tout = "@lines";

    @cop = split(//, $tout);

  

  

  # balise $ouvert = 1 ==> vrai; 0 ==> faux

  $ouvert = $tronquage = 0;

  @ligne = @nwcop = "";

  foreach $e(@cop) {

    if ($ouvert == 0) {

      $i++;

      if($e eq "<") {

        # signale qu'une balise est ouverte et
  pousse la ligne

        $ouvert = 1;

        push @ligne, $e;

      }

      elsif ($e eq "\n") {

        # pousse \n dans @ligne puis @ligne dans
  @nwcop et réinitialise @ligne

        push @ligne, $e;

        push @nwcop, @ligne;

        @ligne ="";

        $i = 0;

      }

      else {

        # pousse le caractère dans la
  ligne

        push @ligne, $e;

        }

      }

    # un balise à été ouverte donc passage en
  ouvert

    else {

      $i++;

      if ($e eq "\n") {

        # balise tronquées 

        $tronquage = 1;

        $k++;

        }

      elsif ($e eq ">") {

        $ouvert = 0;

        if ($tronquage == 1) {

      # si tronqué pousser le caractère dans
  ligne et lui ajouter une fin de ligne

      # puis remettre à zero $ligne, $tronquage et
  ouvert

      push @ligne, "$e\n";

      push @nwcop, @ligne;

      $i = 0;

      @ligne = "";

      $tronquage = 0;

      }

        elsif ($tronquage == 0) {

      # si il n'y a pas eu de tronquage pousser dans ligne

      push @ligne, $e;

      }

        }

      else {

       # print "je passe en ouvert quelconque
  $i:$e:\n";

        # si c'est un caractere quelconque, le
  pousser dans ligne

        push @ligne, $e;

        }

      }

    }    

    

    $contenu = join('', @nwcop);

    @nwlines = $contenu;

  }

  

  

  sub decortique_file {

  

    # decortique le nom complet($lnkbrut) en lnknet, encre, rootfile
  et ext, sans toucher a lnkbrut et lnknet

    $lnkbrt = $lnkbrut;

    ($lnknet, $encre) = split(/\#/, $lnkbrt);

    $lnkt = $lnknet;

    ($rootfile, $ext) = split(/\./, $lnkt);

  }

  

  

  sub datefinefile {

    my ($file, $m_acces, $format_d)= @_;

   

    $datenum = ((stat($file))[$mode]);  

    (my $sec,my $min,my $heure,my $mjour,my $mois,my $annee,my
  $sjour,my $ajour,my $isdst) =  localtime($datenum);

    if ($mois <= 9) {

      $mois= "0" . ($mois+1);

    }

    if ($mjour <= 9) {

      $mjour = "0" . "$mjour";

    }

    if ($heure <= 9) {

      $heure = "0" . "$heure";

    }

    if ($min <= 9) {

      $min = "0" . "$min";

    }

    if ($sec <= 9) {

      $sec = "0" . "$sec";

    }

    my $cj = $lssjour[$sjour];

    my $pj = substr($cj, 0, 2);

    my $pm = substr("$lssmois[$mois]", 0 , 3);

    if ($annee < 100) {

      $pa = $annee;

    }

    elsif ($annee <=109) {

      $pa = "0" . ($annee-100);

    }

    else {

      $pa = ($annee-100);

    }

    if ($format_d == 1) {

      # format differants 1: 20100131-203001 

      $fr_date_file = ($annee+=1900) .
  "$mois$mjour-$heure$min$sec";

      }

    elsif ($format_d == 2) {

      # format differants 2: 31/01/2010-20:30

      $fr_date_file = "$mjour\/$mois\/" . ($annee+=1900) .
  "-$heure:$min";

      }

    elsif ($format_d == 3) {

      # format differants 2: $fr_datenum_file =
  Di-31/01/2010-20:30:02

      $fr_date_file = "$pj-$mjour\/$mois\/" .
  ($annee+=1900) . "-$heure:$min:$sec";

      }

    elsif ($format_d == 4) {

      # format differants: $fr_dt_file = 31Jan10-20h

      $fr_date_file = "$mjour$pm" . "$pa" . "-$heure" .
  "h";

      }

    elsif ($format_d == 5) {

      # format differants: $fr_dt_file = Di 31 Jan 10 -
  20h30

      $fr_date_file = "$pj $mjour $pm" . " $pa" . "-
  $heure" . "h$min";

      }

    else {

      # format differants: $fr_date_file = Dim 31 Janvier
  2010 - 20:30:02

      $fr_date_file = "$lssjour[$sjour] $mjour
  $lssmois[$mois] " . ($annee+=1900) . " - $heure:$min:$sec";

      }

    return $fr_date_file;

    }

  

  

  format STDOUT =

  @<<<
  @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<    
  @<<<
  @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

  $na, $a, $nb, $b

  .

  

  # script Perl écrit par alain Adelmar alias alCoolfort

  # ce script repare plus de 9 liens sur 10

  

  END;