#!/usr/bin/perl 

#   rechpatro version 0.3 14 avril 2000
#   Ce programme est un utilitaire genealogique. Il regarde les patronymes
#   qui figurent dans le fichier name.txt par defaut (ou dans le fichier
#   donne en ligne de commande) chacun sur une ligne. Il lance une
#   recherche sur ce patronyme sur les sites geneanet et familysearch (mormon)
#   et enfin il ecrit un fichier resultat donnant les nouveautes par rapport
#   a une recherche precedente.
#
#    LIGNE DE COMMANDE :
#    --moteur=geneanet ou -m geneanet pour une recherche sur geneanet 
#    --moteur=mormon ou -m mormon pour une recherche sur familysearch
#    par defaut la recherche se fera sur les deux moteurs
#    toute autre entree apres --moteur= ou -m ne lancera aucune recherche ;
#    SUIVI eventuellement du nom du fichier source (name.txt par defaut).
#
#    STRUCTURE DU FICHIER SOURCE :
#    Chaque ligne doit commencer par le patronyme
#    puis on indiquera au choix aucun ou plusieurs des criteres
#    (au format reclame par geneanet : code geographique a 3 lettres pour
#				    pays, region et sousregion
#				    http://www.geneanet.com/codification/)
#    dans n'importe quel ordre et en utilisant les balises ci-dessous suivies 
#    du separateur point-virgule (le dernier de la ligne peut etre omis) :
#    DEBUT  pour l'annee ou debutent les recherches
#    FIN    pour l'annee ou finissent les recherches
#    LIEU   pour le lieu ou chercher
#    SUB    pour la sous-region (departement)
#    REG    pour la region
#    PAYS   pour le pays (attention : je n'ai pris en compte que les pays
#           France, Allemagne, Suisse et USA ; sinon ajouter les traductions
#           pour les recherches avec familysearch)
#    SOURCE pour indiquer la ou les sources a consulter, ou a ne pas consulter
#    Remarque : la recherche par familysearch ne se fera que par pays,
#               cmopte tenu de la faiblesse de leur moteur 
#               (recherche bicritere uniquement!)
#
# TODO : 
# done  * permettre une recherche multicritere en formattant le fichier
#         name.txt genre : patro LIEU lieu; SOURCE source; ....
#         et utiliser ces param dans les recherches web. S'kal propose xml :(
#       * structurer pour que les moteurs apparaissent proprement: volontaire?
# done  * facile : faire un fichier resultatjjmmaaaa au lieu de juste resultat
#
# BUGS CONNUS :
# done  * j'ai eu sur recherche schmitt france mormon : deux dernieres lignes 
#         qui n'auraient jamais du y etre... !! NON en fait c'est bon :
#         c'est du a la structure differente des infos "pages web" 
#
use strict;
use Socket;
use FileHandle;
use File::Copy;

my($filesource, @listenoms, @tableau, @tableau_ancien, $fileresult);
my($jour, $mois, $annee);
my ($ligne, $entree, $moteur);

#my($fileancien, @lignesancien, $filenouveau, @lignesnouveau);
#my(@tronqueancien, @tronquenouveau);

($jour, $mois, $annee) = (localtime)[3..5];
$mois = $mois +1;
$annee = $annee +1900;

$fileresult = "resultat$jour$mois$annee";
open(RESULT, "> $fileresult");
# LIGNES UTILES AUX TESTS HORS CONNEXION
#$fileancien = './testpt';         # Name the file
#open(ANCIEN, $fileancien);                             # Open the file
#@lignesancien = <ANCIEN>;                              # Read it into an array
#close(ANCIEN);                                         # Close the file
#
#$filenouveau = './testgd';        # Name the file
#open(NOUVEAU, $filenouveau);                           # Open the file
#@lignesnouveau = <NOUVEAU>;                            # Read it into an array
#close(NOUVEAU);                                        # Close the file
#
#@tronqueancien = @{&tronque_mormon(\@lignesancien)};
#@tronquenouveau = @{&tronque_mormon(\@lignesnouveau)};
#@tronqueancien = @{&elimine_balise_html_mormon(\@tronqueancien)};
#@tronquenouveau = @{&elimine_balise_html_mormon(\@tronquenouveau)};
##&traitement_ancien_nouveau(\@tronqueancien,\@tronquenouveau,"nom");
##print @tronquenouveau;
##$patronyme="breyer";
##@tronquenouveau = @{&recherche_geneanet_simple($patronyme)};
##@tronquenouveau = @{&tronque_geneanet(\@tronquenouveau)};
##print @tronquenouveau;
#&traitement_ancien_nouveau(\@tronqueancien,\@tronquenouveau,"test");
#

