[28783] in Perl-Users-Digest
Perl-Users Digest, Issue: 27 Volume: 11
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Sun Jan 14 11:10:15 2007
Date: Sun, 14 Jan 2007 08:10:06 -0800 (PST)
From: Perl-Users Digest <Perl-Users-Request@ruby.OCE.ORST.EDU>
To: Perl-Users@ruby.OCE.ORST.EDU (Perl-Users Digest)
Perl-Users Digest Sun, 14 Jan 2007 Volume: 11 Number: 27
Today's topics:
Parsing some input - easy to explain but lengthy to cod <spam.meplease@ntlworld.com>
Re: Parsing some input - easy to explain but lengthy to <jurgenex@hotmail.com>
Re: Parsing some input - easy to explain but lengthy to <see.sig@rochester.rr.com>
Re: Perl free e-books <riye0901@yahoo.com>
problems cgi ex cook book perl <john.swilting@wanadoo.fr>
Re: problems cgi ex cook book perl <RedGrittyBrick@SpamWeary.foo>
Re: problems cgi ex cook book perl <john.swilting@wanadoo.fr>
Re: problems cgi ex cook book perl <john.swilting@wanadoo.fr>
Re: Unix commands <abigail@abigail.be>
wall command from perl jcharth@hotmail.com
Digest Administrivia (Last modified: 6 Apr 01) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: 14 Jan 2007 06:13:40 -0800
From: "doolittle" <spam.meplease@ntlworld.com>
Subject: Parsing some input - easy to explain but lengthy to code - suggestions?
Message-Id: <1168784020.314209.189390@38g2000cwa.googlegroups.com>
Hi,
I have to check that some input conforms to some rules. Although the
rules are simple to expain, my perl function looks too complex/long,
can it be done more simply?
The rule is that the first character must be a letter, and the second
and third characters must form a number between 1 and 25 (so the third
character is optional)
sub isOK {
my $str = shift;
# get the first character
my $chr = lc substr $str, 0, 1;
# return false if the first character is not a letter between a and Z
return 0 if $chr !~ /[a-z]/o;
# get the second character
$chr = substr $str, 1, 1;
# return false if the second character is not
# a number between 1 and 9
return 0 if $chr !~ /[1-9]/o;
# get the third character
$chr = substr $str, 2, 1;
if ($chr) {
# return false if the third character exists, but is not a number
return 0 if $chr !~ /\d/o;
# return false if the combination of the 2nd and
# 3rd characters is over 25
return 0 if (substr $str, 1) > 25;
}
# otherwise return true
return 1
}
------------------------------
Date: Sun, 14 Jan 2007 15:05:29 GMT
From: "Jürgen Exner" <jurgenex@hotmail.com>
Subject: Re: Parsing some input - easy to explain but lengthy to code - suggestions?
Message-Id: <ZErqh.1141$32.305@trndny09>
doolittle wrote:
> Hi,
>
> I have to check that some input conforms to some rules. Although the
> rules are simple to expain, my perl function looks too complex/long,
> can it be done more simply?
>
> The rule is that the first character must be a letter, and the second
> and third characters must form a number between 1 and 25 (so the third
> character is optional)
UNTESTED!!!
sub isOK {
my $str = shift;
if ($str =~ /^\w(\d{1,2}?)/
# check for first character being a letter,
# next 1 or 2 characters being digits and capture them
and $1 > 0 and $1 < 25 ) {
return 1;
} else {
return 0;
}
jue
------------------------------
Date: Sun, 14 Jan 2007 10:05:32 -0500
From: Bob Walton <see.sig@rochester.rr.com>
Subject: Re: Parsing some input - easy to explain but lengthy to code - suggestions?
Message-Id: <45aa46bb$0$18885$4c368faf@roadrunner.com>
doolittle wrote:
> Hi,
>
> I have to check that some input conforms to some rules. Although the
> rules are simple to expain, my perl function looks too complex/long,
> can it be done more simply?
>
> The rule is that the first character must be a letter, and the second
> and third characters must form a number between 1 and 25 (so the third
> character is optional)
>
Try:
use warnings;
use strict;
while(<DATA>){
chomp;
print "$_->".isOK($_)."\n";
}
sub isOK{
my $str=shift;
if($str=~/^[a-z](\d\d?)/i){
return(($1>0 and $1<26)?1:0);
}
else{return 0}
}
__END__
a1
a0
a25
a26
Z1
a1xxxxx
a199999
a299999
a01
z019999
foo
a099999
1a1
Results:
D:\junk>junk580.pl
a1->1
a0->0
a25->1
a26->0
Z1->1
a1xxxxx->1
a199999->1
a299999->0
a01->1
z019999->1
foo->0
a099999->1
1a1->0
D:\junk>
You didn't say whether trailing characters could be present; I assumed
they could and should be ignored greedily (that is, z269999 is rejected
even though it could be taken as z2 followed by junk).
--
Bob Walton
Email: http://bwalton.com/cgi-bin/emailbob.pl
------------------------------
Date: Sun, 14 Jan 2007 19:57:04 +0800
From: "Johnson Shine" <riye0901@yahoo.com>
Subject: Re: Perl free e-books
Message-Id: <eod532$ljj$1@az33news01.freescale.net>
I think what Joe Smith said are totally right! He is a fair man
"Joe Smith" <joe@inwap.com> wrote in message
news:_JWdnUiGUoY2djTYnZ2dnUVZ_tCtnZ2d@comcast.com...
> John Bokma wrote:
>
>> And I am, sadly, moved by your ignorance.
>>
>> Don't top post
>> Don't reply using HTML
>
> He's not posting using HTML.
>
> Content-Type: text/plain; charset="gb2312"
> Content-Transfer-Encoding: quoted-printable
>
> As you can see, it is text/plain (not text/html), with a Chinese codepage.
> (Granted, it is multi-part/MIME, but definitely not HTML.)
>
>
> Uri Guttman wrote:
>
>>> I just wanna make the format of my message as "Times New Roman", not the
>>> default format of Plain Text file.
> >
>> and usenet is a PLAIN TEXT only medium. no one cares about your
>> formatting requests. html IS NOT ACCEPTED.
>
> It's not HTML. It's text/plain in the default setting for Chinese.
>
> You misinterpreted the slightly flawed English.
> Shuo Shi said, (paraphrasing), "Oh, I see, I need to simply tell Outlook
> Express
> to use Time New Roman in order to produce a posting that is not
> offensive."
>
> -Joe
>
>
------------------------------
Date: Sun, 14 Jan 2007 13:54:53 +0100
From: "john.swilting" <john.swilting@wanadoo.fr>
Subject: problems cgi ex cook book perl
Message-Id: <45aa281c$0$25916$ba4acef3@news.orange.fr>
I started again the example of cook book perl
chapter 19.14
He(It) does not walk(work) correctly can you m help to find the error
The error which appears it is Not of ecran for card
at /var/www/cgi-bin/vente.cgi line 24
help help help
i am french
i am beginner of perl
help help help
#!/usr/bin/perl -w
use strict;
use CGI qw(:standard escapeHTML);
use CGI::Carp qw(fatalsToBrowser);
my %Etats;
my $Ecran_actuel;
## hachage des documents et des fonctions
%Etats = (
'Défaut' =>\&document_de_garde,
'Chemises' =>\&chemise,
'Chaussures' =>\&chaussures,
'Passage à la caisse' =>\&passage_a_la_caisse,
'Carte' =>\&carte_de_credit,
'Commande' =>\&commande,
'Annnulation' =>\&document_de_garde,
);
$Ecran_actuel = param(".Etat") || "Défaut";
die "Pas d'écran pour $Ecran_actuel" unless $Etats{$Ecran_actuel};
## engendre le document courant
en_tete_standard();
while ( my ($nom_ecran,$fonction) = each %Etats){
$fonction->($nom_ecran eq $Ecran_actuel);
}
pied_de_page_standard();
exit;
########################################################################
## fonctions d'en-tete, de pied de page, de menu #######################
########################################################################
sub en_tete_standard {
print header(),
start_html(-Title => "Chemises", -BGCOLOR=>"White");
print start_form(); ##start_multipart_form()
##s'il faut exporter des fichiers sur le reseau
}
sub pied_de_page_standard { print end_form(), end_html() }
sub menu_boutique {
print p(defaults("Vider mon caddie"),
vers_doc("Chemises"),
vers_doc("Chaussures"),
vers_doc("Passage à la caisse"));
}
#######################################################################
## sous-programmes pour chaque écran ##################################
#######################################################################
## le document par defaut
sub document_de_garde {
my $actif = shift;
return unless $actif;
print "<H1>salut!</H1>\n";
print "bienvenue dans notre magasin d'habillement!\n",
print "faites votre choix dans le menu ci-dessous.\n";
menu_boutique();
}
## document à partir duquel commander une chemise
sub chemise {
my $actif = shift;
my @tailles = qw(XL L M S);
my @couleurs = qw(Noire Blanche);
my ($taille, $couleur, $compte) =
(param("taille_chemise"), param("couleur_chemise"),
param("nom_chemises"));
##verification des donnees reçus
if ($compte) {
$couleur = $couleurs[0]
unless grep { $_ eq $couleur } @couleurs;
$taille = $tailles[0]
unless grep {$_ eq $taille } @tailles;
param("couleur_chemise" , $couleur);
param("taille_chemise" , $taille);
}
unless ( $actif ) {
print hidden("taille_chemise") if $taille;
print hidden("couleur_chemise") if $couleur;
print hidden("nombre_chemises") if $compte;
return;
}
print h1("chemises");
print p("quelle chemise! cette petite merveille est\n","livree avec
toutes les options.doublure de luxe,\n",
"finitions avec toutes les options. doublure de luxe\n","finitions en
coton, et un col à en avoir les\n",
"Prix unitaire: 33.00\ euros.");
print h2("options");
print p("nombre ?",textfield("nombre_chemises"));
print p("taille ?",popup_menu("taille_chemise",\@tailles ),
"couleur ?", popup_menu("couleur_chemise",\@couleurs ));
menu_boutique();
}
## document à partir duquel commander des chaussures
sub chaussures {
my $actif = shift;
my @tailles = qw(35 36 37 38 39 40 41 42 43 44 45 46 47 48);
my @couleurs = qw(Ivoire Noisette Ebene);
my ( $taille, $couleur, $compte) =
(param("taille_chaussure"), param("couleur_chaussures"),
param("nombre_chaussures"));
##verification des donnees reçus
if ( $compte ) {
$couleur = $couleurs[0]
unless grep { $_ eq $couleur } @couleurs;
$taille = $tailles[0]
unless grep { $_ eq $taille } @tailles;
param("couleur_chaussures",$couleur);
param("taille_chaussures", $taille);
}
unless ( $actif ) {
print hidden("taille_chaussures") if $taille;
print hidden("couleur_chaussures") if $couleur;
print hidden("nombre_chaussures") if $compte;
return;
}
print h1("chaussures");
print p("vous ne serez jamais aussi elegant que chausse de
ces\n", "souliers magnifiques\n",
"prix unitaires: 49.99\ euros.");
print h2("options");
print p("nombre de paires?", textfield("nombre_chaussures"));
print p("pointure?", popup_menu("taille_chaussures",\@tailles));
print p("teinte?",popup_menu("couleur_chaussures",\@couleurs));
menu_boutique();
}
## document qui affiche la commande actuelle en attente de comfirmation
sub passage_a_la_caisse {
my $actif = shift;
return unless $actif;
print h1("confirmation de la commande");
print p("vous avez commande :");
print texte_commande();
print p("est-ce correct?\nn",
"choissisez «Carte» pour regler ces\n",
"objets, ou «chemises» ou\n",
"«chaussures» pour continuer vos courses.");
print p(vers_doc("carte"),
vers_doc("chemises"),
vers_doc("chaussures"));
}
## document pour ollecter les informations relatives à la carte de credit
sub carte_de_credit {
my $actif = shift;
my @gadgets = qw(Nom Adresse1 Adresse2 Ville Code_postal Pats Telephone
Carte Expire_en);
unless ( $actif ) {
print map { hidden($_) } @gadgets;
return;
}
print pre ( p ("Nom: ",textfield("Nom")),
p ("Adresse: ",textfield("Adresse1")),
p (" ",textfield("Adresse2")),
p ("Ville: ",textfield("Ville")),
p ("Code Postal: ",textfield("Code_postal")),
p ("Pays: ",textfield("Pays")),
p ("Telephone: ",textfield("Teléphone")),
p ("Carte numéro: ",textfield("Carte")),
p ("Expire en: ",textfield("Expire_en")));
print p ( "Selectionner «Commande» pour commander\n",
"ces objets. selectionner «Annulation»\n");
print p ( vers_doc("Commande"), vers_doc("Annulation"));
}
## document pour terminer une commande
sub commande {
my $actif = shift;
unless ( $actif) {
return;
}
## ici on verifie les valeurs donnees pour la carte de credit
print h1("Commandé\ !");
print p("vous avez commandé ce qui suit:");
print texte_commande();
print p (defaults ("Retour au debut"));
}
## renvoie de l ' HTML pour la commande actuelle("vous avez ommande")
sub texte_commande {
my $html = '';
if ( param ("nombre_chemises")) {
$html .= p("vous avez commandé" , param("nombre_chemises"),
"chemises de taille", param("taille_chemise"),
" et de couleur " , param("couleur_chemise"),",");
}
if ( param ("nombre_chaussures")) {
$html .= p("vous avez comandé",param("nombre_chaussures"),
"paires de chaussures de pointures" ,
param("taille_chaussures"),
" et de teinte ", param ("couleur_chaussures"),".");
}
$html = p("Rien!") unless $html;
$html .= p("pour un prix total de ",calcule_prix());
return $html;
}
sub calcule_prix {
my $chemises = param("nombre_chemises") || 0 ;
my $chaussures = param("nombre_chaussures") || 0;
return sprintf("%.2f euros", $chemises * 33 + $chaussures * 49.99);
}
sub vers_doc { submit (-NAME => ".Etat", -VALUE => shift) }
------------------------------
Date: Sun, 14 Jan 2007 13:23:41 +0000
From: RedGrittyBrick <RedGrittyBrick@SpamWeary.foo>
Subject: Re: problems cgi ex cook book perl
Message-Id: <pKCdnYH7iehDszfYRVnyuQA@bt.com>
john.swilting wrote:
> I started again the example of cook book perl
> chapter 19.14
> He(It) does not walk(work) correctly can you m help to find the error
> The error which appears it is Not of ecran for card
You have used google to translate your error message from French into
English. You shouldn't do this. See below.
> at /var/www/cgi-bin/vente.cgi line 24
>
> help help help
> i am french
> i am beginner of perl
> help help help
>
> #!/usr/bin/perl -w
>
> use strict;
> use CGI qw(:standard escapeHTML);
> use CGI::Carp qw(fatalsToBrowser);
>
> my %Etats;
>
> my $Ecran_actuel;
>
> ## hachage des documents et des fonctions
>
> %Etats = (
> 'Défaut' =>\&document_de_garde,
> 'Chemises' =>\&chemise,
> 'Chaussures' =>\&chaussures,
> 'Passage à la caisse' =>\&passage_a_la_caisse,
> 'Carte' =>\&carte_de_credit,
> 'Commande' =>\&commande,
> 'Annnulation' =>\&document_de_garde,
> );
>
> $Ecran_actuel = param(".Etat") || "Défaut";
> die "Pas d'écran pour $Ecran_actuel" unless $Etats{$Ecran_actuel};
^^^^^^
That line is printing your error message - some French equivalent of
"Not of ecran for card" which suggests that the user entered some
variation of 'Carte.' or 'carte' or ' Carte'.
I'd change that line to
die "Pas d'écran pour '$Ecran_actuel'" unless $Etats{$Ecran_actuel};
so that you can clearly see leading spaces and other punctuation.
<rest of program snipped>
------------------------------
Date: Sun, 14 Jan 2007 15:00:25 +0100
From: "john.swilting" <john.swilting@wanadoo.fr>
Subject: Re: problems cgi ex cook book perl
Message-Id: <45aa3778$0$25907$ba4acef3@news.orange.fr>
RedGrittyBrick wrote:
> john.swilting wrote:
>> I started again the example of cook book perl
>> chapter 19.14
>> He(It) does not walk(work) correctly can you m help to find the error
>> The error which appears it is Not of ecran for card
>
> You have used google to translate your error message from French into
> English. You shouldn't do this. See below.
>
>> at /var/www/cgi-bin/vente.cgi line 24
>>
>> help help help
>> i am french
>> i am beginner of perl
>> help help help
>>
>> #!/usr/bin/perl -w
>>
>> use strict;
>> use CGI qw(:standard escapeHTML);
>> use CGI::Carp qw(fatalsToBrowser);
>>
>> my %Etats;
>>
>> my $Ecran_actuel;
>>
>> ## hachage des documents et des fonctions
>>
>> %Etats = (
>> 'Défaut' =>\&document_de_garde,
>> 'Chemises' =>\&chemise,
>> 'Chaussures' =>\&chaussures,
>> 'Passage à la caisse' =>\&passage_a_la_caisse,
>> 'Carte' =>\&carte_de_credit,
>> 'Commande' =>\&commande,
>> 'Annnulation' =>\&document_de_garde,
>> );
>>
>> $Ecran_actuel = param(".Etat") || "Défaut";
>> die "Pas d'écran pour $Ecran_actuel" unless $Etats{$Ecran_actuel};
>
> ^^^^^^
> That line is printing your error message - some French equivalent of
> "Not of ecran for card" which suggests that the user entered some
> variation of 'Carte.' or 'carte' or ' Carte'.
>
> I'd change that line to
> die "Pas d'écran pour '$Ecran_actuel'" unless $Etats{$Ecran_actuel};
> so that you can clearly see leading spaces and other punctuation.
>
> <rest of program snipped>
I have correct the problemes of syntax
But after the form card(map) he indicates me 0 euro of command(order)
I do not understand
help help
#!/usr/bin/perl -w
use strict;
use CGI qw(:standard escapeHTML);
use CGI::Carp qw(fatalsToBrowser);
my %Etats;
my $Ecran_actuel;
## hachage des documents et des fonctions
%Etats = (
'Défaut' =>\&document_de_garde,
'Chemises' =>\&chemise,
'Chaussures' =>\&chaussures,
'Passage à la caisse' =>\&passage_a_la_caisse,
'Carte' =>\&carte_de_credit,
'Commande' =>\&commande,
'Annnulation' =>\&document_de_garde,
);
$Ecran_actuel = param(".Etat") || "Défaut";
die "Pas d'écran pour $Ecran_actuel" unless $Etats{$Ecran_actuel};
## engendre le document courant
en_tete_standard();
while ( my ($nom_ecran,$fonction) = each %Etats){
$fonction->($nom_ecran eq $Ecran_actuel);
}
pied_de_page_standard();
exit;
########################################################################
## fonctions d'en-tete, de pied de page, de menu #######################
########################################################################
sub en_tete_standard {
print header(),
start_html(-Title => "Chemises", -BGCOLOR=>"White");
print start_form(); ##start_multipart_form()
##s'il faut exporter des fichiers sur le reseau
}
sub pied_de_page_standard { print end_form(), end_html() }
sub menu_boutique {
print p(defaults("Vider mon caddie"),
vers_doc("Chemises"),
vers_doc("Chaussures"),
vers_doc("Passage à la caisse"));
}
#######################################################################
## sous-programmes pour chaque écran ##################################
#######################################################################
## le document par defaut
sub document_de_garde {
my $actif = shift;
return unless $actif;
print "<H1>salut!</H1>\n";
print "bienvenue dans notre magasin d'habillement\ !\n",
print "faites votre choix dans le menu ci-dessous.\n";
menu_boutique();
}
## document à partir duquel commander une chemise
sub chemise {
my $actif = shift;
my @tailles = qw(XL L M S);
my @couleurs = qw(Noire Blanche);
my ($taille, $couleur, $compte) =
(param("taille_chemise"), param("couleur_chemise"),
param("nom_chemises"));
##verification des donnees reçus
if ($compte) {
$couleur = $couleurs[0]
unless grep { $_ eq $couleur } @couleurs;
$taille = $tailles[0]
unless grep {$_ eq $taille } @tailles;
param("couleur_chemise" , $couleur);
param("taille_chemise" , $taille);
}
unless ( $actif ) {
print hidden("taille_chemise") if $taille;
print hidden("couleur_chemise") if $couleur;
print hidden("nombre_chemises") if $compte;
return;
}
print h1("chemises");
print p("quelle chemise! cette petite merveille est\n","livree avec
toutes les options.doublure de luxe,\n",
"finitions avec toutes les options. doublure de luxe\n","finitions en
coton, et un col à en avoir les\n",
"Prix unitaire: 33.00 euros.");
print h2("options");
print p("nombre ?",textfield("nombre_chemises"));
print p("taille ?",popup_menu("taille_chemise",\@tailles ),
"couleur ?", popup_menu("couleur_chemise",\@couleurs ));
menu_boutique();
}
## document à partir duquel commander des chaussures
sub chaussures {
my $actif = shift;
my @tailles = qw(35 36 37 38 39 40 41 42 43 44 45 46 47 48);
my @couleurs = qw(Ivoire Noisette Ebene);
my ( $taille, $couleur, $compte) =
(param("taille_chaussure"), param("couleur_chaussures"),
param("nombre_chaussures"));
##verification des donnees reçus
if ( $compte ) {
$couleur = $couleurs[0]
unless grep { $_ eq $couleur } @couleurs;
$taille = $tailles[0]
unless grep { $_ eq $taille } @tailles;
param("couleur_chaussures",$couleur);
param("taille_chaussures", $taille);
}
unless ( $actif ) {
print hidden("taille_chaussures") if $taille;
print hidden("couleur_chaussures") if $couleur;
print hidden("nombre_chaussures") if $compte;
return;
}
print h1("chaussures");
print p("vous ne serez jamais aussi elegant que chausse de
ces\n", "souliers magnifiques\n",
"prix unitaires: 49.99 euros.");
print h2("options");
print p("nombre de paires?", textfield("nombre_chaussures"));
print p("pointure?", popup_menu("taille_chaussures",\@tailles));
print p("teinte?",popup_menu("couleur_chaussures",\@couleurs));
menu_boutique();
}
## document qui affiche la commande actuelle en attente de comfirmation
sub passage_a_la_caisse {
my $actif = shift;
return unless $actif;
print h1("confirmation de la commande");
print p("vous avez commande:");
print texte_commande();
print p("est-ce correct?\nn",
"choissisez «Carte» pour regler ces\n",
"objets, ou «chemises» ou\n",
"«chaussures» pour continuer vos courses.");
print p(vers_doc("Carte"),
vers_doc("Chemises"),
vers_doc("Chaussures"));
}
## document pour ollecter les informations relatives à la carte de credit
sub carte_de_credit {
my $actif = shift;
my @gadgets = qw(Nom Adresse1 Adresse2 Ville Code_postal Pats Telephone
Carte Expire_en);
unless ( $actif ) {
print map { hidden($_) } @gadgets;
return;
}
print pre ( p ("Nom\ : ",textfield("Nom")),
p ("Adresse\ : ",textfield("Adresse1")),
p (" ",textfield("Adresse2")),
p ("Ville\ : ",textfield("Ville")),
p ("Code Postal\ : ",textfield("Code_postal")),
p ("Pays\ : ",textfield("Pays")),
p ("Telephone\ : ",textfield("Teléphone")),
p ("Carte numéro\ : ",textfield("Carte")),
p ("Expire en\ : ",textfield("Expire_en")));
print p ( "Selectionner «Commande» pour commander\n",
"ces objets. selectionner «Annulation»\n");
print p ( vers_doc("Commande"), vers_doc("Annulation"));
}
## document pour terminer une commande
sub commande {
my $actif = shift;
unless ( $actif) {
return;
}
## ici on verifie les valeurs donnees pour la carte de credit
print h1("Commandé\ !");
print p("vous avez commandé ce qui suit:");
print texte_commande();
print p (defaults ("Retour au debut"));
}
## renvoie de l ' HTML pour la commande actuelle("vous avez ommande")
sub texte_commande {
my $html = '';
if ( param ("nombre_chemises")) {
$html .= p("vous avez commandé" , param("nombre_chemises"),
"chemises de taille", param("taille_chemise"),
" et de couleur " , param("couleur_chemise"),",");
}
if ( param ("nombre_chaussures")) {
$html .= p("vous avez comandé",param("nombre_chaussures"),
"paires de chaussures de pointures" ,
param("taille_chaussures"),
" et de teinte ", param ("couleur_chaussures"),".");
}
$html = p("Rien!") unless $html;
$html .= p("pour un prix total de ",calcule_prix());
return $html;
}
sub calcule_prix {
my $chemises = param("nombre_chemises") || 0 ;
my $chaussures = param("nombre_chaussures") || 0;
return sprintf("%.2f\ euros", $chemises * 33 + $chaussures *
49.99);
}
sub vers_doc { submit (-NAME => ".Etat", -VALUE => shift) }
------------------------------
Date: Sun, 14 Jan 2007 15:15:37 +0100
From: "john.swilting" <john.swilting@wanadoo.fr>
Subject: Re: problems cgi ex cook book perl
Message-Id: <45aa3b08$0$25930$ba4acef3@news.orange.fr>
john.swilting wrote:
> RedGrittyBrick wrote:
>
>> john.swilting wrote:
>>> I started again the example of cook book perl
>>> chapter 19.14
>>> He(It) does not walk(work) correctly can you m help to find the error
>>> The error which appears it is Not of ecran for card
>>
>> You have used google to translate your error message from French into
>> English. You shouldn't do this. See below.
>>
>>> at /var/www/cgi-bin/vente.cgi line 24
>>>
>>> help help help
>>> i am french
>>> i am beginner of perl
>>> help help help
>>>
>>> #!/usr/bin/perl -w
>>>
>>> use strict;
>>> use CGI qw(:standard escapeHTML);
>>> use CGI::Carp qw(fatalsToBrowser);
>>>
>>> my %Etats;
>>>
>>> my $Ecran_actuel;
>>>
>>> ## hachage des documents et des fonctions
>>>
>>> %Etats = (
>>> 'Défaut' =>\&document_de_garde,
>>> 'Chemises' =>\&chemise,
>>> 'Chaussures' =>\&chaussures,
>>> 'Passage à la caisse' =>\&passage_a_la_caisse,
>>> 'Carte' =>\&carte_de_credit,
>>> 'Commande' =>\&commande,
>>> 'Annnulation' =>\&document_de_garde,
>>> );
>>>
>>> $Ecran_actuel = param(".Etat") || "Défaut";
>>> die "Pas d'écran pour $Ecran_actuel" unless $Etats{$Ecran_actuel};
>>
>> ^^^^^^
>> That line is printing your error message - some French equivalent of
>> "Not of ecran for card" which suggests that the user entered some
>> variation of 'Carte.' or 'carte' or ' Carte'.
>>
>> I'd change that line to
>> die "Pas d'écran pour '$Ecran_actuel'" unless $Etats{$Ecran_actuel};
>> so that you can clearly see leading spaces and other punctuation.
>>
>> <rest of program snipped>
>
> I have correct the problemes of syntax
> But after the form card(map) he indicates me 0 euro of command(order)
> I do not understand
>
>
> help help
>
> #!/usr/bin/perl -w
>
> use strict;
> use CGI qw(:standard escapeHTML);
> use CGI::Carp qw(fatalsToBrowser);
>
> my %Etats;
>
> my $Ecran_actuel;
>
> ## hachage des documents et des fonctions
>
> %Etats = (
> 'Défaut' =>\&document_de_garde,
> 'Chemises' =>\&chemise,
> 'Chaussures' =>\&chaussures,
> 'Passage à la caisse' =>\&passage_a_la_caisse,
> 'Carte' =>\&carte_de_credit,
> 'Commande' =>\&commande,
> 'Annnulation' =>\&document_de_garde,
> );
>
> $Ecran_actuel = param(".Etat") || "Défaut";
> die "Pas d'écran pour $Ecran_actuel" unless $Etats{$Ecran_actuel};
>
> ## engendre le document courant
>
> en_tete_standard();
>
> while ( my ($nom_ecran,$fonction) = each %Etats){
> $fonction->($nom_ecran eq $Ecran_actuel);
> }
>
> pied_de_page_standard();
> exit;
>
> ########################################################################
> ## fonctions d'en-tete, de pied de page, de menu #######################
> ########################################################################
>
> sub en_tete_standard {
> print header(),
> start_html(-Title => "Chemises", -BGCOLOR=>"White");
> print start_form(); ##start_multipart_form()
> ##s'il faut exporter des fichiers sur le reseau
> }
>
> sub pied_de_page_standard { print end_form(), end_html() }
>
> sub menu_boutique {
> print p(defaults("Vider mon caddie"),
> vers_doc("Chemises"),
> vers_doc("Chaussures"),
> vers_doc("Passage à la caisse"));
> }
>
> #######################################################################
> ## sous-programmes pour chaque écran ##################################
> #######################################################################
>
>
> ## le document par defaut
>
> sub document_de_garde {
> my $actif = shift;
> return unless $actif;
>
> print "<H1>salut!</H1>\n";
> print "bienvenue dans notre magasin d'habillement\ !\n",
> print "faites votre choix dans le menu ci-dessous.\n";
>
> menu_boutique();
> }
>
> ## document à partir duquel commander une chemise
>
> sub chemise {
> my $actif = shift;
> my @tailles = qw(XL L M S);
> my @couleurs = qw(Noire Blanche);
>
> my ($taille, $couleur, $compte) =
> (param("taille_chemise"), param("couleur_chemise"),
> param("nom_chemises"));
>
> ##verification des donnees reçus
> if ($compte) {
> $couleur = $couleurs[0]
> unless grep { $_ eq $couleur } @couleurs;
> $taille = $tailles[0]
> unless grep {$_ eq $taille } @tailles;
> param("couleur_chemise" , $couleur);
> param("taille_chemise" , $taille);
> }
>
> unless ( $actif ) {
> print hidden("taille_chemise") if $taille;
> print hidden("couleur_chemise") if $couleur;
> print hidden("nombre_chemises") if $compte;
> return;
> }
>
> print h1("chemises");
> print p("quelle chemise! cette petite merveille est\n","livree avec
> toutes les options.doublure de luxe,\n",
> "finitions avec toutes les options. doublure de
> luxe\n","finitions en
> coton, et un col à en avoir les\n",
> "Prix unitaire: 33.00 euros.");
>
> print h2("options");
> print p("nombre ?",textfield("nombre_chemises"));
> print p("taille ?",popup_menu("taille_chemise",\@tailles ),
> "couleur ?", popup_menu("couleur_chemise",\@couleurs ));
>
> menu_boutique();
>
> }
>
>
> ## document à partir duquel commander des chaussures
>
> sub chaussures {
> my $actif = shift;
> my @tailles = qw(35 36 37 38 39 40 41 42 43 44 45 46 47 48);
> my @couleurs = qw(Ivoire Noisette Ebene);
>
> my ( $taille, $couleur, $compte) =
> (param("taille_chaussure"), param("couleur_chaussures"),
> param("nombre_chaussures"));
>
> ##verification des donnees reçus
> if ( $compte ) {
> $couleur = $couleurs[0]
> unless grep { $_ eq $couleur } @couleurs;
> $taille = $tailles[0]
> unless grep { $_ eq $taille } @tailles;
> param("couleur_chaussures",$couleur);
> param("taille_chaussures", $taille);
> }
>
>
> unless ( $actif ) {
> print hidden("taille_chaussures") if $taille;
> print hidden("couleur_chaussures") if $couleur;
> print hidden("nombre_chaussures") if $compte;
> return;
> }
>
> print h1("chaussures");
> print p("vous ne serez jamais aussi elegant que chausse de
> ces\n", "souliers magnifiques\n",
> "prix unitaires: 49.99 euros.");
>
> print h2("options");
> print p("nombre de paires?", textfield("nombre_chaussures"));
> print p("pointure?", popup_menu("taille_chaussures",\@tailles));
> print p("teinte?",popup_menu("couleur_chaussures",\@couleurs));
>
> menu_boutique();
>
> }
>
> ## document qui affiche la commande actuelle en attente de comfirmation
>
> sub passage_a_la_caisse {
> my $actif = shift;
>
> return unless $actif;
>
> print h1("confirmation de la commande");
> print p("vous avez commande:");
> print texte_commande();
> print p("est-ce correct?\nn",
> "choissisez «Carte» pour regler ces\n",
> "objets, ou «chemises» ou\n",
> "«chaussures» pour continuer vos courses.");
> print p(vers_doc("Carte"),
> vers_doc("Chemises"),
> vers_doc("Chaussures"));
>
> }
>
> ## document pour ollecter les informations relatives à la carte de credit
>
> sub carte_de_credit {
> my $actif = shift;
> my @gadgets = qw(Nom Adresse1 Adresse2 Ville Code_postal Pats
> Telephone
> Carte Expire_en);
>
> unless ( $actif ) {
> print map { hidden($_) } @gadgets;
> return;
> }
>
> print pre ( p ("Nom\ : ",textfield("Nom")),
> p ("Adresse\ : ",textfield("Adresse1")),
> p (" ",textfield("Adresse2")),
> p ("Ville\ : ",textfield("Ville")),
> p ("Code Postal\ : ",textfield("Code_postal")),
> p ("Pays\ : ",textfield("Pays")),
> p ("Telephone\ : ",textfield("Teléphone")),
> p ("Carte numéro\ : ",textfield("Carte")),
> p ("Expire en\ : ",textfield("Expire_en")));
>
> print p ( "Selectionner «Commande» pour commander\n",
> "ces objets. selectionner «Annulation»\n");
>
> print p ( vers_doc("Commande"), vers_doc("Annulation"));
> }
>
> ## document pour terminer une commande
>
> sub commande {
> my $actif = shift;
>
> unless ( $actif) {
> return;
> }
>
> ## ici on verifie les valeurs donnees pour la carte de credit
>
> print h1("Commandé\ !");
> print p("vous avez commandé ce qui suit:");
> print texte_commande();
>
> print p (defaults ("Retour au debut"));
> }
>
> ## renvoie de l ' HTML pour la commande actuelle("vous avez ommande")
>
> sub texte_commande {
> my $html = '';
>
> if ( param ("nombre_chemises")) {
> $html .= p("vous avez commandé" , param("nombre_chemises"),
> "chemises de taille", param("taille_chemise"),
> " et de couleur " , param("couleur_chemise"),",");
> }
> if ( param ("nombre_chaussures")) {
> $html .= p("vous avez comandé",param("nombre_chaussures"),
> "paires de chaussures de pointures" ,
> param("taille_chaussures"),
> " et de teinte ", param ("couleur_chaussures"),".");
> }
> $html = p("Rien!") unless $html;
> $html .= p("pour un prix total de ",calcule_prix());
> return $html;
> }
>
> sub calcule_prix {
> my $chemises = param("nombre_chemises") || 0 ;
> my $chaussures = param("nombre_chaussures") || 0;
> return sprintf("%.2f\ euros", $chemises * 33 + $chaussures *
> 49.99);
> }
>
> sub vers_doc { submit (-NAME => ".Etat", -VALUE => shift) }
A friend ask me to do him a website of paintings.
I try to make this program work and will modify it for paintings.
------------------------------
Date: 14 Jan 2007 14:28:58 GMT
From: Abigail <abigail@abigail.be>
Subject: Re: Unix commands
Message-Id: <slrneqkfh5.ge.abigail@alexandra.abigail.be>
Uri Guttman (uri@stemsystems.com) wrote on MMMMDCCCLXXXIV September
MCMXCIII in <URL:news:x7ps9it9xh.fsf@mail.sysarch.com>:
`' >>>>> "A" == Abigail <abigail@abigail.be> writes:
`'
`' A> || > opendir my $dh => '/some/directory' or die "opendir: $!";
`' A> || > my @files = grep {!/^\./} readdir $dh;
`' A> || > closedir $dh;
`'
`' A> Because glob expands like the csh does. And the csh often does things
`' A> I don't expect. So I avoid glob. Besides, glob() has changed subtlety
`' A> between perl versions.
`'
`' then you should look at file::slurp's read_dir sub. it already
`' filters out . and .. for you as well. one feature i want to add to is
`' supporting filters but that is just an internal call to grep which is
`' not a major win.
But I already have 'ls'. I know 'ls', and I don't know 'File::Slurp'
(I assume it's spelled with capital letters and not in all lowercase).
Abigail
--
perl -le 's[$,][join$,,(split$,,($!=85))[(q[0006143730380126152532042307].
q[41342211132019313505])=~m[..]g]]e and y[yIbp][HJkP] and print'
------------------------------
Date: 14 Jan 2007 05:11:16 -0800
From: jcharth@hotmail.com
Subject: wall command from perl
Message-Id: <1168780276.261652.173360@a75g2000cwd.googlegroups.com>
hello is there a way to execute a print statement that works like the
wall command?. Just to print to console like a broadcast to command
------------------------------
Date: 6 Apr 2001 21:33:47 GMT (Last modified)
From: Perl-Users-Request@ruby.oce.orst.edu (Perl-Users-Digest Admin)
Subject: Digest Administrivia (Last modified: 6 Apr 01)
Message-Id: <null>
Administrivia:
#The Perl-Users Digest is a retransmission of the USENET newsgroup
#comp.lang.perl.misc. For subscription or unsubscription requests, send
#the single line:
#
# subscribe perl-users
#or:
# unsubscribe perl-users
#
#to almanac@ruby.oce.orst.edu.
NOTE: due to the current flood of worm email banging on ruby, the smtp
server on ruby has been shut off until further notice.
To submit articles to comp.lang.perl.announce, send your article to
clpa@perl.com.
#To request back copies (available for a week or so), send your request
#to almanac@ruby.oce.orst.edu with the command "send perl-users x.y",
#where x is the volume number and y is the issue number.
#For other requests pertaining to the digest, send mail to
#perl-users-request@ruby.oce.orst.edu. Do not waste your time or mine
#sending perl questions to the -request address, I don't have time to
#answer them even if I did know the answer.
------------------------------
End of Perl-Users Digest V11 Issue 27
*************************************
