Chapitre 37 : Exercices en PERL



Dernière mise à jour  20 septembre 1999  Auteur Gilles Maire
Serveur  http://www.imaginet.fr/ime/perl2.htm Adresse Gilles.Maire@UNGI.com

Ce chapitre est une succession d'exemples, du simple au plus complexe, qui devraient permettre au lecteur de mettre en oeuvre le langage PERL.
 

37.1 - Exemple de tri

Nous allons commencer le chapitre par une utilisation avancée de la procédure sort, qui fera appel à la procédure split et tr.

 Si vous ne maîtrisez pas ces procédures, ne vous alarmez pas, nous allons les reprendre en détail ici.

 L'exercice va consister à trier une liste d'adresses e-mail non pas par l'ordre alphabétique de leur nom mais par l'ordre alphabétique des domaines.

 Le résultat du tri fera en sorte que John@Ambert.com soit devant Betty@Ibm.com.

La procédure de tri est sort, elle s'utilise de la sorte :

@buf1 = sort ( @buf2 ) ;

mais elle a une syntaxe plus riche qui est :

@buf1 = sort PROC ( @buf2 ) ;

qui permet de trier suivant la procédure de tri PROC.

 La procédure de tri PROC n'aura pas en argument la variable @_ mais deux variables particulières $a et $b.

 Ainsi par défaut la procédure tri sans PROC sera équivalente à :

@buf1 = sort { $a cmp $b } ( @buf2 ) ;

Le fichier d'entrée sera IN et celui de sortie OUT :

#TRI est la fonction de tri qui va être utilisée pour trier les données
# suivant leur domaine
# ! Cette procédure ne reçoit pas les arguments @_ mais $a et $b

sub TRI 
{
# La fonction split éclate $a en deux parties $val1 reçoit ce qui est
# avant le @ de l'adresse et $val2 le reste
($val1,$val2)=split (/@/, $a ) ;
($val3,$val4)=split (/@/, $b ) ;
# la fonction y traduit les majuscules en minuscules pour les chaînes
# résultantes
$val2 =~ y/A-Z/a-z/ ;
$val4 =~ y/A-Z/a-z/ ;
# on compare $val2 et $val4 ; comme c'est le dernier ordre de la routine
# cela revient à faire return ( $val2 cmp $val4  );
$val2 cmp $val4  ; 

}

#IN est le fichier d'entrée, OUT est le fichier de sortie ouvert en écriture
# par le signe >
open (F1 , "IN") ;
open (F2 , ">OUT") ;
#le buffer @fichier est déclaré et rempli avec le contenu du fichier IN
@fichier = <F1> ;
# @buf est trié suivant la procedure TRI
@buf = sort TRI  @fichier ;
#le résultat est écrit dans le fichier F2
print F2 @buf ;
close (F1) ;
close (F2) ;

37.2 - Date en français

La procédure suivante donne la date du jour :

sub Date
{
local (@DATE)=("Janvier","Février", "Mars","Avril", "Mai", "Juin",
"Juillet","Août","Septembre", "Octobre","Novembre","Décembre") ;

($sec,$min,$hour,$mday, $mon,$year,$wday,$yday,$isdst) = localtime(time);

$date = "$mday $DATE[$mon] 19$year" ;
}

Pour l'utiliser :

$date = &Date () ;
print "Date : $date \n";

37.3 - Test d'un champs adresse e-mail

La procédure suivante teste si l'argument donné est bien une adresse e-mail valide sous la forme x@y.z  où x, y et z sont des chaînes de caractères:
sub ControlEmail 

 return @_[0]=~/.+@.+\..+/ ; 
}
@_[0] est le premier argument de la procédure 
@_[0]=~ signifie que le test d'existence se fait sur la variable @_[0] par // 
.+@.+\..+ signifie que l'on demande à l'expression de contenir un ou plusieurs caractères quelconques suivis du caractère @ suivi d'un ou plusieurs caractères quelconques suivis du caractère . qui est backquoté pour signifier que le . n'est pas un caractère d'expression régulière.
Pour utiliser la procédure il suffit de l'appeler par la syntaxe suivante :