$filesource = "name.txt"; # shift;          # Nom du fichier source
$moteur = "";
if ($entree = shift) {
  if($entree =~ /--moteur=(.*)\b/) {
    $moteur = $1;
    if ($entree = shift) {$filesource = $entree;}
  }
  elsif ($entree =~ /-m/) {
    if ($entree = shift) {$moteur = $entree;}
    if ($entree = shift) {$filesource = $entree;}
  }
  else {
    $filesource = $entree;}}

open(NOMS, $filesource) or die "Absence de fichier de noms\n";# Open the file
@listenoms = <NOMS>;                                 # Read it into an array
close(NOMS);                                         # Close the file
 
if ($moteur eq "" or $moteur eq "geneanet")
  {foreach $ligne (@listenoms)# a terme changer ces deux horribles boucles
     #pas forcement possible, trop de specificites ds chaque moteur
   {
     my($name1,$name2);
     my $sortie;
     #transformer $ligne en tous les champs possibles
     my($patronyme, $debut, $fin, $lieu, $sub, $reg, $pays, $source);
     if  ($ligne =~ /^(.*?)\s/)  {$patronyme = $1;} else {
       $ligne =~/^(.*?)$/; $patronyme = $1;}
     if ($ligne =~ /DEBUT (.*?)(;|$)/) { $debut =$1;} else  { $debut ="";}
     if ($ligne =~ /FIN (.*?)(;|$)/) { $fin =$1;} else  { $fin ="";}
     if ($ligne =~ /LIEU (.*?)(;|$)/) { $lieu =$1;} else  { $lieu ="";}
     if ($ligne =~ /SUB (.*?)(;|$)/) { $sub =$1;} else  { $sub ="";}
     if ($ligne =~ /REG (.*?)(;|$)/) { $reg =$1;} else  { $reg ="";}
     if ($ligne =~ /PAYS (.*?)(;|$)/) { $pays =$1;} else  { $pays ="";}
     if ($ligne =~ /SOURCE (.*?)(;|$)/) { $source =$1;} else  { $source ="";}
     $source =~ tr/ /+/;
 
     $name1="$patronyme" ."_geneanet_new";
     $name2="$patronyme" ."_geneanet_old";
     unless (-e "$name1") 
       {
# ecrire un fichier vide: utilite? oui: ne cree pas qd copie si inexistant
 	open(NEW, "> $name1");
 	close(NEW);
       };
     copy("$name1","$name2");
     # ecrire tableau ancien
     open(OLD,"$name2");
     @tableau_ancien = <OLD>;
     close(OLD);
     # recherche sur le net : geneanet
 #    @tableau = @{&recherche_geneanet_simple($patronyme)};
     @tableau = @{&recherche_geneanet($patronyme, $debut, $fin, $lieu, $sub, $reg, $pays, $source)};
     @tableau = @{&tronque_geneanet(\@tableau)};
     @tableau = @{&elimine_balise_html_geneanet(\@tableau)};
     #comparer ancien et nouveau avec traitement
     &traitement_ancien_nouveau(\@tableau_ancien,\@tableau,$patronyme,"geneanet");
     #ecrire tableau dans le fichier $patro_geneanet_new
     open(NEW, "> $name1");
     $sortie = select(NEW);
     print @tableau;
     select($sortie);
     close(NEW);
   }}

 
if ($moteur eq "" or $moteur eq "mormon") {
  foreach $ligne (@listenoms)
   {
     my($name1,$name2);
     my $sortie;
     my ($patronyme, $pays);
     if  ($ligne =~ /^(.*?)\s/)  {$patronyme = $1;} else {
       $ligne =~/^(.*?)$/; $patronyme = $1;}
     if ($ligne =~ /PAYS (.*?)(;|$)/) { $pays =$1;} else  { $pays ="";}
     if ($pays =~ /fra/i) {$pays="Fran96";}
	 elsif ($pays =~ /deu/i) {$pays="ge99";}
	 elsif ($pays =~ /che/i) {$pays="Swit96";}
	 elsif ($pays =~ /usa/i) {$pays="US912";}
     $name1="$patronyme" ."_mormon_new";
     $name2="$patronyme" ."_mormon_old";
     unless (-e "$name1") 
       {
 	# ecrire un fichier vide
 	open(NEW, "> $name1");
 	close(NEW);
       };
     copy("$name1","$name2");
     # ecrire tableau ancien
     open(OLD,"$name2");
     @tableau_ancien = <OLD>;
     close(OLD);
     # recherche sur le net : mormon
     @tableau = @{&recherche_mormon($patronyme, $pays)};
#     @tableau = @{&recherche_mormon_simple($patronyme)};
     @tableau = @{&tronque_mormon(\@tableau)};
     @tableau = @{&elimine_balise_html_mormon(\@tableau)};
     #comparer ancien et nouveau avec traitement
     &traitement_ancien_nouveau(\@tableau_ancien,\@tableau,$patronyme,"mormon");
     #ecrire tableau dans le fichier $patro_mormon_new
     open(NEW, "> $name1");
     $sortie = select(NEW);
     print @tableau;
     select($sortie);
     close(NEW);
   }
   }
