#/usr/local/bin
#----------------------------------------------------------
use Tk;
use locale;
use LWP::Simple;
use Encode;
use HTML::Entities;
use Tk::NoteBook;
use Tk::SMListbox;
#----------------------------------------------------------
# definition interface
#----------------------------------------------------------
# creation de la fenetre principale
$mw= MainWindow->new;
$mw->title("ExtractURL");
#---------------------------------------------------------
my $cadreMenu = $mw->Frame->pack(-side => 'top',
			  -fill => 'both');
my $b_menu=$cadreMenu->Menubutton(-text => "File",
				  -tearoff => 0,
				  -relief => 'ridge',
				  -menuitems => [
						 ['command' => "ouvrir Fichier (txt)",
						 -command => \&lire_Fichier],
						 ['command' => "Charger URL",
						  -command => \&lire_url],
						 ['command' => "Charger FILE_URL",
						  -command => \&lire_file_url],
						 ['command' => "URL vers txt",
						  -command => \&url2txt],
						 ['command' => "FILE_URL vers FILE_txt",
						  -command => \&fileurl2txt],
						 ['command' => "Sauvegarder EDITOR",
						  -command => \&sauve_editor],
						 ['command' => "Search",
						  -command => \&search_in_editor],
						 ['command' => "Exit",
						  -command =>  sub {exit;}]])->pack(-side => 'left');
						  
my $b_menu=$cadreMenu->Menubutton(-text => "Syntax",
				  -tearoff => 0,
				  -relief => 'ridge',
				  -menuitems => [
						 ['command' => "Treetagger",
						 -command => \&lire_Tree],
						 ['command' => "Extraction de Patrons Det + Nom + Verbe",
						 -command => \&lire_Extract1],
						 ['command' => "Extraction de Patrons Nom + Adj",
						  -command => \&lire_Extract]])->pack(-side => 'left');

#---------------------------------------------------------
my $cadre = $mw->Frame->pack(-side => 'top',
			  -expand=>1,
			  -fill => 'both');
my $onglet=$cadre->NoteBook(-backpagecolor=> '#C0C0C0',
				-background=>'#2604FF', 
				-disabledforeground=>'black',
				-foreground=>'white', 
				-inactivebackground  => '#BFBFBF', #color for inactive tabs
				)->pack(-side=>'top',
					-expand=>1,
					-fill=>'both');

my $page1=$onglet->add("page1",-anchor=>'w',label=>'Edition-URL',-underline=>0);
my $page2=$onglet->add("page2",-anchor=>'w',label=>'Dictionnaire',-underline=>0);
my $page3=$onglet->add("page3",-anchor=>'w',label=>'Concordance',-underline=>0);
my $page4=$onglet->add("page4",-anchor=>'w',label=>'Rapport sur URL',-underline=>0);
my $page5=$onglet->add("page5",-anchor=>'w',label=>'Treetagger',-underline=>0);
my $page6=$onglet->add("page6",-anchor=>'w',label=>'Extraction Patrons',-underline=>0);
#------------------------------------------------------------
# interface de la page 1 : edition d' URL...
#------------------------------------------------------------
my $cadreP1=$page1->Frame(-borderwidth => '2', -relief => 'groove')->pack(-side => 'top', -fill => 'both',-expand=>'0');
$cadreP1->configure(-background => 'black');
my $cadreP2=$page1->Frame(-borderwidth => '2', -relief => 'groove')->pack(-side => 'top', -fill => 'both',-expand=>'1');
$cadreP2->configure(-background => 'black');
my $cadreP2b=$page1->Frame(-borderwidth => '2', -relief => 'groove')->pack(-side => 'top', -fill => 'both',-expand=>'0');
$cadreP2b->configure(-background => 'black');
my $cadreP3=$page1->Frame(-borderwidth => '2', -relief => 'groove')->pack(-side => 'top', -fill => 'both',-expand=>'0');
$cadreP3->configure(-background => 'black');

