#!/usr/bin/perl -w
# remd:  Répare les liens en local (avant de publier) en les testant. version :1.02 | Janvier 2003       *
# répare les erreurs d'afféctation et les incompatibilité dues aux changements de systeme UNIX-Like=>M$. *
# Vérif des encres et ré-attribution du premier flag et/ou création d'un #top_ (si page existe sans flag)*
# écrit par alain Adelmar a.adelmar@wanadoo.fr | vers: 1.04 (beta)    |    date: 22/11/02 ~ 18/04/03 14h *
#--------------------------------------------------------------------------------------------------------*
# personel: accessoirement remplace aadelmar@free.fr par a.adelmar@wanadoo.fr | (version pour UNIX-Like) *
#*********************************************************************************************************

# sortie formatée pour l'affichage fichiers/tags
format OUTS_TOP =
Page @ << 
$% 

 Fichier                Flags 
=============          ============
.

format OUTF_TOP =
Page @ <<
$%

 Fichier            Fichier            Fichier
==========         ==========         ==========  
.


# initialisation des variables
$e_mailp = 'a.adelmar@wanadoo.fr';
$countlnk = $u = $i = $k = $cnta = $cntlnkhttp = $cntl = $cntlnknet = $cntlnkftp = $z = 0; 
#-------------------------------------------------------------------------------------
$x = "*-" x 25;                                             # fioritures qui soulignes
$y = "__-__*" x 15;                                         # idem pour différencier
$al = "\t=== A_l_a_i_n -\/\/- A_d_e_l_m_a_r ===      |";    # pub perso
#--------------------------------------------------------------------------- explication pour l'utilisateur
$lbl = "\n\tCe script va modifier les liens locaux de chaque page HTML en liens web\n\tSans pour cela toucher à votre dossier de page-perso\n\til copiera l integralite de vos pages dans un nouveau repertoire\n\t:\/tmp\/newsite\n";
$maintenant = localtime(time);

#création et ouverture d'un rep temporaire pour placer le nouveau site ainsi créé (pour UNIX-Like).
$stemp = "\/tmp";
$newsite = "\/tmp\/newsite";
$temp = "\/home";
$file;
$fs = "\/home\/alain\/sorti_verylink_" . "$file" . "\.log";  

# a degager quand ok---------------
open FS, ">$fs" or die "ouverture de $fs impossible $!";    # compte rendu d'execution du script

print "\t$x\n$al\n\n\t$x\n\n$lbl\n";
#------------------------------------- choix du repertoire temporaire
while (!(-e $newsite)) {
  print "La copie réparer de votre site sera copié sur $newsite:[Oui-Non] ou [path dossier] ou Quitte\n";
  $rcible =<STDIN>;
  chomp $rcible;
  if ($rcible =~ /^o|y|\n/i) {
    if (-e $stemp) {
      mkdir $newsite,0777 or die "ouverture de $newsite impossible $!";
    }
    else { 
      mkdir $stemp,0774 or die "Création de $stemp impossible $!"; 
    }
  }
  elsif ($rcible =~ /^n/i) {
      print "ok le dossier cible se trouvera dans HOME ~\/newsite\n";
      if (-e $temp) {
	mkdir "\/home\/newsite",0744 or die "Création du dossier newsite impossible $!";
	print "création du dossier newsite effectué\nil sera dans le repértoire: \/home\/newsite\n";
	$newsite = "\/home\/newsite";
      }
      else { die "Vous avez un gros problême vu que vous n'avez pas de répértoire home\nconseil le prochain coup repondez oui\nou donner un chemin correct\n $!" }
    }
  elsif ($rcible =~ /^q/i) {
    die "Tchao !!! a la prochaine\n";
  }
  else {
    $newsite = $rcible;
  }
}


#--------------------------demander quel repertoire traiter et verifier si il existe
print "$x$x\n";
print "Indiquez le dossier a traiter:\n"; 
chomp($d = <STDIN>); 

unless (-e $d) {
  print "Veuillez ré-entrer le chemin complet du dossier à traiter, expl:" . '/home/pub/monsite' . "\n";
  chomp($d = <STDIN>);
}

#--------------juste pour recapitulatif mais incorect because $d est en gnl en read-only
# if ($d =~/\/$/){ 
#   $fout = "$d" . "rep.log"; 
# } 
# else { 
#   $fout = "$d\/rep.log"; 
# } 
# mettre en comment, si on decide que ok pour le rep source
$fout = "\.\/rep.log";