if ( &ControlEmail ("nom\@adresse1.adresse2))

37.4 - Conversion HTML vers texte

Il est inutile de se lancer dans l'écriture d'un programme complexe pour convertir un fichier HTML en son homologue texte. Ceci peut bien entendu se faire également par le menu sauve de votre navigateur en donnant le format texte comme format de sauvegarde.

 Mais l'exemple suivant peut être aménagé et montre la souplesse d'utilisation du langage PERL.

$fic1="fichier.htm";
open (F1, "<$fic1") ;

while ( $_ = <F1> ) 
{
  s/<(([^>]|\n)*)>//g;
  print $_ ;
}
close (F1);

L'instruction à regarder dans ce programme est bien sûr :

  s/<(([^>]|\n)*)>//g;

Elle travaille sur l'entrée standard sur laquelle elle effectue une substitution de caractères :

  s/ ... //g;

ceci remplace la séquence .. par rien plusieurs fois dans la ligne (à cause du g). L'expression régulière <(([^>]|\n)*)> est assez complexe et elle impose de supprimer les chaînes de caractères délimitées par <> sachant qu'entre ces délimiteurs, on peut trouver une rupture de ligne \n ou tout autre caractère qu'un caractère > et ce autant de fois qu'on veut ((..)*)

37.5 - Premier CGI

#!/bin/perl

use CGI ;
$html= new CGI ;
print $html->header ;


# première utilisation du module
#pour imprimer une signature de fichier html ou de fichier texte.

print "<HTML>\n"; 

#Les lignes qui suivent construisent un fichier HTML

print "<HEAD>\n"; 
print "<TITLE>titre de la page renvoyée</TITLE>\n";
print "</HEAD>\n"; 
print "<BODY>\n"; 
print "\n"; 
print "<H1>Mon premier exemple</H1>

Pour exécuter ce programme qui ne demande pas d'argument, l'auteur de la page HTML met dans son code un URL de la forme suivante:

http://serveur/cgi-perl/exemple1

Si le programme exemple1 est bien dans la directory cgi-perl.

37.6 - Envoi d'un courrier

Dans cet exemple, on va voir comment la forme suivante peut être exploitée :

<FORM ACTION="http://www.serveur.fr/cgi-bin/abonnement.pl">
URL : <INPUT NAME=Url VALUE=http://www. SIZE=30>   <P>
Titre de la page : <INPUT NAME=Titre SIZE=40><P>
Auteur : <INPUT NAME=Nom SIZE=25><P>
E-mail : <INPUT NAME=Email SIZE=25><P>
<INPUT TYPE=SUBMIT VALUE=Inscription>
</FORM>

C'est l'exemple que l'on trouve dans l'inscription au coin des Unginieux

 Nous allons voir que l'envoi d'un courrier se fait par l'ouverture d'un pipe sur le programme courrier mail par l'expression:

   $filedes="|/bin/mail Gilles.Maire\@Imaginet.fr";
    open(MAIL,$filedes);

Attention!II est important de mettre le caractère \ devant le @ de l'adresse.

#!/bin/perl
# Cette ligne peut être conservée sur PC Windows
push(@INC,"/perl");
# Cette ligne indique que la librairie cgi-perl.pl sera
à chercher dans la directory \perl.
Require("cgi-lib.pl");

# informe le langage PERL que la librairie est cgi-lib.pl

print &PrintHeader; 

# première utilisation de la bibliothèque
pour imprimer une signature de fichier html ou de fichier texte.
Ceci est utile pour que le serveur http sache qu'il doit renvoyer
l'information au client. 

#input est le résultat de la FORM

if (&ReadParse(*input)) {
#le fichier $filedes fera un pipe vers l'envoi de courrier par le programme /bin/mail
   $filedes="|/bin/mail Gilles.Maire\@Imaginet.fr";
   open(MAIL,$filedes);
   print MAIL "From: $input{'Email'}\n";
   print MAIL "Subject: Inscription coin des unginieux\n";
#Les  trois lignes qui suivent permettent  transporter les accents accentués ISO-8859 
   print MAIL "MIME-Version: 1.0\n";
   print MAIL "Content-Type: text/plain; charset=ISO-8859-1\n";
   print MAIL "Content-Transfer-Encoding: 8bit\n" ; 
   print MAIL "\n";


   print MAIL "\n";
   print MAIL "<li><font SIZE=+1><A HREF=http://$input{'Url'}>$input{'Titre'}</A> de $input{'Nom'}</font></li>";
   close(MAIL);
#le mail est envoyé

#On peut renvoyer le résultat sur un URL si le parametre url était spécifié

   if($input{'url'})
        {
           print "Location: $input{\"url\"}\n\n";
        }
   else
#Ou bien sur construire sa page dynamiquement sinon
        {
    print &PrintHeader;
    print "<HTML>\n<HEAD>\n<TITLE>Un nouveau guide d'Internet - Unginieux</TITLE>\n<BASE HREF=http://www.imaginet.fr/ime/></HEAD>\n" ;
    print "<BODY BGCOLOR=#FFFFFF TEXT=#000000 LINK=#0000B0 VLINK=#800000 ALINK=#FF0000>\n" ;
    print "<BASEFONT SIZE=4>";
    print "<HR>\n";
    print "$input{'Nom'},<P>\n";
    print "Bienvenue au coin des Unginieux sous réserve que la page\n";
    print "<B>$input{'Titre'}</B> à l'adresse <B>http://$input{'Url'}</B>  soit sympathique! <P>";
    print "N'oubliez pas de mettre un macaron <I>ungi</I> dans votre page.<P>";
    print "Il est possible qu'un jeu de piste à travers les sites des Unginieux soit organisé prochainement (afin de faire connaître nos pages). Ecrivez-moi pour qu'on discute du projet.<P>" ;
    print "Amicalement.<P>";
    print "Gilles Maire<P><HR>";
    
    print "<A HREF=mailto:Gilles.Maire\@Imaginet.fr> <IMG ALT=Courrier SRC=gif/mailbutt.gif ALIGN=BOTTOM BORDER=0></A>"; 
    print "<A HREF=suscribe.htm> <IMG ALT=Haut SRC=gif/up.gif ALIGN=BOTTOM BORDER=0></A>";
    print "<A HREF=toc.htm> <IMG ALT=Index SRC=gif/index.gif ALIGN=BOTTOM BORDER=0></A>";
    print "<A HREF=index.htm> <IMG ALT=Info SRC=gif/info.gif ALIGN=BOTTOM BORDER=0></A>";
    print "<A HREF=suscribe.htm> <IMG ALT=Souscription SRC=gif/button_y.gif ALIGN=BOTTOM BORDER=0></A>";
    print "<A HREF=aparaitr.htm> <IMG ALT=Bientôt SRC=gif/atwork.gif ALIGN=BOTTOM BORDER=0></A>";
    print "<A HREF=whatisne.htm> <IMG ALT=Nouveau SRC=gif/new.gif ALIGN=BOTTOM BORDER=0></A>";
    print "<A HREF=conventi.htm#CONVENTION> <IMG ALT=Aide SRC=gif/question.gif ALIGN=BOTTOM BORDER=0></A>";
    print "<A HREF=copyw.htm> <IMG ALT=Copyright SRC=gif/copyw.gif ALIGN=BOTTOM BORDER=0></A>";
    print "<A HREF=aparaitr.htm> <IMG ALT=Suivant SRC=gif/next.gif ALIGN=BOTTOM BORDER=0></A>";
    print "<HR>";
}
}

37.7 - Utilisation de OLE Automation

Il est assez facile d'utiliser les mécanismes OLE automation de Microsoft en PERL 5, nous donnons ici un exemple d'extraction de champs issus de plusieurs fichiers Excel en vue de calculs de la somme de ces champs. Cet exemple va plus loin que ceux donnés dans la documentation PERL puisqu'il donne une astuce indispensable non disponible dans la documentation.
 

use  Win32::OLE; 
$dir1="c:/factures/en cours/"; 
$dir2="c:\\factures\\en cours\\" ; 

$application =$application = Win32::OLE->new ('Excel.Application')
   or  warn "Impossible de créer un nouvel objet OLE";
opendir ( DIR , $dir1 ); 

while ( $fichier=readdir (DIR) ) 

push ( @fichier , $fichier); 

close (DIR) ; 
@fichier=sort(@fichier); 
foreach ( @fichier) 

 if ( /.xls$/ ) 
    { 
  $fichier= $dir2 . $_ ; 
  $workbook = $application->Workbooks->open("$fichier"); 
  $worksheet = $workbook->Worksheets(1); 
  $montant=$worksheet->Range("E43")->{'Value'} ; 
   $total+=$montant ; 
   print "$_ => $montant (sous total : $total)\n"; 
  $application->ActiveWorkbook->Close(0); 
  DESTROY ($application)  ; 
  } 

print "$total F H.T.\n" ; 
$application->Quit(); 
 

Appel du package OLE 
$dir1 est le nom de fichier aux conventions PERL 
$dir2 est le nom du fichier aux conventions OLE ! 
Win32::OLE->new ne fonctionne pas avec les packages OLE les plus anciens
à l'extérieur de la boucle car à l'intérieur la mémoire serait allouée autant de fois que d'itérations et nécessiterait une mémoire trop importante. 
Cette séquence consiste à ranger dans le tableau @fichier l'ensemble des fichiers du répertoire et ceci de façon triée. 

Pour tous les fichiers, on sélectionne les fichiers dont le nom se termine par .xls 
 

Ici les ordres sont ceux disponibles dans la documentation OLE de Microsoft. 

Clore l'application ferme la feuille en cours. 

DESTROY permet de réinitisaliser l'objet mais n'est pas commenté dans la documentation PERL. 
 
 

Quitte l'application 
 
 

37.8 - La base de données de fournisseurs

Cet exemple de programme reprend les arguments passés par la procédure ISMAP sur la carte de France des fournisseurs et affiche une page HTML avec les fournisseurs de la ville cliquée.

On remarquera la richesse de PERL dans les bases de données.

#!/usr/bin/perl 
# Ce programme ecrit par Gilles Maire renvoie la liste des
providers

# de la région cliquée sur la carte de France
# Auteur : Gilles Maire Gilles.Maire@imaginet.fr
# Ecrit le 3 octobre 1994 pour le Nouveau Guide d'Internet

#

# variable de localisation du Web

$location = "http://www.imaginet.fr/~gmaire/" ;

#$location = "http://localhost/manuel/" ;

#BASE DE DONNEES :

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

# Villes répertoriées

@VILLES=("Lille","Amiens","Rouen","Caen","Paris","Metz","Chalon",
"Strasbourg","Rennes","Orleans","Nantes","Dijon","Besancon","Poitiers",
"Limoges","Clermont","Lyon","Bordeaux","Toulouse","Montpellier","Marseille",
"Ajaccio","Grenoble","Aix","Toulon","Nice")
;

# On range les coordonnées de chaque ville dans le
Tableau $X $Y ;
$X{"Lille"} = 336 ; $Y{"Lille"} = 33 ;
$X{"Amiens"} = 307 ; $Y{"Amiens"} = 82;
$X{"Rouen"} =  252 ; $Y{"Rouen"} =108;
$X{"Caen"} = 193 ; $Y{"Caen"} = 123;
$X{"Paris"} = 309 ; $Y{"Paris"}= 142 ;
$X{"Grenoble"} = 463 ; $Y{"Grenoble"}= 360 ;
$X{"Aix"} = 442 ; $Y{"Aix"}= 453 ;
$X{"Toulon"} = 473 ; $Y{"Toulon"}= 488 ;
$X{"Nice"} = 518 ; $Y{"Nice"}= 451 ;

#On declare les providers par ville :

$PROVIDER{"Lille"} = "Compuserve:IBM";
$PROVIDER{"Amiens"} = "";
$PROVIDER{"Rouen"} =  "";
$PROVIDER{"Caen"} = "";
$PROVIDER{"Paris"} = 
"Alexnet:Calvacom:Centre_Internet_Européen:Codix";
$PROVIDER{"Metz"} = "" ;
$PROVIDER{"Toulon"} = "PCWan" ;

sub DEBUG {
foreach (%ENV)
{ 

 print "<LI> $_" ;
}

};

#On declare une subroutine de calcul de distance
#La procedure s'appelle DIST (x, y, Ville)
sub DIST {
local ( $arg1, $arg2, $Ville) =  @_ ;
$distance =  ($arg1 - $X{$Ville}) ** 2 + ($arg2 - $Y{$Ville})
** 2 ;
};

#On dresse la liste des providers de façon dynamique

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

sub LISTEPROVIDER {

#On recupere la liste de tous les PROVIDERS
foreach(@VILLES)

{
$Provider = $Provider . ":" . $PROVIDER{$_} ; 
}

#On range les Providers dans un tableau trié

@PROV = sort ( split (/:/,$Provider)) ; 
#On supprime les doublons car des providers sont présents
dans plusieurs villes
foreach (@PROV)
{
if ( $TEMP ne $_ )  
{ $PROV1 = $PROV1 . ":" . $_ ; }
$TEMP=$_ ;
} ; 

@PROV =split (/:/,$PROV1) ;

#On construit un tableau ORDRE avec le numéro d'ordre
de chaque provider dans la liste

foreach (@PROV)
{
$ORDRE {$_} = $compt ++ ;
} ; 

} ;

# La subroutine CONSTRUCT construit une page HTML avec le
résultat


sub CONSTRUCT {
local ( $arg1) = @_ ;
local (@Prov) = split (/:/, $PROVIDER{$arg1}) ;
print "<HEAD>" ;
print "<TITLE> Un nouveau guide d'Internet - Votre
provider </TITLE>" ;
print "</HEAD>" ;
print "<BODY>" ;
print "<H1> Ville de $arg1 </H1>

" ; print "<HR>" ; print "<UL>" ; foreach (@Prov)  { s/_/ /g ; print "<LI> <A HREF=$location/fourniss.htm#CHAP16_2_$ORDRE{$_}>$_</A>\n" ;} ; print "</UL>";  print "<HR>" ;

37.9 - Jeu avec DateManip.pm

La puissance du langage est due à son nombre de bibliothèques dont la puissance est impressionnante. Nous allons illustrer notre propos par l'utilisation du module DateManip.pm qui simplifie la vie de bon nombre de développeurs.

Aujourd'hui nous sommes le 28 février 1998 mais demain quel jour serons-nous ? Et le 1 er mars tombe quel jour ?

 

use Date::Manip;

@MOIS=(Janvier,Février,Mars,Avril,Mai,Juin, Juillet, Août, Septembre, Octobre, Novembre, Décembre);
@JOURS=(lundi,mardi,mercredi,jeudi,vendredi,
samedi,dimanche);
$Date::Manip::TZ="FWT5FST";

&Date_Init(undef,"DateFormat=non-US");
$date=&ParseDate("today") ;

print "$date\n" ;

print &AfficheJourSemaine($date),"\n";;
print &AfficheJour ($date),"\n";
print &AfficheMois ($date),"\n";
print &AfficheAnnee ($date),"\n";
print &JourSuivant($date),"\n";
print &JourPrecedent($date),"\n";
 

sub AfficheJourSemaine()
{
local $m,$d,$y;
($d,$m,$y)=&UnixDate($_[0],"%d","%m","%Y")  ;
return $JOURS[&Date_DayOfWeek($m,$d,$y)];
}

sub AfficheMois ()
{
local $m,$d,$y;
($d,$m,$y)=&UnixDate($_[0],"%d","%m","%Y")  ;
return $MOIS[$m-1];
}

sub AfficheJour ()
{
local $m,$d,$y;
($d,$m,$y)=&UnixDate($_[0],"%d","%m","%Y")  ;
return $d;
}

sub AfficheAnnee ()
{
local $m,$d,$y;
($d,$m,$y)=&UnixDate($_[0],"%d","%m","%Y")  ;
return $y;
}

sub JourSuivant()
{
return &DateCalc(@_[0],"+ 1days");
}

sub JourPrecedent()
{
return &DateCalc(@_[0],"- 1days");
}
 

Les mois sont rangés dans un tableau
 

Les jours itou

La méthode TZ permet de signaler les heures d'hiver et d'été en français.
Date_Init permet de donner les dates en 31/12/98 et non pas comme les américains en 12/31/98.
ParseDate s'emploie avec today mais aussi avec "12/03/98"
 

Les procédures suivantes sont made in UNGI
 
 
 
 
 
 
 

UnixDate fait partie du paquetage manip et extrait la date de la variable passée en argument (c'est à dire 12/02/98)
Date_DayOfWeek est une procédure du paquetage, elle donne le numéro du jour de la semaine (0 = dimanche)

DateCal est très puissante, elle vous donne la date d'un jour avec 15 jours supplémentaires. Elle peut aussi sauter les jours fériés et les samedi dimanche dans le mode business.  
 


Haut Haut Suivant Sommaire Recherche Fenêtre Glossaire Nouveau Bientôt Courrier Souscription Aide Copyright