$cadreP1->Label(-text => "URL : ",
    	      -relief => 'raised')->pack(-side => 'left',
						  -anchor => 'w');
$cadreP1->Entry(-textvariable => \$url)->pack(-side => 'left',
						-anchor => 'w',
						-fill => 'x',
						-expand => 1);
$cadreP1->Button(-text => "Load-URL",
	       -command => sub {&lire_url})->pack(-side => 'left',
						   -anchor => 'e');
$cadreP1->Button(-text => "URL2txt",
	       -command => sub {&url2txt})->pack(-side => 'left',
						   -anchor => 'e');
#--------- Editeur fenetre principale ---------------
$editortexte = $cadreP2->Scrolled("Text")->pack(-side => 'bottom',
				      -fill => 'both',
				      -expand => 1);
$editortexte->Text(-setgrid => 'true');
$search_string = '';
$w_string = $cadreP2b->Frame()->pack(-side => 'top', -fill => 'x');
$w_string_label = $w_string->Label(-text => 'Search string:', -width => 13, -anchor => 'w');
$w_string_entry = $w_string->Entry(-textvariable => \$search_string);
$w_string_button = $w_string->Button(-text => 'Highlight');
$w_string_label->pack(-side => 'left');
$w_string_entry->pack(-side => 'left');
$w_string_button->pack(-side => 'left', -pady => 5, -padx => 10);
$w_string->pack(-side => 'top', -fill => 'x');
$w_string_button->configure(-command => [sub {&text_search($editortexte, $search_string, 'search')}, $editortexte]);
$w_string_entry->bind('<Return>' => [sub {shift; &text_search($editortexte, $search_string, 'search')}, $editortexte]);
$w_string->pack(-side => 'top', -fill => 'x');
if ($mw->depth > 1) {
	text_toggle($editortexte, ['configure', 'search', -background => 'SeaGreen4', -foreground => 'white'], 800,
		          ['configure', 'search', -background => undef,       -foreground => undef],   200);
      } else {
	text_toggle($editortexte, ['configure', 'search', -background => 'black',     -foreground => 'white'], 800,
		          ['configure', 'search', -background => undef,       -foreground => undef],   200);
      }
#-----------------------------------------------------
$cadreP3->Button(-text => "Exit",
	       -command => sub {exit;})->pack(-side => 'right');
$cadreP3->Button(-text => "Save",
	       -command => sub {&sauve_fic})->pack(-side => 'right',
						   -anchor => 'e');
$cadreP3->Label(-textvariable => \$info,
	   -relief => 'ridge')->pack(-side => 'bottom',
				     -fill => 'x');
#---------------------------------------------------------------
# il faudra créer les contenus des autres pages...
my $cadreGGGGGGGGGGG=$page2->Frame (-borderwidth=>'2',-relief=>'groove')->pack(-side=>'top',-fill=>'both',-expand=>'1');
$cadreGGGGGGGGGGG->configure (-background=>'black');

my $dicoG=$cadreGGGGGGGGGGG->Frame (-borderwidth=>'0',-relief=>'groove')->pack(-side=>'left',-fill=>'both',-expand=>'0');
$dicoG->configure (-background=>'black');

my $dicoD=$cadreGGGGGGGGGGG->Frame (-borderwidth=>'0',-relief=>'groove')->pack(-side=>'left',-fill=>'both',-expand=>'1');
$dicoD->configure (-background=>'black');

my$cadretitre=$dicoG->Frame (-height=>'1',-width=>'30')->pack(-side=>'top');
my $labeldico=$cadretitre->Label (-text=>"Dictionnaire",-background=>'black',-foreground=>'white',-height=>2,-width=>20)->pack(-side=>'top',-padx=>5,-pady=>5);
$labeldico->configure (-background=> 'black');

