[28782] in Perl-Users-Digest
Perl-Users Digest, Issue: 26 Volume: 11
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Sun Jan 14 11:05:40 2007
Date: Sun, 14 Jan 2007 08:05:05 -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: 26
Today's topics:
Re: Ascii characters in a loop <rvtol+news@isolution.nl>
Re: Ascii characters in a loop <RedGrittyBrick@SpamWeary.foo>
Re: Ascii characters in a loop (Mark Hobley)
Re: Ascii characters in a loop (Mark Hobley)
Re: Graph in Perl <zentara@highstream.net>
help me problems cgi <john.swilting@wanadoo.fr>
Re: help me problems cgi <john.swilting@wanadoo.fr>
Re: help me problems cgi <john.swilting@wanadoo.fr>
Re: matching a complicated url in a regular expression <rvtol+news@isolution.nl>
Digest Administrivia (Last modified: 6 Apr 01) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: Sun, 14 Jan 2007 12:33:14 +0100
From: "Dr.Ruud" <rvtol+news@isolution.nl>
Subject: Re: Ascii characters in a loop
Message-Id: <eod82e.1eo.1@news.isolution.nl>
Mark Hobley schreef:
> The following loop works fine in Perl:
>
> for ($l = 'a'; $l le 'y'; $l++) {
> print "$l";
> }
>
> However, if I try to loop from a through to z, the loop does not work:
>
> for ($l = 'a'; $l le 'z'; $l++) {
> print "$l";
> }
It does work, but not in the way that you suspect(ed).
See also perldoc -q quoting.
> I know that a for each loop would work, but that is not what I want.
Better mention what you do want.
--
Affijn, Ruud
"Gewoon is een tijger."
------------------------------
Date: Sun, 14 Jan 2007 12:59:29 +0000
From: RedGrittyBrick <RedGrittyBrick@SpamWeary.foo>
Subject: Re: Ascii characters in a loop
Message-Id: <8Ladncq16tSttDfYRVnytwA@bt.com>
Mark Hobley wrote:
> John Bokma <john@castleamber.com> wrote:
>> My guess: because he wants to know why this one "doesn't work" instead of
>> reading: "use this instead".
>
> I am writing Perl documentation. All these points seem to be missed in the
> reference books that I am using, which incidently are extremely big and run
> into several thousand pages each and cost me quite a few quid.
>
> It seems strange that if I increment $l (which equals 'z') then I now have a
> value that is comparitively less than 'z'.
>
> This looks like a bug to me, at least in the context of an a to z loop.
>
Probably because you are thinking "for $x := 'a' to 'z'" but writing
something completely different.
In my view, you *don't* have an a to z loop. You have an initializer;
loop-test; counting-expression loop.
I've always disliked them, I find they're mostly used for shooting
yourself in the foot or doing something more clearly expressed as a
foreach or numeric-range loop.
http://en.wikipedia.org/wiki/For_loop#Kinds_of_for_loops
Saying "in the context of" suggests that you'd like 'z' le 'aa' to
sometimes return true and sometimes return false depending in whether
the expression was being evaluated in the context of a for loop or not.
I think that would be a bad thing. In the code below the value returned
by my inorder subroutine would have to depend on whether it was called
from an expression that was part of a for loop. This would be horribly
hard to justify.
#!perl
use strict;
use warnings;
if (inorder('aa','z')) { print 'ordered OK'; }
for (my $x='x'; inorder($x, 'z'); $x++) {
print $x,' ';
}
sub inorder {
my ($p, $q) = @_;
$p le $q;
}
And of course, if you are using a three-part for loop to sort a
dictionary you'd want the current behaviour of the le operator even in
the context of a for loop.
------------------------------
Date: Sun, 14 Jan 2007 14:04:20 GMT
From: markhobley@hotpop.deletethisbit.com (Mark Hobley)
Subject: Re: Ascii characters in a loop
Message-Id: <5vnp74-26m.ln1@neptune.markhobley.yi.org>
John Bokma <john@castleamber.com> wrote:
> for ($l = 'a'; $l ne 'aa'; $l++) {
> print "$l";
> }
Yeah! I just think that 'a to z' looks far nicer late on a Friday night when I
am trying to debug code.
I need to test reverse loops, capitals, jumping by more than one letter at a
time now to see if there are any more nasty surprises.
I often loop through alphabetical sequences in code.
Regards,
Mark.
--
Mark Hobley
393 Quinton Road West
QUINTON
Birmingham
B32 1QE
Telephone: (0121) 247 1596
International: 0044 121 247 1596
Email: markhobley at hotpop dot donottypethisbit com
http://markhobley.yi.org/
------------------------------
Date: Sun, 14 Jan 2007 14:04:20 GMT
From: markhobley@hotpop.deletethisbit.com (Mark Hobley)
Subject: Re: Ascii characters in a loop
Message-Id: <m8np74-26m.ln1@neptune.markhobley.yi.org>
Dr.Ruud <rvtol+news@isolution.nl> wrote:
> Better mention what you do want.
I am documenting Perl and at the moment I am documenting loops, so I need to
know any place where choosing a particular value will cause different behaviour
than choosing another value.
I often use alphabetical increments in code, so anywhere that choosing a
particular values for alphabetical ranges requires a change in syntax to
perform across those range needs to be noted.
Regards,
Mark.
--
Mark Hobley
393 Quinton Road West
QUINTON
Birmingham
B32 1QE
Telephone: (0121) 247 1596
International: 0044 121 247 1596
Email: markhobley at hotpop dot donottypethisbit com
http://markhobley.yi.org/
------------------------------
Date: Sun, 14 Jan 2007 07:21:23 -0500
From: zentara <zentara@highstream.net>
Subject: Re: Graph in Perl
Message-Id: <9t7kq2p7b35fgoi3lcmh1j40hd907mli9g@4ax.com>
On 14 Jan 2007 00:48:36 -0800, "jupiter" <anil.jupiter9@gmail.com>
wrote:
>what i want is when i start program it should extract webpage with
>lwpcook module
>process data means clean up n extract vales i want
>make a database to store these values then
>it should do some calculation on data already stored
>display them within program (dont want any graphic file) n update as
>new data comes (using multithreading)
>
>i am able to extract data but not sure how to handle database issue n
>graph issue as i know perl is not database oriented script language nor
>graphics oriented. so should i do what i want in perl or vb is better
>option?
wel, yor righting style makes it hard for me to fig out what u want.
but since you are already using Perl, with LWP and the Database,
you could make graphs with many different Perl modules. GD is
often used.
--
I'm not really a human, but I play one on earth.
http://zentara.net/japh.html
------------------------------
Date: Sun, 14 Jan 2007 15:42:41 +0100
From: "john.swilting" <john.swilting@wanadoo.fr>
Subject: help me problems cgi
Message-Id: <45aa4160$0$27404$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: Sun, 14 Jan 2007 16:10:08 +0100
From: "john.swilting" <john.swilting@wanadoo.fr>
Subject: Re: help me problems cgi
Message-Id: <45aa47cf$0$5105$ba4acef3@news.orange.fr>
john.swilting wrote:
> 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.
That walks(works) for shoes not for shirts
------------------------------
Date: Sun, 14 Jan 2007 16:21:02 +0100
From: "john.swilting" <john.swilting@wanadoo.fr>
Subject: Re: help me problems cgi
Message-Id: <45aa4a5d$0$5067$ba4acef3@news.orange.fr>
john.swilting wrote:
> 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.
its ok
problems syntax
perl is permissive
sorry for flood
my name is serge
i am french
------------------------------
Date: Sun, 14 Jan 2007 13:59:44 +0100
From: "Dr.Ruud" <rvtol+news@isolution.nl>
Subject: Re: matching a complicated url in a regular expression
Message-Id: <eodd2h.1ig.1@news.isolution.nl>
Nospam schreef:
> How do I place it in a regular expresion to match the whole url
Regexp::Common::URI
--
Affijn, Ruud
"Gewoon is een tijger."
------------------------------
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 26
*************************************
