 |
Chapitre 29 : Exercices en PERL |
|
Chapitre 29 : Exercices en PERL |
29.0 - Exemple de tri
29.1 - Date en français
29.2 - Conversion HTML vers texte
29.3 - Premier CGI
29.4 - Envoi d'un courrier
29.5 - La base de données de fournisseurs
29.6 - Procedure Upload
Ce chapitre est une succession d'exemples, du simple au plus complexe, qui devraient permettre au lecteur de mettre en oeuvre le langage PERL.
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 recoit 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 chaines
# 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) ;
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";
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 ((..)*)
#!/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>\n"; print "\n";
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.
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);
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=mailbutt.gif ALIGN=BOTTOM BORDER=0></A>";
print "<A HREF=suscribe.htm> <IMG ALT=Haut SRC=up.gif ALIGN=BOTTOM BORDER=0></A>";
print "<A HREF=toc.htm> <IMG ALT=Index SRC=index.gif ALIGN=BOTTOM BORDER=0></A>";
print "<A HREF=index.htm> <IMG ALT=Info SRC=info.gif ALIGN=BOTTOM BORDER=0></A>";
print "<A HREF=suscribe.htm> <IMG ALT=Souscription SRC=button_y.gif ALIGN=BOTTOM BORDER=0></A>";
print "<A HREF=aparaitr.htm> <IMG ALT=Bientôt SRC=atwork.gif ALIGN=BOTTOM BORDER=0></A>";
print "<A HREF=whatisne.htm> <IMG ALT=Nouveau SRC=new.gif ALIGN=BOTTOM BORDER=0></A>";
print "<A HREF=conventi.htm#CONVENTION> <IMG ALT=Aide SRC=question.gif ALIGN=BOTTOM BORDER=0></A>";
print "<A HREF=copyw.htm> <IMG ALT=Copyright SRC=copyw.gif ALIGN=BOTTOM BORDER=0></A>";
print "<A HREF=aparaitr.htm> <IMG ALT=Suivant SRC=next.gif ALIGN=BOTTOM BORDER=0></A>";
print "<HR>";
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:Compuserve:EuNet:FDN:FranceNet:France_Réseau:Mounet:IBM:Imaginet:Internet_Way:Micro_Net:Oléane:Planete_PC:Planete:Remcomp:SepCom:USNet:WorldNet"v;
$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>" ;
print "<A HREF=mailto:Gilles.Maire@Imaginet.fr><IMG
SRC=$location/gif/mailbutt.gif ALIGN=BOTTOM></A>";
print "<A HREF=$location/france.htm><IMG SRC=$location/gif/up.gif
ALIGN=BOTTOM></A>" ;
print "<A HREF=$location/toc.htm><IMG SRC=$location/gif/index.gif
ALIGN=BOTTOM></A> <A HREF=$location/index.htm>";
print "<IMG SRC=$location/gif/info.gif ALIGN=BOTTOM></A>
<A HREF=$location/suscribe.htm>";
print "<IMG SRC=$location/gif/button_y.gif ALIGN=BOTTOM></A>
<A HREF=$location/aparaitr.htm>";
print "<IMG SRC=$location/gif/atwork.gif ALIGN=BOTTOM></A>
<A HREF=$location/whatisne.htm>";
print "<IMG SRC=$location/gif/new.gif ALIGN=BOTTOM></A>
<A HREF=$location/conventi.htm#CONVENTION>";
print "<IMG SRC=$location/gif/question.gif ALIGN=BOTTOM></A>
<A HREF=$location/copyw.htm>";
print "<IMG SRC=$location/gif/copyw.gif ALIGN=BOTTOM></A><A
HREF=$location/france.htm>";
print "<IMG SRC=$location/gif/next.gif ALIGN=BOTTOM></A>
<HR>";
print "</BODY>" ;
};
require "cgi-lib.pl";
print &PrintHeader ;
# on range les deux arguments de coordonnées dans VAL[0]
et VAL[1],
#ces arguments sont séparés par des virgules
@VAL=split (/,/,$ARGV[0]) ;
# il est plus parlant d'appeler ces variables x et y non ?
$x=$VAL[0] ;
$y=$VAL[1] ;
#On etablit la liste des providers avec un tableau d'ordre
&LISTEPROVIDER ;
foreach(@VILLES)
{
if ( &DIST($x,$y,$_) < 400 )
{ &CONSTRUCT ($_) ; }
} ;
Cette procedure CGI permet de copier un fichier vers un serveur à partir des navigateurs qui acceptent la balise INPUT TYPE=FILE.
Elle est accompagnée d'une librairie le tout étant écrit en Perl5.
# Perl Routines to Manipulate CGI input.
# Last modified: 28 Feb 1996
# Usage:
# Use this library, of course:
# require 'CGI_LIB.pl';
#
# Print the "Content-Type:" line:
# &Print_Head;
#
# "GET" method:
# &Parse_Data;
# All the variables will be parsed into %CGI. $CGI{'NAME'} is the value
# of the variable "NAME".
#
# "POST" method:
# &Parse_Data;
# Data parsed in the way same as "GET" method.
#
# If "ENCTYPE" is used ( for Netscape2.0 extension & HTML3.0 ):
# &Parse_Multi;
# The data will be parsed into %CGI, $CGI{'NAME'} is the value of the
# variable "NAME". If variable's type is "FILE", (i.e. TYPE="FILE" in
# form) there'll have an extension information for this variable; and
# those informations are assigned to $EXT{'NAME'}. $EXT{'NAME'} has
# style like 'filename="xxxx"' (or maybe 'filename="xx"; yyy="zzz"',
# I'm not sure as I've not met this b4), so you need to parse it again
# in your cgi program. If the uploaded file has known suffix, ( such
# as .gif ) which "Content-Type" will be contained in the part,
# $C_TYPE{name} is the content type of the value.
#
# You can try http://140.114.63.14:6083/doc/upload.html
#
# Notice!!
# If you fail to upload some binary files, check the comment in
# &Parse_Multi subroutine below. And maybe you can try the File
# upload demonstration written by wole at
# http://140.114.63.14:6083/wole/UL/upload.html and tell me the
# browser and the web server you're using. Thanks.
#
sub Parse_Data {
local($raw_data,@items,$key,$value);
$raw_data = &Parse_Method;
# Split different "NAME" and their values.
@items = split('&', $raw_data);
# For each list of "NAME=its_value".
for (@items) {
$_ =~ tr/+/ /;
($key,$value) = split('=',$_,2);
# The %xx hex numbers are converted to alphanumeric.
$key =~ s/%(..)/pack("C", hex($1))/eg;
$value =~ s/%(..)/pack("C", hex($1))/eg;
$CGI{$key} = $value;
}
}
sub Print_Head {
print "Content-Type: text/html\n\n";
}
sub Parse_Multi {
local($boundary,@pairs,$position);
local($raw_data,$value,$name,$part,$type);
if ( $ENV{CONTENT_TYPE} =~ /application\/x-www-form-urlencoded/ ) {
&Parse_Data;
return;
};
$raw_data = &Parse_Method;
($boundary = $ENV{CONTENT_TYPE}) =~ s/^.*boundary=(.*)$/\1/;
@pairs = split(/--$boundary/, $raw_data);
@pairs = splice(@pairs,1,$#pairs-1);
for $part (@pairs) {
undef $type if defined $type;
($position = $part) =~ s/^Content-Disposition: form-data; (.*)(\n.*)+/\1/mg;
$position =~ s/\r\n//mg;
if ( $position =~ /^name=".*";\s.*$/ ) {
if ( $part =~ /^Content-Disposition:.*\nContent.*/ ) {
($value = $part) =~ s/^Content-Disposition: form-data; .*\nC.*\n(.*)/\1/mg;
($type = $part) =~ s/^Content-Dis.*\nContent-Type:\s+(.*\/.*)(\n.*)+/\1/mg;
$type =~ s/(\r\n|\r)//mg;
}
else {
($value = $part) =~ s/^Content-Disposition: form-data; .*\n(.*)/\1/mg;
}
($name = $position) =~ s/^name="(.*)";.*$/\1/;
($ext = $position) =~ s/^name=".*"(;.*)+$/\1/;
$ext =~ s/(^;\s*|\r)//mg;
$EXT{$name} = $ext;
$C_TYPE{$name} = $type;
}
else {
($value = $part) =~ s/^Content-Disposition: form-data; .*\n\s*\n(.*)/\1/mg;
($name = $position) =~ s/^name="(.*)"\s+$/\1/;
}
$value =~ s/\r\n//mg;
###################################
# If you fail to upload some binary files, try to comment above
# line and use the following two lines.
# $value =~ s/^\r\n//;
# $value =~ s/\r\n$//;
# (This is told by Ziga Turk <ziga.turk@fagg.uni-lj.si>)
###################################
$CGI{$name} = $value;
}
}
sub Parse_Method {
local($buffer);
if ($ENV{'REQUEST_METHOD'} eq "POST") {
read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
return $buffer;
}
elsif ($ENV{'REQUEST_METHOD'} eq "GET") {
return $ENV{'QUERY_STRING'};
}
else {
return 0;
}
}
#END of CGI_LIB.pl library.
1;
__END__
La procedure elle même est la suivante :
#!/usr/local/bin/perl5
require './CGI_LIB.pl';
&Print_Head;
&Parse_Multi;
$plusplus = "<BIG><FONT COLOR=#00aaaa>++</FONT></BIG>";
print "<PRE>";
print <<__END__HEAD__;
<HR SIZE=8>
<H2>\$ENV{CONTENT_TYPE}</A>
</H2>
<SMALL><FONT COLOR=#ff0000>$ENV{CONTENT_TYPE}</FONT></SMALL>
<HR SIZE=8>
<B>In the following \"$plusplus\" is a mark to know where the value starts and ends.</B>
__END__HEAD__
print "\n<H2>%CGI</H2>";
for (keys(%CGI)) {
print "<B><BIG><FONT COLOR=#0000ff>$_</FONT></BIG></B>\n";
print "Its value: <B><FONT COLOR=#00ff33>\$CGI\{$_\}</FONT></B>\n";
print "$plusplus<B>$CGI{$_}</B>$plusplus\n";
print "\n<HR SIZE=3 WIDTH=90%>";
}
print "<HR SIZE=8>";
print "<H2>%EXT</H2>";
for (keys(%EXT)) {
print "<B><BIG><FONT COLOR=#0000ff>$_</FONT></BIG><B>\n";
print "Its extension variable: <B><FONT COLOR=#00ff33>\$EXT\{$_\}</FONT></B>\n";
print "$plusplus<B>$EXT{$_}</B>$plusplus\n\n";
if ( defined $C_TYPE{$_} ) {
print "Its Content-Type: <B><FONT COLOR=#00ff33>\$C_TYPE\{$_\}</FONT></B>\n";
print "$plusplus<B>$C_TYPE{$_}</B>$plusplus\n";
};
print "\n<HR SIZE=3 WIDTH=90%>";
}
print <<__HTML__;
</PRE>
<HR SIZE=8>
<A HREF="mailto:u810561\@Oz.nthu.edu.tw">Comments are welcome!</A>
__HTML__