[Cpan-forum-commit] rev 182 - in trunk: . lib/CPAN t/lib/CPAN/Forum t/mech
svn at pti.co.il
svn at pti.co.il
Sun Aug 27 23:18:52 IDT 2006
Author: gabor
Date: 2006-08-27 23:18:51 +0300 (Sun, 27 Aug 2006)
New Revision: 182
Modified:
trunk/
trunk/lib/CPAN/Forum.pm
trunk/t/lib/CPAN/Forum/Test.pm
trunk/t/mech/100-auth.t
Log:
It seems I could fix the issue with the sessions in the tests
Property changes on: trunk
___________________________________________________________________
Name: svk:merge
- 8c4c90e1-83eb-0310-96eb-e7cb62807872:/local/cpan-forum:11030
+ 8c4c90e1-83eb-0310-96eb-e7cb62807872:/local/cpan-forum:11033
Modified: trunk/lib/CPAN/Forum.pm
===================================================================
--- trunk/lib/CPAN/Forum.pm 2006-08-27 04:12:55 UTC (rev 181)
+++ trunk/lib/CPAN/Forum.pm 2006-08-27 20:18:51 UTC (rev 182)
@@ -13,6 +13,7 @@
use Carp qw(cluck carp);
use Mail::Sendmail qw(sendmail);
use CGI ();
+use List::MoreUtils qw(any);
use CPAN::Forum::INC;
@@ -441,11 +442,12 @@
-path => '/',
},
SEND_COOKIE => 0,
+
);
$self->log->debug("sid: " . ($self->session->id() || ""));
$self->header_props(
- -expires => '-1d',
+ #-expires => '-1d',
# I think this this -expires causes some strange behaviour in IE
# on the other hand it is needed in Opera to make sure it won't cache pages.
-charset => "utf-8",
@@ -540,27 +542,27 @@
sub cgiapp_prerun {
my $self = shift;
- my $rm = $self->get_current_runmode();
- $self->log->debug("Current runmode: $rm");
+ $self->error_mode('error');
my $status = $self->status();
+ $self->log->debug("Status: $status");
if ($status ne "open" and not $self->session->param("admin")) {
+ $self->log->debug('site_is_closed');
$self->prerun_mode('site_is_closed');
return;
}
- $self->log->debug("Status: $status");
- $self->param(path_parameters => []);
+ my $rm = $self->_set_run_mode();
+ $self->log->debug("Current runmode: $rm");
- $rm = $self->_get_run_mode($rm);
-
- $self->log->debug("Current runmode: $rm");
$self->log->debug("Current user: " . ($self->session->param("username") || ""));
$self->log->debug("Current sid: " . ($self->session->id() || ""));
- return if grep {$rm eq $_} @free_modes;
- #return if not grep {$rm eq $_} @restricted_modes;
+ if (any {$rm eq $_} @free_modes) {
+ $self->log->debug('Free mode');
+ return;
+ }
# Redirect to login, if necessary
if (not $self->session->param('loggedin') ) {
@@ -576,8 +578,12 @@
$self->log->debug("cgiapp_prerun ends");
}
-sub _get_run_mode {
- my ($self, $rm) = @_;
+sub _set_run_mode {
+ my ($self) = @_;
+
+ $self->param(path_parameters => []);
+
+ my $rm = $self->get_current_runmode();
if (not $rm or $rm eq "home") {
if ($ENV{PATH_INFO} =~ m{^/
([^/]+) # first word till after the first /
@@ -585,16 +591,15 @@
}x) {
my $newrm = $1;
my $params = $2 || "";
- if (grep {$newrm eq $_} @urls) {
+ if (any {$newrm eq $_} @urls) {
my @params = split /\//, $params;
$self->param(path_parameters => @params ? \@params : []);
$rm = $newrm;
$self->prerun_mode($rm);
} elsif ($ENV{PATH_INFO} eq "/cgi/index.pl") {
- # TODO this is temporary to avoid unnecessary warnings
+ $self->log->error("Invalid PATH_INFO: $ENV{PATH_INFO}");
} else {
- warn "Invalid PATH_INFO: $ENV{PATH_INFO}";
- # shall I make more noise ?
+ $self->log->error("Invalid PATH_INFO: $ENV{PATH_INFO}");
}
}
}
@@ -727,6 +732,12 @@
$t->output;
}
+sub error {
+ my ($self) = @_;
+ $self->log->fatal($@) if $@;
+ $self->internal_error();
+}
+
=head2 internal_error
Gives a custom Internal error page.
@@ -771,6 +782,7 @@
my ($self, $errs) = @_;
my $q = $self->query;
+ $self->log->debug("Sending cookie using sid: " . ($self->session->id() || ""));
$self->session_cookie();
my $t = $self->load_tmpl(
"login.tmpl",
@@ -1506,12 +1518,18 @@
my $q = $self->query;
- my $group = ${$self->param("path_parameters")}[0];
+ my $group = ${$self->param("path_parameters")}[0] || '';
+ if ($group =~ /^([\w-]+)$/) {
+ $group = $1;
+ } else {
+ return $self->internal_error(
+ "Probably bad regex when checking group name for $group called in $ENV{PATH_INFO}",
+ );
+ }
$self->log->debug("show dist: '$group'");
# $group =~ s/-/::/g;
# (my $dashgroup = $group) =~ s/::/-/g;
-
my $t = $self->load_tmpl("groups.tmpl",
loop_context_vars => 1,
global_vars => 1,
@@ -1522,14 +1540,6 @@
$t->param(group => $group);
$t->param(title => "CPAN Forum - $group");
- if ($group =~ /^([\w-]+)$/) {
- $group = $1;
- } else {
- return $self->internal_error(
- "Probably bad regex when checking group name for $group called in $ENV{PATH_INFO}",
- );
- }
-
my ($gr) = CPAN::Forum::Groups->search(name => $group);
if (not $gr) {
return $self->internal_error(
@@ -2320,8 +2330,10 @@
if (not $self->session->param('loggedin') and $rm ne "login") {
$self->log->debug("not logged in, deleting session");
$self->session->delete();
- #$self->session->flush();
}
+ # flush added as the Test::WWW::Mechanize::CGI did not work well without
+ # it after we started to use file based session objects
+ $self->session->flush();
}
sub _my_sendmail {
Modified: trunk/t/lib/CPAN/Forum/Test.pm
===================================================================
--- trunk/t/lib/CPAN/Forum/Test.pm 2006-08-27 04:12:55 UTC (rev 181)
+++ trunk/t/lib/CPAN/Forum/Test.pm 2006-08-27 20:18:51 UTC (rev 182)
@@ -7,7 +7,7 @@
our @users = (
{
username => 'abcder',
- email => 'qqrq at banana.com',
+ email => 't at cpanforum.com',
},
);
@@ -59,10 +59,25 @@
init_db();
require CPAN::Forum::Users;
- my $user = CPAN::Forum::Users->create($users[0]);
+ my $user = CPAN::Forum::Users->create($users[$id]);
return $user;
}
+sub register_users {
+ my ($id, $n) = @_;
+ init_db();
+ require CPAN::Forum::Users;
+ my @users;
+ foreach my $i (1..$n) {
+ my %user;
+ $user{$_} = $i . $users[$id]{$_} foreach qw(username email);
+ push @users, CPAN::Forum::Users->create(\%user);
+ }
+ return @users;
+}
+
+
+
1;
Modified: trunk/t/mech/100-auth.t
===================================================================
--- trunk/t/mech/100-auth.t 2006-08-27 04:12:55 UTC (rev 181)
+++ trunk/t/mech/100-auth.t 2006-08-27 20:18:51 UTC (rev 182)
@@ -36,12 +36,30 @@
}
{
+ unlink glob "/tmp/cgisess_*";
+ my @session_files = glob "/tmp/cgisess_*";
+ is (@session_files, 0);
+ BEGIN { $tests += 1; }
+}
+
+{
$w_admin->get_ok($url);
$w_admin->content_like(qr{CPAN Forum});
+ is($w_admin->cookie_jar->as_string, '');
+
$w_admin->follow_link_ok({ text => 'login' });
$w_admin->content_like(qr{Login});
$w_admin->content_like(qr{Nickname});
+ my @session_files = glob "/tmp/cgisess_*";
+ is(@session_files, 1);
+ my $cookie = '';
+ my $cookie_jar = $w_admin->cookie_jar->as_string;
+ if ($cookie_jar =~ /cpanforum=(\w+)/) {
+ $cookie = $1;
+ }
+ is($session_files[0], "/tmp/cgisess_$cookie");
+
$w_admin->submit_form(
fields => {
nickname => $config{username},
@@ -49,8 +67,15 @@
},
);
$w_admin->content_like(qr{You are logged in as.*$config{username}});
- BEGIN { $tests += 6; }
+ is($w_admin->cookie_jar->as_string, $cookie_jar);
+ #diag $w_admin->cookie_jar->as_string;
+ BEGIN { $tests += 10; }
}
+{
+ my @session_files = glob "/tmp/cgisess_*";
+ is (@session_files, 1);
+ BEGIN { $tests += 1; }
+}
{
my $user = CPAN::Forum::Test::register_user(0);
@@ -79,6 +104,8 @@
$w_guest->get_ok("$url/dist/Acme-Bleach");
$w_guest->follow_link_ok({ text => 'new post' });
# check if this is the login form
+
+ # next call causes the warning when running with -w
$w_guest->submit_form(
fields => {
nickname => $user->username,
@@ -86,12 +113,13 @@
},
);
+ # this seem to be ok when done with real browser
+ #diag $w_guest->content;
$w_guest->content_like(qr{Distribution: Acme-Bleach});
$w_guest->follow_link_ok({ text => 'logout' });
BEGIN { $tests += 6; }
}
-
{
$w_user->get_ok($url);
$w_user->content_like(qr{CPAN Forum});
@@ -109,3 +137,4 @@
BEGIN { $tests += 2; }
}
+
More information about the Cpan-forum-commit
mailing list