$dicoG->Button (-text=>"Concordance",-background=>'black',-foreground=>'white',-command=> sub {&concordance})->pack(-side=>'top',-padx=>5,-pady=>5);

$editortextetemporaire = $cadreGGGGGGGGGGG-> Scrolled ('SMListbox',
                -scrollbars => 'se',
				-height =>20,
				-width =>400,
				-relief => 'sunken',
				-sortable => 1,
				-selectmode => 'extended',
				-showallsortcolumns => 1,
				-takefocus => 1,
				-borderwidth => 1,
				-columns => [

                        [-text => 'Forme', -textwidth => 30, -fg=>'black',-bg=>'white',-comparecommand => sub { $_[1] cmp $_[0]}],
                        [-text => 'Fréquence', -width => 20, -fg=>'black',-bg=>'white', -comparecommand => sub { $_[1] <=> $_[0]}],


                ]

                )->pack(-side=>'top',

                                -expand => 'yes',
								-fill=>'both',
								-padx=>0,
								-pady=>0,

                );
my $listeconcordance=$page3-> Scrolled ('SMListbox',
                -scrollbars => 'se',
				-height =>12,
				-relief => 'sunken',
				-sortable => 1,
				-selectmode => 'extended',
				-showallsortcolumns => 1,
				-takefocus => 1,
				-borderwidth => 1,
				-columns => [

                        [-text => 'Contexte gauche', -textwidth => 20, -fg=>'black',-bg=>'white',-comparecommand => sub { $_[1] cmp $_[0]}],
                        [-text => 'Pole', -width => 20, -fg=>'black',-bg=>'white', -comparecommand => sub { $_[1] <=> $_[0]}],
						[-text => 'Contexte Droit', -width => 20, -fg=>'black',-bg=>'white', -comparecommand => sub { $_[1] <=> $_[0]}],





                ]

                )->pack(-side=>'top',

                                -expand => 'yes',
								-fill=>'both',
								-padx=>0,
								-pady=>0,
								);
#---------------Treetagger----------------

my $cadretree=$page5->Frame (-borderwidth=>'2',-relief=>'groove')->pack(-side=>'bottom',-fill=>'both',-expand=>'1');
$cadretree->configure (-background=>'black');

$editortextetree = $cadretree-> Scrolled ("Text")->pack(-side=>'bottom',
								-fill=>'both',
								-expand=>1);
$editortextetree->Text(-setgrid=>'true');
#------------- Extraction Patrons ---------
my $cadreextract=$page6->Frame (-borderwidth=>'2',-relief=>'groove')->pack(-side=>'bottom',-fill=>'both',-expand=>'1');
$cadreextract->configure (-background=>'black');

$editortexteextract= $cadreextract-> Scrolled ("Text")->pack(-side=>'bottom',
								-fill=>'both',
								-expand=>1);
$editortexteextract->Text(-setgrid=>'true');

#.......
#.......
#.......
#---------------------------------------------------------------
MainLoop;
#---------------------------------------------------------------
#---------------------Procédures------------------------------
#---------------------------------------------------------------
sub lire_url {
    $info="Chargement $url...";
    $editortexte->delete("1.0","end");

    my $page = get( $url );

    if ( not defined( $page ) ){
	print "Problème lors du téléchargement !\n";
    }

    $editortexte->insert("end",$page);

    $info = "$url chargée.";
}
#----------------------------------------------------------------
sub makedico {
	my ($texteasegmenter)=@_;
	my @listedemots=split(/\W+/,$texteasegmenter);
	my %dico=();
	foreach my $mot (@listedemots){
		if (exists($dico{$mot})){
			$dico{$mot}++;
		}
		else {
			$dico{$mot}=1;
			}
		}
	foreach my $mot (sort keys %dico){
	
            $editortextetemporaire->insert ("end",[$mot,$dico{$mot}]);
	}
}
	
