#/usr/local/bin #---------------------------------------------------------- use Tk; use locale; use LWP::Simple; use Encode; use HTML::Entities; use Tk::NoteBook; use Tk::SMListbox; use Win32::Process; #---------------------------------------------------------- # definition interface #---------------------------------------------------------- # creation de la fenetre principale $mw= MainWindow->new; $mw->title("Extraire une URL ou un fichier"); #--------------------------------------------------------- # je crée un nouveux frame, celui qui va contenir l'ensemble des objets # Nous avons deux menus dans la fenetre graphique qui s'intitulent: Fichier et Syntaxe my $cadreMenu = $mw->Frame->pack(-side => 'top', -fill => 'x'); #On crée le premier menu qui contient: Ouvrir un fichier, Sauvegarder l'éditeur et Sortie my $b_menu=$cadreMenu->Menubutton(-text => "Fichier", -tearoff => 0, -relief => 'groove', -background => 'blue', -activebackground => 'red', -foreground => 'white', -menuitems => [ ['command' => "Ouvrir un fichier txt", -background => 'red', -command => \&lire_File], ['command' => "Sauvegarder l'editeur", -background => 'red', -command => \&sauve_fic], ['command' => "Sortie", -background => 'red', -command => sub {exit;}]])->pack(-side => 'left' ); # On crée le deuxième menu qui contient: Tretagger (en Francais) et Extraire les patrons syntaxiques my $b_menu2=$cadreMenu->Menubutton(-text => "Syntaxe", -tearoff => 0, -relief => 'groove', -background => 'blue', -activebackground => 'red', -foreground => 'white', -menuitems => [ ['command' => "treetagger(en Francais)", -background => 'red', -command => \&loadtreetagger], ['command' => "Extraire les patrons syntaxiques", -background => 'red', -command => \&loadextractiontreetagger], ])->pack(-side => 'left'); #--------------------------------------------------------- my $cadre = $mw->Frame->pack(-side => 'top', -fill => 'both'); my $onglet=$cadre->NoteBook(-backpagecolor=> 'blue', -background=>'white', -disabledforeground=>'blue', -foreground=>'red', -inactivebackground => 'blue', #color for inactive tabs )->pack(-side=>'top', -expand=>1, -fill=>'both'); #Ici, on peut créer des onglets dans la fenêtre graphique. On a donc 6 onglets 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 pattron',-underline=>0); #------------------------------------------------------------ # interface de la page 1 : edition d' URL... #------------------------------------------------------------ #nous créons un nouveau cadre qui renvoie à l'édition de l'url my $cadreP1=$page1->Frame(-borderwidth => '10', -relief => 'groove')->pack(-side => 'top', -fill => 'both',-expand=>'1'); $cadreP1->configure(-background => 'blue'); my $cadreP2=$page1->Frame(-borderwidth => '10', -relief => 'groove')->pack(-side => 'top', -fill => 'both',-expand=>'1'); $cadreP2->configure(-background => 'blue'); my $cadreP2b=$page1->Frame(-borderwidth => '10', -relief => 'groove')->pack(-side => 'top', -fill => 'both',-expand=>'1'); $cadreP2b->configure(-background => 'blue'); my $cadreP3=$page1->Frame(-borderwidth => '10', -relief => 'groove')->pack(-side => 'top', -fill => 'both',-expand=>'1'); $cadreP3->configure(-background => 'blue'); $cadreP1->Label(-text => "URL : ", -background => 'red', -foreground=> 'white', -relief => 'raised')->pack(-side => 'left', -anchor => 'w'); $cadreP1->Entry(-textvariable => \$url)->pack(-side => 'left', -anchor => 'w', -fill => 'x', -expand => 1 ); $cadreP1->Button(-text => "Telecharger URL",-background => 'red', -foreground=> 'white', -command => sub {&lire_url})->pack(-side => 'left', -anchor => 'e'); $cadreP1->Button(-text => "URL a txt", -background => 'red', -foreground=> 'white', -command => sub {&url2txt})->pack(-side => 'left', -anchor => 'e'); #--------- Editeur fenetre principale --------------- #Ici on crée un éditeur de texte #Les ascenseurs sont crées sur le côté gauche et bas $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 => 'Recherche mot:', -width => 13,-background => 'red', -foreground=> 'white', -anchor => 'w'); $w_string_entry = $w_string->Entry(-textvariable => \$search_string); $w_string_button = $w_string->Button(-text => 'OK', -background => 'red', -foreground=> 'white'); $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('' => [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 => 'blue', -foreground => 'white'], 800, ['configure', 'search', -background => undef, -foreground => undef], 200); } else { text_toggle($editortexte, ['configure', 'search', -background => 'blue', -foreground => 'red'], 800, ['configure', 'search', -background => undef, -foreground => undef], 200); } #----------------------------------------------------- #on crée un nouveau cadre qui se retrouvera en bas de la fenêtre graphique $cadreP3->Button(-text => "Sortie", -background => 'red', -foreground=> 'white', -command => sub {exit;})->pack(-side => 'right'); $cadreP3->Button(-text => "Sauvegarder", -background => 'red', -foreground=> 'white', -command => sub {&sauve_fic})->pack(-side => 'right', -anchor => 'e'); $cadreP3->Label(-text=> 'SOUHAITEZ VOUS :', -relief => 'ridge', -background => 'red', -foreground=> 'white')->pack(-side =>'left', -fill => 'x'); #--------------------------------------------------------------- #Ici, on a la création de la page 2: my $cadrePeeeee=$page2->Frame(-borderwidth => '10', -background =>'blue', -relief => 'groove')->pack(-side => 'top', -fill => 'both',-expand=>'1'); $cadrePeeeee->configure(-background =>'blue'); # Il y a 2 frames pour organiser les 2 parties de la fenêtre my $dicoG=$cadrePeeeee->Frame(-borderwidth => '0', -relief => 'groove')->pack(-side => 'left', -fill => 'both',-expand=>'0'); $dicoG->configure(-background =>'blue'); my $dicoD=$cadrePeeeee->Frame(-borderwidth => '0', -relief => 'groove')->pack(-side => 'left', -fill => 'both',-expand=>'1'); $dicoD->configure(-background =>'blue'); #on remplit le frame à gauche de la fenêtre graphique. On va faire apparaître un label appellé "Dictionnaire" et un bouton intitulé "Concordance" my $cadreTitre=$dicoG->Frame(-height=>'1',-width=>'40', -borderwidth => '10',)->pack(-side => 'top'); my $labelDico=$cadreTitre->Label(-text => "DICTIONNAIRE:", -background=>'pink', -foreground=>'red', -height=>4, -width=>25)->pack( -side => 'top',-padx => 5,-pady=>5 ); $labelDico->configure(-background => 'blue'); $cadreTitre->Button(-text => "Concordance", -background => 'blue', -foreground=>'white', -command => sub {&concordance})->pack( -side => 'bottom',-padx => 5,-pady=>5); # on met le smlistbox à droite de la fenêtre graphique $editortextetemporaire = $dicoD->Scrolled('SMListbox', -scrollbars => 'se', -height => 12, -relief => 'sunken', -sortable => 1, -selectmode => 'extended', -showallsortcolumns => 1, -takefocus => 1, -borderwidth => 1, -columns => [ [-text => 'Forme', -background => 'white', -foreground => 'blue', -width => 30, -comparecommand => sub { $_[1] cmp $_[0]}], [-text => 'Fréquence',-background => 'red',-foreground => 'white', -width => 30, -comparecommand => sub { $_[1] <=> $_[0]}], ] )->pack( -expand => 'yes', -fill=>'both', -padx=>0, -pady=>0 ); #................................................................................... # Ici, on a la creation de la page 3: my$listeconcordance = $page3->Scrolled('SMListbox', -scrollbars => 'se', -height => 12, -relief => 'sunken', -sortable => 1, -selectmode => 'extended', -showallsortcolumns => 1, -takefocus => 1, -borderwidth => 10, -background => 'blue', # On aura la création de 3 colonnes appelées: contexte gauche, pole, et contexte droit -columns => [ [-text => 'CONTEXTE GAUCHE', -background => 'blue', -foreground => 'red', -width => 35, -comparecommand => sub { $_[1] cmp $_[0]}], [-text => 'POLE', -background => 'white', -foreground => 'blue', -width => 22, -comparecommand => sub { $_[1] <=> $_[0]}], [-text => 'CONTEXTE DROIT', -background => 'red', -foreground => 'white', -width => 35, -comparecommand => sub { $_[1] <=> $_[0]}], ] )->pack( -expand => 'yes', -fill=>'both', -padx=>0, -pady=>0 ); #.............................................................................................................................. # Ici, on a la création de la page 4: # Dans cette page, on fait apparaître un éditeur de texte appelé "editorrapport" my $cadreP4=$page4->Frame(-borderwidth => '10', -relief => 'groove', -background => 'blue')->pack(-side => 'top', -fill => 'both',-expand=>'1'); $cadreP4->configure(-background => 'blue'); $editorrapport = $cadreP4->Scrolled("Text")->pack(-side => 'bottom', -fill => 'both', -expand => 1); $editorrapport->Text(-setgrid => 'true'); #.............................................................................................................................. # Ici, on a la création de la page 5: # Dans cette page, on fait apparaître un éditeur de texte appelé "editortextetreetagger" my $cadreP5=$page5->Frame(-borderwidth => '10', -relief => 'groove', -background => 'blue')->pack(-side => 'top', -fill => 'both',-expand=>'1'); $cadreP5->configure(-background => 'blue'); $editortextetreetagger = $cadreP5->Scrolled("Text")->pack(-side => 'bottom', -fill => 'both', -expand => 1); $editortextetreetagger->Text(-setgrid => 'true'); #.............................................................................................................................. # Ici, on a la création de la page 6: # Dans cette page, on fait apparaître un éditeur de texte appelé "editortexteextraction" my $cadreP6=$page6->Frame(-borderwidth => '10', -relief => 'groove', -background => 'blue')->pack(-side => 'top', -fill => 'both',-expand=>'1'); $cadreP6->configure(-background => 'blue'); $editortexteextraction = $cadreP6->Scrolled("Text")->pack(-side => 'bottom', -fill => 'both', -expand => 1); $editortexteextraction->Text(-setgrid => 'true'); #---------------------------------------------------------------------------- MainLoop; #---------------------------------------------------------------------------- #--------Dans cette partie, on a les procédures------------------------------ #---------------------------------------------------------------------------- #---------------------------------------------------------------------------- #on cherche à faire une extraction de patron syntaxique pour les séquences ADJ_NOM: sub loadextractiontreetagger { # $editortextetreetagger contient le texte. #ce texte est stocké dans une variable $textetmp #avec la fonction get on parcourt le texte: de la ligne 1 jusqu'à la fin, "end" my $textetmp=$editortextetreetagger->get("1.0","end"); # il faut transformer $textetmp en @lignes avec la fonction split #le retour à la ligne va être le séparateur @lignes=split(/\n/,$textetmp); #tant qu'il y a des lignes, on les lit while (@lignes) { my $ligne=shift(@lignes); chomp $ligne; my $sequence=""; my $longueur=0; #On a une condition pour checher les séquences qui commencent par un nom if ( $ligne =~ /NOM<\/data>[^<]+<\/data>([^<]+)<\/data><\/element>/) { my $forme=$1; $sequence.=$forme; $longueur=1; my $nextligne=$lignes[0]; #On a une deuxième condition qui permetrait de chercher les séquences adjectifs après un nom if ( $nextligne =~ /ADJ<\/data>[^<]+<\/data>([^<]+)<\/data><\/element>/) { my $forme=$1; $sequence.=" ".$forme; $longueur=2; } } #si la longueur est de 2, on prend les lignes trouvées (c'est-à-dire les séquences NOM+ADJ) et on les insère dans l'éditeur "editortexteextraction" if ($longueur == 2) { $editortexteextraction->insert("end","$sequence \n"); } } #Les lignes trouvées sont affichés dans l'onglet de la page 6 #on ferme le fichier close(FILE); $onglet->raise('page6'); } #------------------------------------------------------------------------------ #Cette procédure permet d'insérer treetagger dans la fenêtre graphique sub loadtreetagger { #On lance la tokenisation my $texte=$editortexte->get ("1.0","end"); #On recupere le texte open (FILETMP,">toto.txt"); print FILETMP $texte; close (FILETMP); #Ici, on le coupe : 1 mot par ligne system("perl tokenise-fr.pl toto.txt > INPUTTREETAGGER.txt"); my $treetagger= "INPUTTREETAGGER.txt"; my $treetaggerout= "OUTPUTTTREETAGGER.txt"; my $liblangue= "french.par"; my $progname= "tree-tagger.exe"; my $commandetreetagger= "$progname $liblangue -lemma -token -sgml -no-unknown \"$treetagger\" \"$treetaggerout\""; Win32::Process::Create($Win32::Process::Create::ProcessObj, "tree-tagger.exe", $commandetreetagger, 0, NORMAL_PRIORITY_CLASS, "." ) or die Win32::FormatMessage(Win32::GetLastError() ),"\n"; $Win32::Process::Create::ProcessObj->Wait(INFINITE); #------------------------------------------------------------- #On met au format xml print "on passe a la suite... \n"; system("perl treetagger2xml.pl OUTPUTTTREETAGGER.txt"); #------------------------------------------------------------- #On lit les résultats maintenant my $texte=""; open (TMP,"OUTPUTTTREETAGGER.txt.xml"); while() { $texte.=$_; } close(TMP); #On insère les résultats dans l'éditeur "editortextetreetagger" dans l'onget de la page 5 $editortextetreetagger->delete("1.0","end"); $editortextetreetagger->insert("end",$texte); $onglet->raise('page5'); } #-------------------------------------------------------------------------------------- #Cette procédure permet de lire un fichier quelconque de type txt, dic ou par sub lire_File { my $types=[ ['Text Files', ['.txt','.dic','.par']], ['All File', ['.*']] ]; my $tmp_nom_source=$mw->getOpenFile(-filetype=>$types); print $tmp_nom_source,"\n"; if ( $tmp_nom_source=~/^$/){ return; } my $texte=""; $url= $tmp_nom_source; open (TMP,$tmp_nom_source); while(){ $texte.=$_; } close (TMP); #Le fichier lu sera insérer dans l'éditeur de texte appelé: editortexte $editortexte->delete("1.0","end"); $editortexte->insert("end",$texte); &makedico($texte); } #-------------------------------------------------------------------------------------- #Cette procédure permet de lire une url quelconque 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."; } #---------------------------------------------------------------------------------------- # Cette procédure sert à construire le dictionnaire d'une part et d'autre part à faire le rapport de l'url en indiquant #le nom du répertoire utilisé, le nombre de mots dans le texte, et la forme et la fréquence maximales dans le texte. sub makedico { #On définit 3 variables dont 2 sont des compteurs initialisés à 0 et 1 est une variable vide. my $nombredemots=0; my $freqmax=0; my $formemax=""; #on segmente le texte à l'aide la fonction split. Le séparateur de mots est: \W+. On obtient donc une liste de mots insérées dans un tableau #appelé "listedemots" my ($texteasegmenter)=@_; my @listedemots=split(/\W+/,$texteasegmenter); my %dico=(); #On regarde pour chaque mot dans la listedemots, si le mot existe dans le dictionnaire foreach my $mot (@listedemots) { #Si le mot existe alors on incrémente le dictionnaire if (exists($dico{$mot})){ $dico{$mot}++; } #Si le mot n'existe pas dans le dictionnaire, on lui rajoute la valeur 1 else{ $dico{$mot}=1; } #On a une autre condition: est ce que le mot est supérieur à la fréquencemax? if ($dico{$mot}>$freqmax) { #si c'est non, freqmax devient le mot $freqmax=$dico{$mot}; $formemax=$mot }; #on incrémente le nombre de mots $nombredemots++; } #Ici, on trie le dictionnaire et on insère les résultats dans les éditeurs de texte comme "editortextetemporaire" et "editorrapport". foreach my $mot (sort keys %dico){ $editortextetemporaire->insert("end",[$mot,$dico{$mot}]); } my $titrerapport="Nom de l'url: $url"; $editorrapport->insert("end",$titrerapport); $editorrapport->insert("end","Nombre de mot : $nombredemots \n"); $editorrapport->insert("end","Frequence Maximale : $freqmax \n"); $editorrapport->insert("end","Forme Maximale : $formemax \n"); } #---------------------------------------------------------------------------------------- #Cette procédure permet de faire fonctionner le bouton "url2txt" 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); #------------------------------------------------------------------------------------------------------------------------- #Cette procédure est en rapport avec la procédure précédente. Elle permet de nettoyer un texte, d'obtenir le texte brut d'une page web quand #l'utilisateur clique sur le bouton "url2txt". 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//\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; } } #------------------------------------------------------------------------------------------------------------------------- #Cette procédure permet de sauvegarder un fichier quand l'utlisateur clique sur le bouton "sauvegarder". 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é."; } #------------------------------------------------------------------------------------------------------------------------- #Cette procédure permet de chercher un mot dans le fichier 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."; } #------------------------------------------------------------------------------------------------------------------------- #Cette procédure permet de chercher un mot dans l'éditeur texte 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 #------------------------------------------------------------------------------------------------------------------------- #Cette procédure permet de faire une concordance dans le texte étudié. sub concordance { #Il recherche des motifs sélectionnés dans le dictionnaire et il vérifie que l'utilisateur a selectionné quelque chose my @selection= $editortextetemporaire->curselection(); if ($#selection eq -1){ return; } my @listeItem=(); for (my $sel=0; $sel <=$#selection; $sel++){ my @formes=$editortextetemporaire->getRow($selection[$sel]); my $forme=$formes[0]; print $forme,"\n"; push (@listeItem,$forme); } #On récupère dans l'editortextetemporaire, le contenu grâce à la fonction "get" my $texte=$editortexte->get ("1.0","end"); my $nbmotscontextes=10; #On donne le contexte gauche et le contexte droit des motifs selectionnés par l'utilisateur foreach my $motif(@listeItem){ while ($texte=~/\b$motif\b/gi) { my @gauche=split(/[\W]+/,$`); my $pole=$&; my $droite=$'; $droite=~s/^ +//; my @droite=split(/[\W]+/,$droite); my $d=""; my $g=""; for (my $i=1;$i<=$nbmotscontextes;$i++) { $d.=" ".$droite[$i-1]; $g = $gauche[$#gauche-$i+1]." ".$g; } #On insère les résultats dans la page 3 $listeconcordance->insert('end',[$g,$pole,$d]); $cptfq++; } } $onglet=>raise('page3'); }