#----------ouverture du repertoire, assign de la list de file, et traitement file/file
opendir R, "$d" or die "Ouverture repertoire impossible $!"; 
@lsfile = (sort readdir R);
print "$x$x\n";
&recup_all_tags;

foreach $file(@lsfile) {
  if ($file =~ /\.htm|\.dat|\.txt|\.log|html$/) {
    print "$x\n";
    &controle_file;
    &reparation;
    &compte_rendu;
    push @rep, $file;
  }
  #-------------facultatif
  $pfile = "\t$file\n\t" . '********' . "\n";
  print FS $pfile; 
  
  #--------------
}
closedir R or die "Fermeture du repertoire R impossible $!"; 
#---------------------------------recherche des flags

#--------------------------------------------pour chaque fichiers voulu, ligne par ligne
sub controle_file {
  my($good)= 0;         # last ou next si good = 1; 
  $filesrc = "$d\/$file";
  close FS || die "impossible de fermer $fs $!";
  $fs = "\/home\/alain\/sorti_verylink_" . "$file" . "\.log";
  open FS, ">$fs" or die "Ouverture de $fs impossible $!";
  open FI, "$filesrc" or die "Ouverture du fichier $file impossible $!";
  @lines = <FI>;
  close FI || die "Fermeture impossible $!";
  
  foreach $line(@lines) {
    $cnttl++;  #compteur de lignes traité (total)
    $cntl++;   #index de ligne, par document, pour recherche.
    if ($line=~ /<a\shref="(.*?)"/i) {
      $lnkbrut = $1;
      $countlnk++;
      if ($lnkbrut=~ /^mailto/) {
	($kk, $email) =split(/:/, $lnkbrut);
	($login, $fai) = split(/\@/, $email);
	$cnta++;
	#------------------------modification perso
	if ($email =~ /^aadelmar/) {
	  s/$email/$e_mailp/;
	  print FS "modification d'adresse mail effectué sur $file ligne $cntl\n";
	}
      }
      #--------------------http
      elsif ($lnkbrut=~ /^http:\/\//i) {
	($lnkhttp, $encre) = split(/\#/, $lnkbrut);
	$cntlnkhttp++;
	$prlnkhttp = "$file ligne:$cntl\t$lnkhttp\t$encre\n";
	push @lnk_http, $prlnkhttp;
	# ou en hashage
	$h_lnkhttp{"$lnkhttp" . "_" . "$cntlnkhttp"} = $encre;
      }
      #------------------ftp
      elsif ($lnkbrut=~ /^ftp:\/\//i) {
	($lnkftp, $encre) = split(/\#/, $lnkbrut);
	$cntlnkftp++;
	$prlnkftp = "$file ligne:$cntl\t$lnkftp\t$encre\n"; 
	push @lnk_ftp, $prlnkftp;
	
	#-------------- ou en hashage
	$h_lnkftp{"$lnkftp" . "_" . "$cntlnkftp"} = $encre;
      }
      #---------------local
      else {  
	($lnknet, $encre) = split(/\#/, $lnkbrut);
	$cntlnknet++;
	#---------------------------------------------------y a une couille
	print "Trouvé\n" if exists ${{reverse %htab}} {$lnkbrut};
	if (&regarde($lnkbrut) == 1) {
	  LABELPARDEF:print "et de $v lien qui colle direct\n";
	  $v++;
	} 
	else { 
	  $prlnknet = "$file ligne:" . "$cntl " . "$lnknet " . "$encre\n";
	  # pour avoir une liste de liens par pages
	  push @lnk_net, $prlnknet;
	  $h_lnknet{$lnknet . ":" . $cntlnknet} = $encre;
	  # depart de tout les test en local
	  &traquef;
	  $nwlnkb = "$lnknet" . "#" . "$encre";
	  $line=~ s/$lnkbrut/$nwlnkb/;
	}
      }
     
      # il faut que $line soit impeccable
      push @nwlines, $line;
    }
    
    else {
      # pousser le reste dans le nouveau document
      push @nwlines, $line;
      $cntl = 0;
    }
  }
  #push @LoL_http, [ @lnk_http ]; 
  #push @LoL_ftp, [ @lnk_ftp ]; 
  push @LoL_net, [ @lnk_net ];
 
}


sub traquef {
    # traite les liens locaux (sur la même page) ex: #top_ 
  if ($lnknet =~ /^\#/) {
    &control_encre;
   }

  $full_filename= "$d\/$lnknet";

  if (-e $full_filename) {
    print FS "$x\n_Dans $file traquef:nom du lien $lnknet existe\nav control_encre:$full_filename\n";
    $gf++;
    &control_encre;
  }
  elsif (-e $lnknet) {
    ($root, $filename) = split(/\\$/, $linknet);
    $lnknet = $filename;
    $full_filename = "$d\/$lnknet";
    print FS "$x\n_Dans $file trakf:lien doubler puis spliter:$full_filename\n"; #---a deg
    $ef++;
    $fr++;
    &control_encre;
  }
  elsif ($lnknet =~ /.?\w\\\w\.\w.?|.?\/\w\.\w.?/) {
    # c'est un lien Microsoft ou linux
    ($kk, $lnknet)= split(/\\/, $lnknet);
    ($kk, $lnknet)= split(/\//, $lnknet);
    # voila c'est tout
    $fr++;
  }

  else {
    
    # voir si il n'y a pas un PATH accroché (UNIX-like) autre que celui au dessus.
    if ($lnknet=~ /.*?\/.*?/) {
      ($kk, $filename)= split(/\//,$lnknet);
      $lnknet = $filename;
    }
    # idem mais pour MicroSoft (petit-Mou)
    elsif ($lnknet=~ /.*?\\.*?/) {
      ($kk, $filename)= split(/\\/,$lnknet);
      $lnknet = $filename;
    }
    else {
      print "$y\nProbléme:dans traquef (page non reconnu):\nAucune correspondance pour le lien:\n$lnknet:$encre\nchoisissez dans la liste ci-dessous puis\nentrer le nom du fichier vers qui il doit pointer:\nSi vous désirez laisser en l'etat [Enter]\nSi vous entrez un substitut et que vous ne voulez pas qu'il soit vérifié, saisissez:\nR:monlien_a_ne_pas_verifier.dob\n";
      print "regader la liste des fichiers\n";
      $ef++;
      #print "Fichiers      Fichiers      Fichiers\n========      ========      ========\n";
      foreach $k(@reph) {
	select((select(STDOUT),
		$~ = "OUTF",
		$^ = "OUTF_TOP"
	       )[0]);
	
	# sur trois colonnes
	if ($u <= 2) {
	  push @row, $k;
	  $u++;
	}
	else {
	  write;
	  $u = 0;
	  delete @row[0..$#row];
	}
      }
      write;
      print "\n\nNom du fichier désigné:";
      $user_lnknet =<STDIN>;
      chomp $user_lnknet;
      if ($user_lnknet=~ /^R:()/) {
	($kk, $lnknet)=split(/:/, $user_lnknet);
	$fr++;
	goto LABELPARDEF;
      }
      elsif ($user_lnknet eq "") {
	$fr++;
	goto LABELPARDEF;
      }
      else {
	$lnknet = $user_lnknet;
	&traquef($lnkbrut);
      }
    }
  }
}

sub control_encre {
  for (values %htag) {
    if ($_ eq "$file#" . "$encre") {
      print "top_cool\n";
      $eb++;
    }
    else {
      open FC, "$full_filename" or die "Ouverture de $lnknet impossible $!";
      @cible = <FC>;
      close FC || die "fremeture impossible $!";
      #---------chercher une encre2secour | a voir dessous
      $po = 0;
      foreach $el(@cible) {
	if ($po == 0) {
	  if ($el =~ /<a\sname="$encre"/i) {
	    $eb++;
	    print "cool $encre a été trouvé sur $full_filename ligne $i\n";
	    &reparation;
	  }
	  if ($el =~ /<a\sname="(.*?)"/i) {
	    $def_encre = $1;
	    $po++;
	  }
	}
	else {
	  if ($el =~ /<a\sname="$encre"/i) {
	    $eb++;
	    print "cool mon $encre a été trouvé sur $full_filename ligne $i\n";
	    &reparation;
	  }
	}
      }
      $err++;
      $ee++;
      $encre = $def_encre;
    }
  }
}


sub reparation {
  $fcible = $newsite . "\/$file";
  open FR, ">$fcible" or die "Ouverture de $fcible impossible $!";
  print FR @nwlines;
  close FR || die "Fermeture de $fcible impossible $!";
}

sub compte_rendu {
  $file_cr= "$newsite" . "\/rap" . "$ir.log";
  
  open FRAP, ">$file_cr" or die "Ouverture de $file_cr impossible $!";
  print FRAP "liens http de $file trouvé avec liste:\n";
  foreach $lk(@lnk_http) {
    print FRAP "adresse Web: $lk\n";
  }
  
  print FRAP "\n$x\navec le hashage maintenant\n";
  while ( ($key, $value) = each %h_lnkhttp) {
    print FRAP "$key = $value\n";
  }
  print FRAP "\n$x\n";
  print FRAP "liens ftp de $file trouvé:\n";
  foreach $lk(@lnk_ftp) {
    print FRAP "adresse ftp: $lk\n";
  }
  print FRAP "\n$x\navec hashage now:\n";
  while ( ($key, $value) = each %h_lnkftp) {
    print FRAP "$key = $value\n";
  }
  print FRAP "\n$x\n";
  print FRAP "liens de $file trouvé:\n";
  foreach $lk(@lnk_net) {
    print FRAP "liens vers la page: $lk\n";
  }
  print FRAP "\n$x\navec le hashage now\n";
  while ( ($key, $value) = each %h_lnknet) {
    print FRAP "$key = $value\n";
  }
  print FRAP "\n$x\n";
  print FRAP "Pour un total de $countlnk liens dans le fichier $file :\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 "$cntlnknet sur $file\n";
  print FRAP "recap total de $cntlnknet liens \/page:\n$gf bon adressage\n$ef erreur adressage\n$fr erreur adressage fichier réparer\n$eb bonne encre\n$ee erreur encre\n$err encre reparrer\n";
  print FRAP "effectuer sur les fichiers:\n" . "\n@rep\n" . "\n";  #ca marche
  print FRAP "fait le $maintenant\n";
  close FRAP || die "dreumer ca bloque $!";
  # --------------------------------remise a zero de nwlines et incremente index rapport
  @nwlines = "";
  $ir++;
}



open FO, ">$fout" or die "Ouverture de $fout impossible $!";
print FO "Récapitulation\:\n" . $countlnk . " liens dans " . $#rep+1 . " fichiers\n";
print FO "recap total de $cntlnknet liens \/page:\n$gf bon adressage\n$ef erreur adressage\n$fr erreur adressage fichier réparer\n$eb bonne encre\n$ee erreur encre\n$err encre reparrer\n";
print FO "\n@rep\n";
for $i (0 .. $#LoL_net) {
  $ref_tab= $LoL_net[$i];
  $n = @$ref_tab -1;
  for $j (0 .. $n) {
    print FO "l'element $i $j est $ref_tab->[$j]\n";
  }
}
close FO || die "rimpossuble dhmfkjh fermer  le hsdkjhfj $!";
close FS || die "Fermeture de $fs impossible $!";


sub recup_all_tags {
  select((select(STDOUT),
	  $~ = "OUTS",
	  $^ = "OUTS_TOP"
	 )[0]);
  foreach $file(@lsfile) {    # ici $file vaut ~ nom_de_fichier.html
    if ($d =~ /\/$/) {
      $ftagsrc = "$d" . "$file";
    }
    else {
      $ftagsrc = "$d\/$file";
    }
    if ($file =~ /\.htm|html$/) {
      open FT, "$ftagsrc" or die "Ouverture du fichier $file impossible $!";
      @lines = <FT>;
      close FT || die "Fermeture impossible $!";
      foreach $line(@lines) {
	if ($line=~ /<a\sname="(.*?)"/i) {
	  $tag = $1;
	  #$fz = "$file:$z";
	  # mieux
	  $htag{$z}= "$file" . "#" . "$tag";
	  write;
	  $z++;
	}
      }
      push @reph, $file;
    }
  }
}


sub regarde($lnkbrut) {
  # return 1 if exists ${{reverse %htab}} {$lnkbrut};
  for (values %htab) {
    return 1 if ($_ =~ /$lnkbrut/);
  }
  print "je t emmerde\n";
  return 0;
  
}

sub encre2secour($def_encre) {
  for (@cible) {
    if (/<a\sname="(.*?)"/i) {
      $def_encre = $1;
      print "premier tag de cible trouver dans $full_filename comme encre2secours $def_encre\n";
      #&control_encre;
    }
    else {
      $ee++;
      $def_encre= "#top_";
    }
  }
}

format OUTS = 
@<<<<<<<<<<<<<<<<<<<<< @<<<<<<<<<<<<<<<<<<< 
$file, $tag 
. 

format OUTF =
@<<<<<<<<<<<<<<<<<<<<  @<<<<<<<<<<<<<<<<<<<<  @<<<<<<<<<<<<<<<<<<<<
$row[0], $row[1], $row[2]
.
 

END;
