Hello,
I wasn't sure if I should post here, on the Mason list, or elsewhere;
hopefully someone here can help.
I'm using mp1, Mason, Apache::DBI, and MySQL InnoDB tables.
When adding a second database connection to our code, a very simple
getUserIdFromSession subroutine returns inconsistent values. Removing
the second connection fixes the problem.
I added warnings inside the getUserIdFromSession subroutine (below) to
track down where the problem might be, but:
- the DBH connection is always to the proper database (I printed out a
SHOW TABLES statement).
- it always receives the cookie value correctly
- it always falls into the else { return $userId; } portion
- sometimes it returns the value, other times it returns undef
While connected outside of apache to the database server, I can see the
record in the tUserSession table using the same SQL statement the code
is using.
If I simply comment out the connection to $dbhEmail in the autohandler,
the problem goes away, and the subroutine always returns the proper value.
I've been scratching my head for awhile on this one, but can't see why
adding another global and a different connection would cause this.
Thanks in advance,
Matthew
httpd.conf
----------
PerlAddVar MasonAllowGlobals $dbh
PerlAddVar MasonAllowGlobals $dbhEmail
startup.pl
----------
use Apache::DBI ();
use DBI ();
use DBD::mysql ();
autohandler
-----------
<%once>
use Apache::Cookie qw();
use Foo::Auth;
use Foo::Constants;
use Foo::User;
</%once>
<%init>
$dbh =
DBI->connect("DBI:mysql:$CONSTANTS{DB_BASE}content:$CONSTANTS{DB_HOST}",
$CONSTANTS{DB_USER}, $CONSTANTS{DB_PASS},
{AutoCommit => 0, RaiseError => 1, PrintError => 0}
) or die "ERROR: Cannot connect to database";
$dbhEmail =
DBI->connect("DBI:mysql:$CONSTANTS{DB_BASE}email:$CONSTANTS{DB_HOST}",
$CONSTANTS{DB_USER}, $CONSTANTS{DB_PASS},
{AutoCommit => 0, RaiseError => 1, PrintError
=> 0}
) or die "ERROR: Cannot connect to database";
</%init>
<%perl>
my(%cookies) = Apache::Cookie->fetch();
# -- login session --
my($userId) = getUserIdFromSession($dbh, \%cookies);
my($userObject) = undef;
if (defined($userId)) {
$userObject = Foo::User->new()->init($dbh);
unless ($userObject->load([EMAIL PROTECTED], $userId)) {
$userObject = undef;
}
}
</%perl>
<% $m->call_next( userObject => $userObject ) %>
Foo/Auth.pm
-----------
package Foo::Auth;
@ISA = qw( Exporter );
use strict;
use warnings;
our($SESSION_COOKIE_NAME) = 'user_session';
our($SESSION_KEY_LENGTH) = 50;
our(@EXPORT) = qw( $SESSION_KEY_LENGTH getUserIdFromSession
doLogin );
sub getUserIdFromSession {
my($dbh, $rCookies) = @_;
croak 'API' unless defined($dbh);
croak 'API' unless defined($rCookies) && ref($rCookies) eq 'HASH';
my($cookie) = $rCookies->{$SESSION_COOKIE_NAME};
return undef unless defined($cookie);
my($sessionKey) = $cookie->value();
return undef unless defined($sessionKey) && length($sessionKey) ==
$SESSION_KEY_LENGTH;
my($userId) = eval {
return $dbh->selectrow_array(q{
SELECT userId
FROM tUserSession
WHERE sessionKey=? AND expiresOn>NOW()
}, undef, $sessionKey);
};
if ($@) {
return undef;
} else {
return $userId;
}
}
sub doLogin {
my($dbh, $rErrors, $username, $ip) = @_;
my($sessionKey) = _createSessionKey();
eval {
my($userId) = $dbh->selectrow_array(q{
SELECT userId
FROM tUser
WHERE userName=?
}, undef, $username);
$dbh->do(q{
INSERT INTO tUserSession (sessionKey, userId, createdOn,
createdIp, expiresOn)
VALUES (?,?,NOW(),?,ADDDATE(NOW(), INTERVAL 1 DAY))
}, undef, $sessionKey, $userId, $ip);
$dbh->commit();
};
if ($@) {
push @$rErrors, $@;
eval { $dbh->rollback() };
push @$rErrors, $@ if $@;
return undef;
} else {
return $sessionKey;
}
}
1;
