Hi ninjazin,

First, you should really use not only 'warnings', but 'strict' as well:

    use strict;
    use warnings;
[download]

Secondly, you have to show us the code for "learn/db_connect.pl". (And is "index.pl" the thing which calls "login.pl"? It wouldn't hurt to show us that as well).

Third, assuming you have access to a webserver where you can test this, try putting the following line with the other 'use' statements:

    use CGI::Carp qw{ fatalsToBrowser };
[download]

while debugging. This will make the browser display any fatal errors, rather than having to rely on your webserver logfiles. Additionally (andx only while debugging), you can make warnings become fatal errors (which with "fatalsToBrowser" will make them conviently appear in the output, with:

    use warnings FATAL => "all";
[download]

and cleanup any warnings that appear, such as the one I'm getting:

    Use of unitialized value in numeric eq (==) at login.cgi line 50.
[download]

which is this line:

    if($ref->{'counted'} == 1){
[download]

where $ref wasn't assigned correctly because in the code:

    my $dbh = connectDB();
    my $sth = $dbh->prepare("SELECT count(id) as counted FROM perl_use
+rs WHERE `username` = ? AND `password` = ?");

    $sth->execute($uname, $pass_hash);

    my $ref = $sth->fetchrow_hashref();
[download]

$dbh never got assigned (It's part of the missing code that you haven't shown us in "learn/db_connect").

Another aid you can employ in debugging is to create a subroutine in login.pl called debug():

    sub debug {
        my ($msg) = @_;
        my $lnum = (caller)[2];

        print qq{<pre><b>Debug [line $lnum]</b>: &nbsp; $msg</pre>};
    }
[download]

now any time you want to debug any line of your code, you can call debug() with an informational message. For example, to make sure that the request method was really a "POST", do this:

    if($q->request_method eq "POST"){
        debug("Yes, the request method WAS 'POST'");
[download]

and to ascertain that you're getting the right values for $uname and $pass, you could do:

    my $uname = $q->param('uname');
    my $pass  = $q->param('pass');
    debug("Passed values were: Uname=$uname Pass=$pass");
[download]

Finally, you can really simplify your logic by refactoring your if ... else clauses to handle the reverse cases first, and get them out of the way. Also, though it's not strictly necessary, I find it easier to break long lines up into shorter ones, especially when you have long SQL text.

Here's how I would rewrite everything:

    #!/usr/bin/perl

    print "Content-type: text/html\n\n";
    require 'learn/db_connect.pl';

    use CGI;
    use CGI::Session qw();
    use CGI::Carp qw{ fatalsToBrowser };
    use DBI;

    use strict;
    # use warnings;        # Put this back in when done with FATAL => 
+"all"
    use warnings FATAL => "all";

    my $username;
    my $user_id;

    use File::Basename;
    my $prog = 'profile.cgi';

    use Digest::SHA qw(hmac_sha512_hex);
    my $q   = new CGI;
    my $cgi = new CGI;

    my $meth = $q->request_method;

    sub debug {
        my ($msg) = @_;
        my $lnum = (caller)[2];

        print qq{<pre><b>Debug [line $lnum]</b>: &nbsp; $msg</pre>};
    }

    # If it's NOT POST, go back to index.pl
    if($q->request_method ne "POST"){
        print "<script>window.location.href = 'index.pl';</script>";
        exit;
    }

    # Get parameters
    my $uname = $q->param('uname');
    my $pass  = $q->param('pass');
    debug("Passed values were: Uname=$uname Pass=$pass");

    # A better way to write if (!defined($uname) or $uname eq "") { ..
+. }
    # is if (!($uname || "")) { ... }
    ##
    if (!($uname || "")) {
        my $err = qq{error=please fill all fields};
        print "<script>window.location.href = 'index.pl?$error';</scri
+pt>";
        exit;
    }

    my $pass_hash = hmac_sha512_hex($pass);
    my $dbh = connectDB();
    my $sql = qq{
        SELECT count(id) as counted FROM perl_users
         WHERE `username` = ? AND `password` = ?
    };

    $sth->execute($uname, $pass_hash);
    my $ref = $sth->fetchrow_hashref();

    if ($ref->{'counted'} != 1) {
        my $err = qq{error=Invalid Username Or Password.};
        print "<script>window.location.href = 'index.pl?$error';</scri
+pt>";
        exit;
    }


    # Successful up to this point -- note the lack of hard-to-read,
    # multiply nested if ... else .. else ... else clauses.
    ##
    $sql = qq{
        SELECT * FROM perl_users WHERE `username` = ? AND `password` =
+ ?
    };
    my $sql001 = $dbh->prepare($sql);
    $sql001->execute($uname, $pass_hash);

    my $result = $sql001->fetchrow_hashref();

    $user_id  = $result->{'id'};
    $username = $result->{'username'};

    my $s = CGI::Session->new;
    $s->param("user_id" => $user_id);
    my $id = $s->id;

    print "<script>window.location.href = 'profile.pl?token=$id';</scr
+ipt>";
[download]