#/usr/local/bin
#----------------------------------------------------------
use Tk;
use locale;
use LWP::Simple;
use Encode;
use HTML::Entities;
use Tk::NoteBook;
#----------------------------------------------------------
# definition interface
#----------------------------------------------------------
# creation de la fenetre principale
$mw= MainWindow->new;
$mw->title("ExtractURL");
#---------------------------------------------------------
my $cadreMenu = $mw->Frame->pack(-side => 'top',
			  -fill => 'x');
my $b_menu=$cadreMenu->Menubutton(-text => "File",
				  -tearoff => 0,
				  -relief => 'ridge',
				  -menuitems => [
						 ['command' => "load URL",
						  -command => \&lire_url],
						 ['command' => "load FILE_URL",
						  -command => \&lire_file_url],
						 ['command' => "URL to txt",
						  -command => \&url2txt],
						 ['command' => "FILE_URL to FILE_txt",
						  -command => \&fileurl2txt],
						 ['command' => "Save EDITOR",
						  -command => \&sauve_editor],
						 ['command' => "Search",
						  -command => \&search_in_editor],
						 ['command' => "Exit",
						  -command =>  sub {exit;}]])->pack(-side => 'left');

#---------------------------------------------------------
my $cadre = $mw->Frame->pack(-side => 'top',
			  -fill => 'x');
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);
#------------------------------------------------------------
# interface de la page 1 : edition d' URL...
#------------------------------------------------------------
my $cadreP1=$page1->Frame(-borderwidth => '2', -relief => 'groove')->pack(-side => 'top', -fill => 'both',-expand=>'1');
$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=>'1');
$cadreP2b->configure(-background => 'black');
my $cadreP3=$page1->Frame(-borderwidth => '2', -relief => 'groove')->pack(-side => 'top', -fill => 'both',-expand=>'1');
$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...
#.......
#.......
#.......
#.......
#.......
#.......
#.......
#.......
#---------------------------------------------------------------
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 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);
    #-------------------------------------------------------------
    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
#---------------------------------------------------------------
