Beefy Boxes and Bandwidth Generously Provided by pair Networks
Problems? Is your data what you think it is?

Re: CGI::Session - non-stop session creation problem

by Miguel (Friar)
on Apr 07, 2005 at 11:26 UTC ( #445609=note: print w/ replies, xml ) Need Help??

in reply to CGI::Session - non-stop session creation problem

A short but functional example:

#!/usr/bin/perl -Tw use strict; use CGI; use CGI::Session qw/ip-match/; my $q = new CGI; my $name = "name"; my $password = "password"; my $f_name = $q->param("name") || ""; my $f_password = $q->param("password") || ""; my $session = new CGI::Session(undef,$q,{Directory=>'/tmp'}); $session->expire('+1h'); my $sessionid=$q->cookie("cgisessid")||$session->param("_SESSION_ID"); my $cookie_id = $q->cookie(CGISESSID=>$session->id); $session->delete() if $q->param("out"); if (!$session->param("name") && ValidateLogin($f_name,$f_password) == 0) { Form(); } else { LogedIn(); } sub Form { print $q->header, $q->start_html, $q->start_form, "Name: ", $q->textfield({NAME=>'name',OVERRIDE=>1}), $q->br, "Password: ", $q->password_field({NAME=>'password',OVERRIDE=>1}), $q->br, $q->submit("Login"), $q->end_form, "Sesson ID: ", $session->id, $q->p,"HINT: Use 'name' and 'password' to login",$q->end_html; } sub LogedIn { $session->param("name",$q->param("name")); print $q->header({COOKIE=>$cookie_id}), $q->start_html, "LoggedIn", $q->br, "SESSION(id): ", $session->id, $q->br, "SESSION(name): ", $session->param("name"), $q->br; print $q->start_form, $q->hidden({NAME=>'out',VALUE=>1}), $q->submit("LogOut"), $q->end_form, $q->end_html; } sub ValidateLogin { my ($n,$p) = @_; $n ne $name && $p ne $password ? 0 : 1; }

Hope it helps.

Comment on Re: CGI::Session - non-stop session creation problem
Download Code

Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://445609]
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others chanting in the Monastery: (13)
As of 2014-11-27 11:17 GMT
Find Nodes?
    Voting Booth?

    My preferred Perl binaries come from:

    Results (184 votes), past polls