Gossamer Forum
Home : General : Perl Programming :

Small problems with a perl script...

Quote Reply
Small problems with a perl script...
Okey, here's the deal.
I'm making a small script to a page.
It's a form script.
I'm having some small error problems.
The script itself reads the form, sends it to the webmaster, storing all into a file and showing the person a thank you page.
I'm not sure what I have done wrong, but that's what I want you to find out.
PS! All the text is in norwegian, but that want be a problem. The perl is the same!

-----------------------------------------

#!/usr/bin/perl


# Først så sier vi til scriptet at det som kommer nedenfor er tekst og html.
print "Content-type:text/html\n\n";

$count = 0;

# Så leser vi av sjemaet.
read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
@pairs = split(/&/, $buffer);
foreach $pair (@pairs) {
($name, $value) = split(/=/, $pair);
$value =~ tr/+/ /;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$value =~ s/\n/ /g; # replace newlines with spaces
$value =~ s/\r//g; # remove hard returns
$value =~ s/\cM//g; # delete ^M's
$FORM{$name} = $value;
}


$count++;

if ($count >= 30) {

print "Vi beklager så mye, men det er ikke lengre ledige plasser. Det du kan gjøre er å stikke innom en tur på lørdag uten PC. Du får sikkert prøve til noen!\n";
}


# Så åpner vi filen vi skal legge alle informasjon inn i.
open (OUTF, ">>dataparty.out") or dienice("Kunne ikke åpne dataparty.out for skriving: $!");

# Så låser vi filen slik at ingen andre cgi script kan skrive til den samtidig.
# Dette gjør vi for at alt ikke skal bli slettet.
flock(OUTF,2);

#Tilbakestiller telleren i slutten av scriptet, hvis noen skriver til scriptet mens vi venter på locken.
seek(OUTF,0,2);

# Da er vi klar til å printe informasjonen til filen.
print OUTF "Navn: $FORM{'navn'} | Epost: $FORM{'Email'} | Alder: $FORM{'Alder'}\n";
print OUTF "Antall PC: $FORM{'antall_pc'} | Prossesor hastighet: $FORM{'cpu'} (mhz)\n";
print OUTF "Ram: $FORM{'ram'} (mb) | Operativsystem: $FORM{'operativsystem'} \n";
print OUTF "Nettverkskort: $FORM{'nettverkkort_hastihet'} (hastighet 10 /100) \n";
print OUTF "Jeg ønsker å spille: $FORM{'jeg_vil_spille'} i nettverk. | Filmer jeg vil se: $FORM{'film'}\n";
print OUTF "Jeg vil spise: $FORM{'mat_i_cafe'} | Annet utstyr: $FORM{'utstyr'}\n";
close(OUTF);


# Ok, da er det klart!
# Så må vi finne ut hvor mailprogrammet er på serveren.
$mailprog ='/usr/lib/sendmail';

# Så kommer adressen til personen som skal motta mailene.
$recipient = 'address@host.com';

# Så åpner vi mailprogrammet eller viser error beskjeden.
open (MAIL, "|$mailprog -t") or dienice("Kan ikke finne $mailprog!\n");

# Vi viser hvem vi sender mailen til.
print MAIL "To: $recipient\n";

# Så printer vi ut temaet så mottaker av mailen vet at det er fra scriptet.
# De to \n\n tegnene viser at alt som blir skrevet nedenfor kommer i selve
# 'magen' av mailen.
print MAIL "Subject: Ny deltaker på dataparty\n\n";

