On 04/05/11 14:44, Agnello George wrote:
if i remvove this line for my script login.pl the web server log gives me
[Wed May 04 19:14:30 2011] [error] [client 192.168.2.94] malformed
header from script. Bad header=<form action="/cgi-bin/login.p:
login.pl
and browser gives me internal server error .
This may be because $evalue !=3 and therefore the if block does not
execute. You need to send the header in all cases. Try changing your if
block to:
if ( $evalue == 3 ) {
my $cookie = $cgi->cookie(CGISESSID => $session->id);
print $cgi->header( -cookie=>$cookie );
deploy_page();
}
else {
print $cgi->header;
}
Pete
The $cgi->header call is also outputting the HTTP header, but you have
already created it with the line above. That is why you can see the
generated header in your browser.
If $evalue != 3 you may want to call $cgi->header without the cookie
depending on the behaviour you want.
Cheers,
Pete
On 04/05/11 14:23, Agnello George wrote:
Hi
In my script i am using template toolkit. I am trying to set the
cookie in my browser but all that it does is it prints the following
output on my broswer :
Set-Cookie: CGISESSID=f032fc8982a1ae022c4f51baa3bc4143; path=/ Date:
Wed, 04 May 2011 13:07:40 GMT Content-Type: text/html;
charset=ISO-8859-1
here is my script , how do is set cookie
=========================
#!/usr/bin/perl
use strict ;
use warnings ;
use Template;
use Data::Dumper;
use CGI::Session;
use CGI;
print "Content-type: text/html\n\n";
my $cgi = new CGI;
my $session = new CGI::Session(undef, $cgi, {Directory=>'/tmp'});
my $tt = Template->new( INCLUDE_PATH => "/var/www/html/template" ) ||
die "template process failed:$!";
my %tag;
$session->clear();
$session->expire('+2h');
my $evalue = init($cgi, $session);
if ( $evalue == 3 ) {
my $cookie = $cgi->cookie(CGISESSID => $session->id);
print $cgi->header( -cookie=>$cookie );
deploy_page();
}
unless ( $session->param("~logged-in") ) {
login_page();
$session->delete();
exit(0);
}
sub init {
my ($cgi,$session) = @_; # receive two args
if ( $session->param("~logged-in") ) {
return 3 ; # if logged in, don't bother going further
}
my $lg_name = $cgi->param("lg_name") or "dfdsfsd";
my $lg_psswd = $cgi->param("lg_password") or "dsfdsfsd";
# if we came this far, user did submit the login form
# so let's try to load his/her profile if name/psswds match
if ( my $profile = _load_profile($lg_name, $lg_psswd) ) {
$session->param("~profile", $profile);
$session->param("~logged-in", 1);
$session->clear(["~login-trials"]);
return 3;
}
}
sub _load_profile {
my ($lg_name, $lg_psswd) = @_;
local $/ = "\n";
unless (sysopen(PROFILES, "profiles.txt", O_RDONLY) ) {
die "Couldnt open profiles.txt: $!";
}
while (<PROFILES> ) {
/^(\n|#)/ and next;
chomp;
my ($n, $p, $e) = split (/\s+/,$_) ;
if ( ($n eq $lg_name)&& ($p eq $lg_psswd) ) {
my $p_mask = "x" . length($p);
return {username=>$n, password=>$p_mask, email=>$e};
}
}
close(PROFILES);
return undef;
}
sub deploy_page {
$tt->process("form/form.html") || die $tt->error();
}
sub login_page {
$tt->process("login.tmpl",\%tag) || die $tt->error();
}
==============================================
thanks for all the help !!
NET-A-PORTER.COM Irresistible fashion at your fingertips
______________________________________________________________________
CONFIDENTIALITY NOTICE
The information in this email is confidential and is intended solely for the
addressee. Access to this email by anyone else is unauthorised. If you are
not the intended recipient, you must not read, use or disseminate the
information. Any views expressed in this message are those of the individual
sender, except where the sender specifically states them to be the views of
Net a Porter Ltd.
Net A Porter Ltd is a company registered in England& Wales Number: 3820604
Registered Office: 1 The Village Offices, Westfield, Ariel Way, London, W12
7GF
_____________________________________________________________________
--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/
--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/
