in reply to Re^9: cookie problem
in thread cookie problem

'in html source'
Is this html code generated by another script ?

Replies are listed 'Best First'.
Re^11: cookie problem
by bigup401 (Pilgrim) on Nov 13, 2014 at 13:12 UTC

    here is full scrip with html source

    #!"C:\xampp\perl\bin\perl.exe"

use DBI;
use CGI;

$cgi = CGI->new(); 
$db ="datab";
$usr ="root";
$pwd ="";
$host ="localhost";


$dbh = DBI->connect("DBI:mysql:$db:$host", $usr, $pwd {
   AutoCommit => 0,
    RaiseError => 1,
} )   or die $DBI::errstr;

my $username = $cgi->param('username');
my $password = $cgi->param('password');

my $sth = $dbh->prepare("select id from mysql_auth where username = ? 
+AND password=?");
$sth->execute($username, $password);
 if ($x = $sth->fetchrow()) {
     $sth->finish();
     $cookie = $cgi->cookie(-name=>'id', -value=>$username);
     print $cgi->redirect(-location=>"welcome.pl", -cookie=>$cookie);
}
 else {
 print $cgi->redirect("wrong_username or password.pl");
 }

print "Content-type: text/html\n\n";
print <<START_HTML;
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http:/
+/www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
<head>
<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
<title>Untitled Document</title>
</head>

<body>
<p>username 
  <input type="text" name="username" />
</p>
<p>password 
  <input type="password" name="password" />
</p>
<p>
  <input type="submit" name="button"  value="Submit" />
</p>
</body>
</html>

START_HTML

    [download]
[reply]
[d/l]

      You're being a little inconsistent in your code postings. For example is the cookie name 'id' or 'login'?

      Why are you using fetchrow instead of fetchrow_array? The former is an old alias for the later and even was removed from the documentation. To learn of it, you need to search the module's source code or have old documentation.

      Why are you assigning $x but never use it? BTW, the author recommends against calling fetchrow (or fetchrow_array) in scalar context. You should call it in list context. And most importantly, why aren't you using the strict and warnings pragmas?

      Here's an untested rewrite of your 2 scripts which should get you closer to your goal.

      Edit: oops - I made a couple updates to the posted script (i.e., I moved the db stuff to a sub) and poj spotted a goof on my part in the placement of $welcome and $login var assignments. Should be fixed now.

      home.pl 

      use strict;
use warnings;
use DBI;
use CGI;
use CGI::Carp qw(fatalsToBrowser);

my $cgi      = CGI->new();
my $username = $cgi->param('username');
my $password = $cgi->param('password');
my $id       = get_uid($username, $password);
my $welcome  = 'http://localhost/cgi-bin/welcome.pl';
my $login    = 'http://localhost/cgi-bin/login.pl';

if ($id) {
    my $cookie = $cgi->cookie(-name => 'login', -value => $username);
    print $cgi->redirect(-location => $welcome, -cookie => $cookie);
}
else {
    print $cgi->redirect($login);
}

exit;

sub get_uid {
    my $username = shift;
    my $password = shift;
    my $db       = 'datab';
    my $usr      = 'root';
    my $pwd      = '';
    my $host     = 'localhost';

    my $dbh = DBI->connect("DBI:mysql:$db:$host", $usr, $pwd,
                           {AutoCommit => 0, RaiseError => 1})
            or die $DBI::errstr;

    my $sth = $dbh->prepare("SELECT id
                            FROM mysql_auth
                            WHERE username = ? AND password = ?");

    $sth->execute($username, $password);
    my ($id) = $sth->fetchrow_array;
    $sth->finish();

    return $id;
}

      [download]

      welcome.pl

      use strict;
use warnings;
use DBI;
use CGI;
use CGI::Carp qw(fatalsToBrowser);

my $cgi   = CGI->new(); 
my $sid   = $cgi->cookie('login');
my $login = 'http://localhost/cgi-bin/login.pl';

if ( ! $sid ){ # exit and return to login.pl! we have no cookies 
    print $cgi->redirect($login);
}

#start using the page! we have cookies
print $cgi->header();

# etc

      [download]

[reply]
[d/l]
[select]
        thanks it worked now bt i had to remove some some codes u wrote i removed sub sub get_uid {return $id; } i remove my $id = get_uid($username, $password); thanks for the idea, wow anyway am feeling good by using fetchrow instead of using fetchrow_array i know its nolonger supported bt in other way there is were it helps me
[reply]

In Section Seekers of Perl Wisdom