Maraninchi Laetitia, maîtrise

Programmation en perl

 

  1. Sommaire
  2. 1 Sommaire *

    2 Programme qui compte les lignes d’un fichier (d’état quelconque) lu en entrée *

    2.1 Programme *

    3 Programme qui lit un état quelconque du corpus et compte le nombre de mots du fichier lu *

    3.1 Programme *

    3.2 Observations *

    4 Programme qui lit un corpus et construit un dictionnaire contenant toutes les formes graphiques *

    4.1 Programme *

    4.2 Explication du programme *

    5 Programme qui prend en entrée le fichier p96.bal et produit une version html de ce fichier, en laissant les noms des champs dans la version html produite *

    5.1 Programme *

    6 Modification du programme créant un index au format html de Rincon Rolland *

    6.1 Programme *

    6.2 Observations *

    7 Programmation objet en perl *

    7.1 Création d’un programme sur l’exemple du code " objet patient " *

    7.1.1 Création d’un package *

    7.1.2 Programme utilisant ce package *

    7.2 Programme Perl/Tk *

     

  3. Programme qui compte les lignes d’un fichier (d’état quelconque) lu en entrée
  4.  

    1. Programme

    #!/usr/bin/perl

    #compteligne.pl

    $NumLigne=0;

    READ: while(<>)

    {

    $NumLigne++;

    }

    print "Le nombre de lignes est : $NumLigne\n";

     

  5. Programme qui lit un état quelconque du corpus et compte le nombre de mots du fichier lu
    1. Programme
    2. #!/usr/local/bin/perl -w

      #CompteMots.pl

      $nbmots=0;

      $total=0;

      READ: while(<>)

      {

      chop($texte);

      # reduction des tabulations et espaces multiples à un espace.

      s/[\/\t]+/ /g;

      s/[ ]+/ /g;

      s/^ ([^ ])/$1/g;

      while (/ /g) {

      $nbmots++;

      $espaces{$1}++;

      }

      }

      $total=$nbmots + 1; # le dernier mot lu n'est pas suivi d'un espace

      print STDOUT "le nombre de mots est : $total\n";

       

    3. Observations

    -Un test a été effectué sur le fichier corpus.txt (programme de l'Action démocratique du Québec, le nombre de mots trouvés est de 10 371, et si on teste le même fichier avec l'outil statistique de word, le nombre de mots est de 10 631.

    -Compter les espaces pour connaître le nombre de mots, ne permet pas d'avoir le nombre exact de mots, cela marche bien à l'échelle d'une phrase mais lorsqu'il s'agit d'un texte ce système est moins performant.

    -Lorsqu'il y a un retour chariot, il n'a pas d'espace entre le mot de la ligne

    précédente et celui de la nouvelle ligne, comme dans l'exemple suivant :

    Concerts le 21 juin.

    Salle la Cigale.

    Le programme comptera 6 mots (5 espaces + 1), au lieu de 7.

    Ce qui explique le décalage avec le nombre de mots trouvé par word.

     

  6. Programme qui lit un corpus et construit un dictionnaire contenant toutes les formes graphiques
    1. Programme
    2. #!/usr/local/bin/perl

      #dictionnaire.pl

      open(DIC1, ">dico1.txt");

      $ligne=0;

      READ: while (<>)

      {

      next READ if (/^$/);

      s/[\/\t]+/ /g;

      s/[ ]+/ /g;

      s/^ ([^ ])/$1/g;

      s/<[^>]*>//g; #enleve les tags

      s/<[^>]*|[^<]*>//; #enleve les tags sur deux lignes

      s/&nbsp;//g;

      s/A//g;

      s/[0-9]//g;

      # élimination des éléments de ponctuation :

      s/[\$\.\-\%\:\?\!\<\>\)\(\[\]"\/;\{\}=\@\+\,]+/ /g;

      chop;

      $ligne++;

      $lignes[$ligne]=$_;

      @mots=split(/[' \t]+/);

      $taille=@mots;

      foreach $mot (@mots) {

      print DIC1 "$mot\n";

      for ($i=0; $i<$taille; $i++) {

      $j=$i+1;

      while ($j<$taille) {

      if ($mots[$i] eq $mots[$j])

      {

      $mots[$j]=$mots[$j+1]; }

      $j++;

      }

      }

      }

      }

      close (DIC1);

       

    3. Explication du programme

    -après un nettoyage du texte, le fichier est segmenté en mots et stocké dans un tableau. De façon à éliminer les doublons,  chaque élément du tableau est ensuite comparé à tous les autres éléments du tableau qui le suivent :

    if ($mots[$i] eq $mots[$j])

    {

    $mots[$j]=$mots[$j+1]; }

    -en effet si le mot est égal à l’un des autres mots qui le suivent dans le tableau, le mot auquel il est égal, reçoit une autre valeur (celle de l’élément qui le suit), et son ancienne valeur est ainsi éliminée (écrasée).

    -ce qui est intéressant avec cette méthode c’est qu’il y a création d’un seul fichier contenant les formes graphiques.

     

  7. Programme qui prend en entrée le fichier p96.bal et produit une version html de ce fichier, en laissant les noms des champs dans la version html produite
  8.  

    1. Programme

    #!/usr/local/bin/perl

    open (FILE, "p96.bal");

    @lignes=<FILE>;

    close (FILE);

    foreach $ligne (@lignes) {

    # Remplacement des tags pour qu’ils ne soient pas interprétés comme des # balises html

    $ligne=~s/</&lt;/g;

    $ligne=~s/>/&gt;/g;

    }

    #creation d'un autre fichier qui contiendra le contenu du document p96.bal + les balises élémentaires d'un document html

    $paragraphe="<p>";

    $html="<HTML><HEAD><TITLE>p96.html</TITLE></HEAD><BODY>";

    $htmlend="</BODY></HTML>";

    @lines=@lignes;

    open (FIC, ">p96.html");

    print FIC "$html\n";

    foreach $line (@lines) {

    if ($line=~/^&lt;FICHE&gt;/) {

    print FIC "$paragraphe\n"; #creation de paragraphe au format html

    }

    print FIC "$line\n";

    }

    print FIC "$htmlend\n";

    close (FIC);

  9. Modification du programme créant un index au format html de Rincon Rolland 
  10.  

    1. Programme
    2. #!/usr/local/bin/perl

      # Modification du fichier ind3html.pl de Rincon Rolland

      # création d'une fonction pour que les éléments de ponctuation et

      # les chiffres ne soient pas des liens et donc des éléments de l'index,

      # mais qu’ils apparaissent quand même dans le texte (fichier " corpus.html ", d’étiquette HTMLFIC) pour des raisons de lisibilité.

      # Par l’instruction : print HTMLFIC "$Mot"; ils ne sont pas mis en lien mais inscrit quand même dans le fichier.

      sub elimination_ponctuation {

      if ($Mot=~/[*!$\%&\,\:\.]|[0-9]/) {

      print HTMLFIC "$Mot";

      } else {

      print HTMLFIC "<A HREF=\"$NomFichier.ind.html#$Mot\">$Mot</A> ";

      unless ($IndexMot{$Mot} =~ /$NumLigne /)

      {

      $IndexMot{$Mot}=$IndexMot{$Mot}.$NumLigne." ";

      }

      }

      }

      # Programme principal

      $NumLigne = 0;

      $NomFichier = $ARGV[0];

      open(HTMLFIC,">$NomFichier.html");

      open(HTMLIND,">$NomFichier.ind.html");

      while(<>)

      {

      chop;

      $NumLigne++;

      $ligne = $_;

      s/[\(\)\[\]"]//g; # nettoyage

      # Suppression des points et isolement de certains caracteres pour en faire des mots dans un premier temps, mais qui n'apparaitront pas dans l'index.

      s/\./ \. /g;

      s/,/ ,/g;

      s/!/ !/g;

      s/:/ :/g;

      # Modification de la segmentation, car sinon le caractere de segmentation était considéré comme un mot qui apparaissait à toutes les lignes.

      @TableauMot = split();

      # numérotation en début de ligne seulement pour plus de lisibilité

      print HTMLFIC "<A NAME=\"$NumLigne\">$NumLigne</A> ";

      foreach $Mot (@TableauMot)

      {

      elimination_ponctuation();

      }

      print HTMLFIC "</A><P><P>\n";

      }

      close(HTMLFIC);

      @IndexMotTri = sort keys %IndexMot;

      foreach (@IndexMotTri)

      {

      @NumIndex = split(/ /,$IndexMot{$_});

      print HTMLIND "<B><A NAME=\"$_\">$_</A></B> ";

      foreach $Num (@NumIndex)

      {

      print HTMLIND " <A HREF=\"$NomFichier.html#$Num\">$Num</A>\n";

      }

      print HTMLIND "<BR>";

      }

       

    3. Observations

    -les modifications qui ont été faîtes concernent surtout des problèmes d’affichage et donc de lisibilité des documents créés.

    -en particulier dans l’index créé, qui contenait également les éléments de ponctuation et les chiffres, et qui contenait tous les numéros de ligne en lien au début du fichier (ce problème a été résolu par une modification de la segmentation, voir commentaires dans le programme).

     

  11. Programmation objet en perl
    1. Création d’un programme sur l’exemple du code " objet patient "
      1. Création d’un package
      2. Ce package est un fichier.pm qui se trouve dans le dossier perl créé lors de l’installation de perl, à l’adresse suivante : perl/site/lib

        Il n’apparaît pas dans le programme dans lequel il est utilisé.

        Ce programme annonce des dates de concert de groupes de musique, donne le style musical de ces groupes, le prix du concert, le nombre de places au départ, puis le nombre de places restantes.

        package groupe; # Déclaration du package

        sub new {

        my ($groupe, $nom, $style) = @_;

        my $groupe = {}; # Structure complexe

        $groupe->{nom} = $nom;

        $groupe->{style} = $style;

        return bless $groupe;

        }

        sub concert { # dates de concert

        my ($groupe, $concert, $prix, $nombre) = @_;

        $groupe->{concert} = $concert;

        $groupe->{prix} = $prix;

        $groupe->{nombre} = $nombre;

        }

        sub placesdisponibles { # indication du nombre de places restantes

        my ($groupe, $nvnombre) = @_;

        $groupe->{nombre} = $nvnombre;

        }

        sub affiche { # Affichage des informations

        my ($groupe) = @_;

        print "Concert du groupe $groupe->{nom} de $groupe->{style} le

        $groupe->{concert}, prix : $groupe->{prix}, nb places $groupe->{nombre}\n";

        }

        sub afficheplacesrestantes {

        my ($groupe) = @_;

        print "A ce jour, il reste $groupe->{nombre} places pour le concert de $groupe->{nom}\n";

        }

        sub DESTROY {

        my ($groupe) = @_;

        }

        1; # Une classe d'objet se termine toujours par 1;

         

      3. Programme utilisant ce package

      #!/bin/perl

      use groupe;

      $groupe1 = new groupe('silmarils','rock');

      $groupe2 = new groupe('NIN', 'gothique');

      $groupe1->concert('vendredi 30 juin', '120 Fr','500');

      $groupe1->affiche;

      $groupe1->placesdisponibles('80');

      $groupe1->afficheplacesrestantes;

      $groupe2->concert('samedi 1er juillet', '130 Fr','500');

      $groupe2->affiche;

      $groupe2->placesdisponibles('60');

      $groupe2->afficheplacesrestantes;

      # fin du programme, appel des destructeurs

       

    2. Programme Perl/Tk

#/usr/local/bin

use Tk;

$mw= MainWindow->new;

$mw->title("Recherche avec Expressions régulières");

 

$cadre = $mw->Frame->pack(-side => 'top',

-fill => 'x');

$b_menu=$cadre->Menubutton(-text => "File",

-tearoff => 0,

-relief => 'ridge',

-menuitems => [['command' => "load",

-command => \&lire_fic],

['command' => "Save",

-command => \&sauve_fic],

['command' => "Search",

-command => \&search_in_fic],

['command' => "Exit",

-command => sub {exit;}]])->pack(-side => 'left');

$cadre->Label(-text => "File : ",

-relief => 'raised')->pack(-side => 'left',

-anchor => 'w');

$cadre->Entry(-textvariable => \$nom_fic)->pack(-side => 'left',

-anchor => 'w',

-fill => 'x',

-expand => 1);

$cadre->Button(-text => "load",

-command => sub {&lire_fic})->pack(-side => 'left',

-anchor => 'e');

$texte = $mw->Scrolled("Text")->pack(-side => 'bottom',

-fill => 'both',

-expand => 1);

$texte->Text(-setgrid => 'true');

$search_string = '';

$w_string = $mw->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_buttonNew = $w_string->Button(-text => 'Concordance');

$w_string_label->pack(-side => 'left');

$w_string_entry->pack(-side => 'left');

$w_string_buttonNew->pack(-side => 'left', -pady => 5, -padx => 10);

$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($texte, $search_string, 'search')}, $texte]);

$w_string_buttonNew->configure(-command => [sub {&mkConcordanceOneWord2}, $texte]);

$w_string_entry->bind('<Return>' => [sub {shift; &text_search($texte, $search_string, 'search')}, $texte]);

$w_string->pack(-side => 'top', -fill => 'x');

if ($mw->depth > 1) {

text_toggle($texte, ['configure', 'search', -background => 'SeaGreen4', -foreground => 'white'], 800,

['configure', 'search', -background => undef, -foreground => undef], 200);

} else {

text_toggle($texte, ['configure', 'search', -background => 'black', -foreground => 'white'], 800,

['configure', 'search', -background => undef, -foreground => undef], 200);

}

 

$cadre->Button(-text => "Exit",

-command => sub {exit;})->pack(-side => 'right');

$cadre->Button(-text => "Save",

-command => sub {&sauve_fic})->pack(-side => 'right',

-anchor => 'e');

$mw->Label(-textvariable => \$info,

-relief => 'ridge')->pack(-side => 'bottom',

-fill => 'x');

MainLoop;

 

sub lire_fic {

$info="Chargement du fichier '$nom_fic'...";

$texte->delete("1.0","end");

if (!open(FIC,"$nom_fic")) {

$texte->insert("end","ERREUR : Impossible d\'ouvrir '$nom_fic'\n");

return;

}

while (<FIC>) {

$texte->insert("end",$_);

}

close(FIC);

$info = "Fichier '$nom_fic' chargé.";

}

sub sauve_fic {

$info="Sauvegarde du fichier '$nom_fic'...";

open(FIC,">$nom_fic");

print FIC $texte->get("1.0","end");

$info= "Fichier '$nom_fic' sauvegardé.";

}

 

sub search_in_fic {

$info="Recherche dans le fichier '$nom_fic'...";

&text_search($texte, $search_string, 'search');

if ($mw->depth > 1) {

text_toggle($texte, ['configure', 'search', -background => 'SeaGreen4', -foreground => 'white'], 800,

['configure', 'search', -background => undef, -foreground => undef], 200);

} else {

text_toggle($texte, ['configure', 'search', -background => 'black', -foreground => 'white'], 800,

['configure', 'search', -background => undef, -foreground => undef], 200);

}

$info= "Recherche dans Fichier '$nom_fic' 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 mkConcordanceOneWord2 {

if ($search_string eq "") {

&mkPrintErreur("ERREUR : Aucune sélection de chaîne de recherche donnée dans la zone \"Search string\"\n");

return;

}

$mkTextConcordance->destroy if Exists($mkTextConcordance);

$mkTextConcordance = $mw->Toplevel();

my $w = $mkTextConcordance;

$w->title('Concordance');

$w->iconname('Text Concordance');

my $w_ok = $w->Button(-text => 'OK', -width => 8, -command => ['destroy', $w]);

my $w_t = $w->TextUndo(-setgrid => 'true', -width => '60', -height => '28',

-font => '-Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-*');

my $w_save = $w->Button(-text => "Save",

-image => $imageSave,

-command => sub {$w_t->FileSaveAsPopup()})->pack(-side => 'top', -pady => 5, -padx => 10);

my $w_s = $w->Scrollbar(-command => ['yview', $w_t]);

$w_t->configure(-yscrollcommand => ['set', $w_s]);

$w_ok->pack(-side => 'top', -pady => 5, -padx => 10);

$w_s->pack(-side => 'right', -fill => 'y');

$w_t->pack(-expand => 'yes', -fill => 'both');

# Set up display styles

my(@bold, @normal, $tags);

if ($mkTextConcordance->depth > 1) {

@bold = (-foreground => 'red');

@normal = (-foreground => undef);

} else {

@bold = (-foreground => 'white', -background => 'black');

@normal = (-foreground => undef, -background => undef);

}

if (!open(FIC,"$nom_fic")) {

$w_t->insert("end","ERREUR : Impossible d\'ouvrir '$nom_fic'\n");

return;

}

$w_t->insert('0.0', 'Résultats Concordance...');

$w_t->insert("end","\n\n");

my %Lignes=();

my %Concord=();

my $Ligne = 0;

my @Mots=();

READ: while(<FIC>)

{

#saute les lignes vides

next READ if (/^$/);

s/[ ]+/ /g;

chop;

$Ligne++;

$Lignes[$Ligne] = $_ ;

if ($Lignes[$Ligne]=~/$search_string/) {

$w_t->insert("end","\tLigne : $Lignes[$Ligne] \n");

}

@Mots = split(/[\[\"°\{\}&~\@=*?!;,():<>%\' \+_\/.-]+/);

#@Mots = split(/\W+/);

foreach $Mot (@Mots) {

$Mot =~ /\D/ or next ;

$Mot =~ /$search_string/ or next ;

push(@{$Concord{$Mot}},$Ligne);

}

}

foreach $Mot (sort keys %Concord) {

$w_t->insert("end","-------------------------------------------------\n");

$w_t->insert("end","Mot : $Mot \n");

for $Ligne (@{$Concord{$Mot}})

{

$w_t->insert("end","\tLigne n°$Ligne: $Lignes[$Ligne]\n");

}

}

close(FIC);

$info = "Concordance sur '$nom_fic' terminée.";

}

#---------------------------------------------