sub url2txt {
    $editortexte->delete("1.0","end");
    my $page = get( $url );
    if ( not defined($page) ){
	die "Problème lors du téléchargement !\n";
    }
    my $codage_page = "latin1";
    if ($page =~ /\bcharset\s*=\s*([\w-]+)/i) {
	$codage_page = $1;
	eval { decode ($codage_page, "test") };
	if ( defined ($@) ) {
	    $codage_page = "latin1";
	}
    }
    my $page_unicode = decode( $codage_page, $page );
    my $texte_unicode = supprime_html( $page_unicode );
    my $texte = normalise_latin1( $texte_unicode );
    $editortexte->insert("end",$texte);
	&makedico ($texte);
	
    #-------------------------------------------------------------
    sub supprime_html { 
	my @balises_a_ignorer =
	    ("applet","code","embed","head","object","script","server");
	
	my $html = shift @_; 
	$html =~ s/\n+/ /g;
	$html =~ s/\r+/ /g;
	decode_entities($html);
	foreach my $balise (@balises_a_ignorer) {
	    $html=~s/<$balise.*?<\/$balise>//ig;
	}
	$html =~ s/<!--.*?-->//g;     #commentaires
	$html =~ s/<\/?p\/?>/\n/ig;   #paragraphes
	$html =~ s/<br\/?>/\n/ig;     #retours à la ligne
	$html =~ s/<\/tr>/\n/ig;      #lignes de tableau
	$html =~ s/<\/?h[1-6]>/\n/ig; #titres
	$html =~ s/<\/?div.*?>/\n/ig; #sections
	$html =~ s/<.*?>//g;          #autres balises
	$html =~ s/\s*\n\s*/\n/g;     #espaces en début/fin de ligne
	$html =~ s/ +/ /g;            #séquences de plusieurs espaces  
	return $html;
    }
    sub normalise_latin1 {
	my $chaine = shift @_;
	$chaine =~ s/[\x{2019}\x{2018}]/\'/g;
	$chaine =~ s/[\x{201C}\x{201D}]/\"/g;
	$chaine =~ s/[\x{2013}\x{2014}]/-/g;
	$chaine =~ s/\x{2026}/.../g;
	$chaine =~ s/\x{0152}/OE/g;
	$chaine =~ s/\x{0153}/oe/g;
	$chaine =~ s/[^\x{0000}-\x{00FF}]//g;
	return $chaine;
    }
}
#---------------------------------------------------------------
sub sauve_fic {
    
    $info="Sauvegarde du fichier RESULTAT.txt...";
    $nom_fic="RESULTAT.txt";
    open(FIC,">$nom_fic");
    print FIC $editortexte->get("1.0","end");
    $info= "Fichier '$nom_fic' sauvegardé.";
}
#---------------------------------------------------------------
sub search_in_fic {
    
    $info="Recherche dans le fichier...";
    &text_search($editortexte, $search_string, 'search');
    if ($mw->depth > 1) {
	text_toggle($editortexte, ['configure', 'search', -background => 'SeaGreen4', -foreground => 'white'], 800,
		          ['configure', 'search', -background => undef,       -foreground => undef],   200);
      } else {
	text_toggle($editortexte, ['configure', 'search', -background => 'black',     -foreground => 'white'], 800,
		          ['configure', 'search', -background => undef,       -foreground => undef],   200);
      }

    $info= "Recherche dans Fichier terminée.";
}
#---------------------------------------------------------------
sub text_search {

    # The utility procedure below searches for all instances of a given string in a text widget and applies a given tag
    # to each instance found.
    # Arguments:
    #
# w -	The window in which to search.  Must be a text widget.
    # string -	The string to search for. (regexp and so on...)
    # tag -	Tag to apply to each instance of a matching string.

    my($w, $string, $tag) = @_;

    $w->tag('remove',  $tag, '0.0', 'end');
    (my $num_lines) = $w->index('end') =~ /(\d*)\.\d*/;
    for($i = 1; $i <=$num_lines; $i++) {
	my $line = $w->get("${i}.0", "${i}.1000");
	next if not defined $line or $line !~ /($string)/;
        my $l = length $1;
	$stringRegexp=$1;
	my $offset = 0;
	while (1) {
	    my $tmpoffset=0;
	    my $index = index $line, $stringRegexp, $tmpoffset;
	    last if $index == -1;
	    $offset += $index;
	    $w->tag('add', $tag, sprintf("%d.%d", $i, $offset), sprintf("%d.%d", $i, $offset+$l));
	    $offset += $l;
	    $line = substr $line, $index+$l;
	    if ($line=~/($string)/) { $stringRegexp=$1;
				      $l = length $1;}
	} # whilend
    } # forend

} # end text_search
#---------------------------------------------------------------
sub text_toggle {
    # The procedure below is invoked repeatedly to invoke two commands at periodic intervals.  It normally reschedules itself
    # after each execution but if an error occurs (e.g. because the window was deleted) then it doesn't reschedule itself.
    # Arguments:
    #
    # w -       Text widget reference.
    # cmd1 -	Reference to a list of tag options.
    # sleep1 -	Ms to sleep after executing cmd1 before executing cmd2.
    # cmd2 -	Reference to a list of tag options.
    # sleep2 -	Ms to sleep after executing cmd2 before executing cmd1 again.
    my($w, $cmd1, $sleep1, $cmd2, $sleep2) = @_;
# return if not Exists $w;
    $w->tag(@{$cmd1});
    $w->after($sleep1, [sub {text_toggle(@_)}, $w, $cmd2, $sleep2, $cmd1, $sleep1]);
} # end text_toggle
sub concordance {
	my @selection =$editortextetemporaire->curselection();
	if ($#selection eq -1) {
	return;
	}
	my @listeitem=();
	my $texte=$editortexte->get("1.0",'end');
	#getrow renvoie les différentes colonnes donc ici ça renvoie le mot avec sa fréquence.
	#ensuite on selectionne le premier élement.
	for (my $sel=0;$sel<=$#selection;$sel++){
	my @formes=$editortextetemporaire->getRow($selection[$sel]);
	my $forme=$formes[0];
	print $forme,"\n";
	push (@listeitem,$forme);
	}
	#my $texte=$editortexte->get("1.0",'end');
	my $nombredemotsagarderdanslecontexte=5;
	
	foreach my $motif (@listeitem) {
		# on lance la concordance du $motif sur $texte
		while ($texte=~/\b$motif\b/gi){
			my $pole=$&;
			my $contextegauche=$`;
			my $contextedroite=$';
			$contextedroite=~s/^ +//;
			my @GAUCHE=split (/\W+/,$contextegauche);
			my @DROITE=split (/\W+/,$contextedroite);
			my $tmpdroit="";
			for ($i=0;$i<=$nombredemotsagarderdanslecontexte-1;$i++){
				$tmpdroit.=" ".$DROITE[$i-1];
			}
			@GAUCHE=reverse(@GAUCHE);
			my $tmpgauche="";
			for ($i=0;$i<=$nombredemotsagarderdanslecontexte-1;$i++){
				$tmpgauche=$GAUCHE[$i]." ".$tmpgauche;
			}
			$listeconcordance->insert ('end',[$tmpgauche,$pole,$tmpdroit]);
		}
	}
	$onglet->raise('page3');
}
#----------------------Lire Fichier ---------------------------

sub lire_Fichier {
	my $types=[
			['Text Files',['.txt','.dic','.par']],
			['All Files', ['.*']]
			];
			
			
	my $tmp_nom_source=$mw->getOpenFile (-filetypes=>$types);
	print $tmp_nom_source,"\n";
	if ($tmp_nom_source=~/^$/){
	return;
	}
	my $texte="";
	$url=$tmp_nom_source;
	open (TMP,$tmp_nom_source);
	while (<TMP>){
	$texte.=$_;
	}
	close (TMP);
	$editortexte->delete ("1.0","end");
	$editortexte->insert ("end",$texte);
	&makedico($texte);
}

sub lire_Tree {
	my $textetree=$editortexte->get ("1.0","end");
	open (FILETMP,">textetreetagger.txt");
	print FILETMP $textetree;
	close (FILETMP);
	system ("perl tokenise-fr.pl textetreetagger.txt | tree-tagger.exe -token -lemma french.par > textetreetagger2.txt");
	#mettre au format xml
	system ("perl treetagger2xml.pl textetreetagger2.txt");
	#lire les résultats
	my $texte="";
	open (TMP,"textetreetagger2.txt.xml");
	while (<TMP>) {
	$texte.=$_;
	}
	close(TMP);
	$editortextetree->delete("1.0","end");
	$editortextetree->insert("end",$texte);
	$onglet->raise('page5');
	
	}
	
sub lire_Extract {
	$editortexteextract->delete("1.0","end");
	my $texteentreeextract=$editortextetree->get ("1.0","end");
	open (FILE,">textetreetagger2.txt");
	print FILE $texteentreeextract,"\n";
	close (FILE);
	open (FILE,"textetreetagger2.txt");
	my @lignes=<FILE>;
	close(FILE);
	while (@lignes) {
		my $ligne=shift(@lignes);
		chomp $ligne;
		my $sequence="";
		my $longueur=0;
		if ( $ligne =~ /<element><data type=\"type\">NOM<\/data><data type=\"lemma\">[^<]+<\/data><data type=\"string\">([^<]+)<\/data><\/element>/) {
			my $forme=$1;
		$sequence.=$forme;
		$longueur=1;
		my $nextligne=$lignes[0];
		if ( $nextligne =~ /<element><data type=\"type\">ADJ<\/data><data type=\"lemma\">[^<]+<\/data><data type=\"string\">([^<]+)<\/data><\/element>/) {
			my $forme=$1;
			$sequence.=" ".$forme;
			$longueur=2;
		}
	}
    if ($longueur == 2) {
	
	$editortexteextract->insert("end", "$sequence \n");
    }
}
$onglet->raise('page6');
}

sub lire_Extract1 {
	$editortexteextract->delete("1.0","end");
	my $texteentreeextract=$editortextetree->get ("1.0","end");
	open (FILE,">textetreetagger2.txt");
	print FILE $texteentreeextract,"\n";
	close (FILE);
	open (FILE,"textetreetagger2.txt");
	my @lignes=<FILE>;
	close(FILE);
	while (@lignes) {
		my $ligne=shift(@lignes);
		chomp $ligne;
		my $sequence="";
		my $longueur=0;
		if ( $ligne =~ /<element><data type=\"type\">DET:.*<\/data><data type=\"lemma\">[^<]+<\/data><data type=\"string\">([^<]+)<\/data><\/element>/) {
			my $forme=$1;
			$sequence.=$forme;
			$longueur=1;
			my $nextligne=$lignes[0];
		
			if ( $nextligne =~ /<element><data type=\"type\">NOM<\/data><data type=\"lemma\">[^<]+<\/data><data type=\"string\">([^<]+)<\/data><\/element>/) {
				my $forme=$1;
				$sequence.=" ".$forme;
				$longueur=2;
				my $nextligne1=$lignes[1];
			
				if ( $nextligne1=~ /<element><data type=\"type\">VER:.*<\/data><data type=\"lemma\">[^<]+<\/data><data type=\"string\">([^<]+)<\/data><\/element>/) {
					my $forme=$1;
					$sequence.=" ".$forme;
					$longueur=3;
				}
			}
			if ($longueur == 3) {
				$editortexteextract->insert("end", "$sequence \n");
			}
		}
$onglet->raise('page6');
}
}