print "Les résultats de la recherche se trouvent dans le fichier $fileresult\n";
close(RESULT); 

sub traitement_ancien_nouveau #(ancien,nouveau,patronyme,moteur)
  {
  my($patro, @tableau, $moteur);
  my $sortie;
  @tableau = @{&extrait_differences($_[0],$_[1])};
  $patro = $_[2];
  $moteur = $_[3];
  if  (@tableau == 0)
    {
      $sortie = select(RESULT);
      print "Les informations du moteur $moteur concernant le patronyme $patro N'ont PAS changé\n";
      select($sortie);
    }
  else
    {
      $sortie = select(RESULT);
      print "Les changements concernant le patronyme " .
	"$patro sur le moteur $moteur sont les suivants :\n";
      print @tableau;
      select($sortie);
    }
}

sub compare_simple # teste juste si les fichiers sont egaux : plus utilisee
{
    my ($tab1,$tab2)=@_;
    my($i);
    if (@$tab1 == @$tab2)
{
    for ($i=0; $i <= $#$tab1 ; $i++)
{
    if   ($$tab1[$i] ne $$tab2[$i]) {return "0";}
}
    return "1";
}
else 
{
    return "0";
}
}

sub extrait_differences #sort les lignes nouvelles (ancien, nouveau)
  {
  my ($tab1,$tab2) = @_;
  my($objet);
  my (%vu_dans_ancien, @que_dans_nouveau);
  @vu_dans_ancien{@$tab1} = ();
  foreach $objet (@$tab2) {
    push (@que_dans_nouveau, $objet) unless exists $vu_dans_ancien{$objet};
  }
  return \@que_dans_nouveau;
  }

sub tronque_geneanet #tronque le fichier html en lignes du tableau html
{
    my ($tab)=@_;
    my ($i , $i_debut , $i_fin);
    my @nouveau_tableau;
    $i_debut = -1;
    for($i = 0; $i < @$tab ; $i++) {
      if ($$tab[$i] =~ /<TABLE/){# $tab->[$i] = ....
	$i_debut=$i;
	last;
      }
    }
    if ($i_debut != -1) {
      for($i = $i_debut; $i < @$tab ; $i++) {
	if ($$tab[$i] =~ /<\/TABLE>/ ){
	  $i_fin=$i;
	  last;
	}
      }
      @nouveau_tableau= @$tab[$i_debut+1..$i_fin-1];
      return \@nouveau_tableau;
    }
    else {
      @nouveau_tableau=("");
      return \@nouveau_tableau;
    };
}

sub elimine_balise_html_geneanet#elimine les balises tr et td du tableau html (tableau)
  {
    my($tab)=@_;
    my $ligne;
    foreach $ligne (@$tab) {
      $ligne =~ s/<TR>(.*)<\/TR>/$1/;
      $ligne =~ s/<TD>(.*?)<\/TD>/$1 /g;
      $ligne =~ s/<A HREF="(.*)">(.*)<\/A>/$2 http:\/\/www.geneanet.com$1/;
    }
    if (@$tab == 100) {
      $ligne = "Cette liste contient 100 lignes, faire une recherche plus fine\n";
      push (@$tab , $ligne);
    }
    return $tab;
  }


sub tronque_mormon # tronque le fichier html en lignes du tableau html
{
    my ($tab)=@_;
    my ($i , $i_debut , $i_fin);
    my @nouveau_tableau;
    $i_debut = -1;
    for($i = 0; $i < @$tab ; $i++) {
      if ($$tab[$i] =~ /<td valign=top><strong>\d+\.<\/strong>/) {
	$i_debut=$i;
	last;
      }
    }
    if ($i_debut != -1) {
      for($i = $i_debut; $i < @$tab ; $i++) {
	if ($$tab[$i] =~ /<\/table>/ ){
	  $i_fin=$i;
	  last;
	}
      }
      @nouveau_tableau= @$tab[$i_debut..$i_fin-1];
      return \@nouveau_tableau;
    }
    else {
      @nouveau_tableau=("");
      return \@nouveau_tableau;
    };
}

sub elimine_balise_html_mormon # elimine les balises html (tableau)
  { 
    my($tab)=@_;
    my ($ligne, $ligne_intermediaire, @nouveau_tableau, $i);
    for ( $i=0 ; $i < @$tab ; $i++) {
      if ($$tab[$i] =~ /<td valign=top><strong>\d+\.<\/strong>/) {
	chop ($$tab[$i]);
	$ligne_intermediaire = $$tab[$i];
	$i++;
	while ($$tab[$i] !~ /<td valign=top align=left><\/td><\/tr>/) {
	  chop ($$tab[$i]);
	  $ligne_intermediaire = $ligne_intermediaire . $$tab[$i];
	  $i++;
	}
	if ($ligne_intermediaire =~ /Web Sites/) {
	$ligne_intermediaire =~ s/^(.*?)<a href='(.*?)'>(.*?)<\/a>(.*?)<small>(.*?)<\/small><br>(.*?)<br>(.*?)$/$3 $5 $6 $2/; 
	}
	else {
	$ligne_intermediaire =~ s/^(.*?)<a href='(.*?)'>(.*?)<\/a>(.*?)<small>(.*?)<\/small><br>(.*?)<br>(.*?)$/$3 $5 $6 http:\/\/www.familysearch.com\/Search\/$2/; 
      }
	$ligne_intermediaire = $ligne_intermediaire ."\n";
	push(@nouveau_tableau, $ligne_intermediaire);
      }
    }
    return \@nouveau_tableau;
  }

sub recherche_page_web # recherche le source web (remote,repertoire,port)
  {
    my ($remote, $dir, $port, $iaddr, $paddr, $proto, $ligne);
    my @tableau;

    $remote = shift || 'localhost';
    $dir = shift || "/";
    $port = shift || 80;
    if ($port =~ /\D/) {
      $port = 80;
    }
    $iaddr = inet_aton ($remote) or die "Hôte absent : $remote";
    $paddr = sockaddr_in ($port, $iaddr);
    $proto = getprotobyname ('tcp');
    socket (SOCK, PF_INET, SOCK_STREAM, $proto) or die "Socket : $!";
    connect (SOCK, $paddr) or die "Connect : $!";
    print SOCK "GET $dir HTTP/1.0\r\n\r\n";
    flush SOCK;
    @tableau = <SOCK>;
    close (SOCK);
    return \@tableau;
  }

sub recherche_geneanet_simple # recherche sur geneanet  (patro) plus utilisee
  { 
    my ($patro, $remote, $dir, @tableau);
    $patro = shift ;
    $remote ="www.geneanet.com";
    $dir = "/cgi-bin/search.pl?name=$patro&language=fr&limit=100";
    print "Contacte www.geneanet.com pour recherche sur patronyme $patro.\n";
    @tableau = @{&recherche_page_web($remote, $dir)};
    return \@tableau;
  }
sub recherche_geneanet # recherche multicritere geneanet  (patro,etpatati)
  { 
    my ($patro, $debut, $fin, $lieu, $sub, $reg, $pays, $source);
    my ($remote, $dir, @tableau);
    $patro = shift ;
    $debut = shift;
    $fin = shift;
    $lieu = shift;
    $sub = shift;
    $reg = shift;
    $pays = shift;
    $source = shift;
    $remote ="www.geneanet.com";
    $dir = "/cgi-bin/search.pl?name=$patro&begin=$debut&end=$fin&place=$lieu&subregion=$sub&region=$reg&country=$pays&sourcename=$source&language=fr&limit=100";
    print "Contacte www.geneanet.com pour recherche sur patronyme $patro.\n";
    @tableau = @{&recherche_page_web($remote, $dir)};
    return \@tableau;
  }


sub recherche_mormon_simple #recherche sur mormon  (patro) plus utilisee
  { 
    my ($patro, $remote, $dir, @tableau);
    $patro = shift ;
    $remote ="www.familysearch.com";
    $dir = "/Search/ancestorsearchresults.asp?last_name=$patro";
    print "Contacte www.familysearch.com pour recherche sur patronyme $patro.\n";
    @tableau = @{&recherche_page_web($remote, $dir)};
    return \@tableau;
  }

sub recherche_mormon #recherche sur mormon  (patro,pays)
  { 
    my ($patro, $pays, $remote, $dir, @tableau);
    $patro = shift ;
    $pays = shift;
    $remote ="www.familysearch.com";
    $dir = "/Search/ancestorsearchresults.asp?last_name=$patro&juris1=$pays";
    print "Contacte www.familysearch.com pour recherche sur patronyme $patro.\n";
    @tableau = @{&recherche_page_web($remote, $dir)};
    return \@tableau;
  }