foreach $key (keys(%FORM)) {
print MAIL "$key = $FORM{$key}\n";

# Nå er vi ferdig med å skrive mailen så da må vi huske å lukke mailprogrammet.
close(MAIL);

# Så printer vi ut siden de kommer til når mailen er sendt.

print <<EndHTML;
<html>
<head> <title>Takk for din innsendelse.</title>
<head>
<body bgcolor=black text=white link=blue>
Takk for at du meldte deg på datapartyet.<br>
Vi har mottat din informasjon og du er med.<br>
Hvis du lurer på om det er fult så kan vi bekrefte at det ikke er det.<br>
Til nå har $count meldt seg på.<br>
Når det er kommet til 30 så kan ikke flere melde seg på.<br>
Her kommer informasjon du fylte ut:<p>


</body>
</html>
EndHTML


# Og til slutt. Hvis det var en error når vi skulle åpne mailprogrammet så viser
# vi erroren i denne sub'en.

sub dienice {
my($errmsg) = @_;
print "<h2>Error!</h2>\n";
print "$errmsg<p>\n";
print "</body></html>\n";
exit;
}

---------------------------------------------





Quote Reply
Re: [perlman] Small problems with a perl script... In reply to
Hmm the error may be due to you having no "From" field when creating the email.

You may want to add:

use CGI::Carp qw(fatalsToBrowser);

...under #!/usr/bin/perl

I'd recommend using CGI.pm for this as it would cut out a large chunk of the code.

Also in dienice() you use @_ but only one argument is ever passed to the sub so shift will suffice. Also this is not a big deal but you have </body></html> in dienice() but you don't start the sub with <html><head></head><body>

What is $count for?


Quote Reply
Re: [RedRum] Small problems with a perl script... In reply to
Hi again!
This script is my first so I don't want to use CGI.pm
(I don't know how to use it either!)
I added use CGI::Carp qw(fatalsToBrowser); right below the top line.
And I added the From part and removed the count thing. The thing I wanted with $count was the number of posts. Don't know how to do it so I just tried a thing.
I uploaded everything, but now I get another error.
Here's the code I use:


#!/usr/bin/perl
use CGI::Carp qw(fatalsToBrowser);

# Først så sier vi til scriptet at det som kommer nedenfor er tekst og html.
print "Content-type:text/html\n\n";


# Så leser vi av sjemaet.
read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
@pairs = split(/&/, $buffer);
foreach $pair (@pairs) {
($name, $value) = split(/=/, $pair);
$value =~ tr/+/ /;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$value =~ s/\n/ /g; # replace newlines with spaces
$value =~ s/\r//g; # remove hard returns
$value =~ s/\cM//g; # delete ^M's
$FORM{$name} = $value;
}



# Så åpner vi filen vi skal legge alle informasjon inn i.
open (OUTF, ">>dataparty.out") or dienice("Kunne ikke åpne dataparty.out for skriving: $!");

# Så låser vi filen slik at ingen andre cgi script kan skrive til den samtidig.
# Dette gjør vi for at alt ikke skal bli slettet.
flock(OUTF,2);

#Tilbakestiller telleren i slutten av scriptet, hvis noen skriver til scriptet mens vi venter på locken.
seek(OUTF,0,2);

# Da er vi klar til å printe informasjonen til filen.
print OUTF "Navn: $FORM{'navn'} | Epost: $FORM{'Email'} | Alder: $FORM{'Alder'}\n";
print OUTF "Antall PC: $FORM{'antall_pc'} | Prossesor hastighet: $FORM{'cpu'} (mhz)\n";
print OUTF "Ram: $FORM{'ram'} (mb) | Operativsystem: $FORM{'operativsystem'} \n";
print OUTF "Nettverkskort: $FORM{'nettverkkort_hastihet'} (hastighet 10 /100) \n";
print OUTF "Jeg ønsker å spille: $FORM{'jeg_vil_spille'} i nettverk. | Filmer jeg vil se: $FORM{'film'}\n";
print OUTF "Jeg vil spise: $FORM{'mat_i_cafe'} | Annet utstyr: $FORM{'utstyr'}\n";
close(OUTF);


# Ok, da er det klart!
# Så må vi finne ut hvor mailprogrammet er på serveren.
$mailprog ='/usr/sbin/sendmail';

# Så kommer adressen til personen som skal motta mailene.
$recipient = 'kbergem@hotmail.com';

# Så åpner vi mailprogrammet eller viser error beskjeden.
open (MAIL, "|$mailprog -t") or dienice("Kan ikke finne $mailprog!\n");

# Vi viser hvem vi sender mailen til.
print MAIL "To: $recipient\n";

# Vi viser hvem vi sender mailen til.
print MAIL "From: $FORM{'Email'}\n";

# Så printer vi ut temaet så mottaker av mailen vet at det er fra scriptet.
# De to \n\n tegnene viser at alt som blir skrevet nedenfor kommer i selve
# 'magen' av mailen.
print MAIL "Subject: Ny deltaker på dataparty\n\n";

foreach $key (keys(%FORM)) {
print MAIL "$key = $FORM{$key}\n";

# Nå er vi ferdig med å skrive mailen så da må vi huske å lukke mailprogrammet.
close(MAIL);

# Så printer vi ut siden de kommer til når mailen er sendt.

print <<EndHTML;
<html>
<head> <title>Takk for din innsendelse.</title>
<head>
<body bgcolor=black text=white link=blue>
Takk for at du meldte deg på datapartyet.<br>
Vi har mottat din informasjon og du er med.<br>
Hvis du lurer på om det er fult så kan vi bekrefte at det ikke er det.<br>
Når det er kommet til 30 så kan ikke flere melde seg på.<br>
Her kommer informasjon du fylte ut:<p>


</body>
</html>
EndHTML


# Og til slutt. Hvis det var en error når vi skulle åpne mailprogrammet så viser
# vi erroren i denne sub'en.

sub dienice {
my($errmsg) = @_;
print "<h2>Error!</h2>\n";
print "$errmsg<p>\n";
exit;
}





Quote Reply
Re: [perlman] Small problems with a perl script... In reply to
You are missing a bracket....

foreach $key (keys(%FORM)) {
print MAIL "$key = $FORM{$key}\n";


...should be:

foreach $key (keys(%FORM)) {
print MAIL "$key = $FORM{$key}\n";
}