[Cpan-forum-commit] rev 167 - in trunk: . lib/CPAN t/lib/CPAN/Forum t/mech
svn at pti.co.il
svn at pti.co.il
Fri Aug 25 18:15:15 IDT 2006
Author: gabor
Date: 2006-08-25 18:15:15 +0300 (Fri, 25 Aug 2006)
New Revision: 167
Removed:
trunk/t/lib/CPAN/Forum/TestApp.pm
Modified:
trunk/
trunk/lib/CPAN/Forum.pm
trunk/t/mech/011-register.t
trunk/t/mech/100-auth.t
Log:
remove TestApp as we are not using it anymore
remove redirection as it only causes problems in testing
Property changes on: trunk
___________________________________________________________________
Name: svk:merge
- 8c4c90e1-83eb-0310-96eb-e7cb62807872:/local/cpan-forum:10994
+ 8c4c90e1-83eb-0310-96eb-e7cb62807872:/local/cpan-forum:10995
Modified: trunk/lib/CPAN/Forum.pm
===================================================================
--- trunk/lib/CPAN/Forum.pm 2006-08-25 15:15:09 UTC (rev 166)
+++ trunk/lib/CPAN/Forum.pm 2006-08-25 15:15:15 UTC (rev 167)
@@ -2,7 +2,7 @@
use strict;
use warnings;
-our $VERSION = "0.11_01";
+our $VERSION = "0.11_02";
use base "CGI::Application";
use CGI::Application::Plugin::Session;
@@ -254,6 +254,13 @@
Create links http://www.cpanforum.com/rss/author/PAUSEID
These links don't seem to contain any data http://www.cpanforum.com/rss/dist/OpenOffice-OODoc
+Check if the database is writable by the process and give appropriate error
+message if not.
+If the directory of the database is not writable and logging was setup the
+application fails.
+
+
+
Subject field:
- <= 80 chars
- Can contain any characters, we'll escape them when showing on the web site
@@ -398,6 +405,76 @@
Use this for mapping:
grep INCLUDE *| grep -v navigation.tmpl | grep -v footer.tmpl | grep -v head.tmpl
+=head1 Schema
+
+=over 4
+
+=item configure
+
+=item grouprelations
+
+NOT USED
+
+=item groups
+
+ name - name of the module (using - separator)
+ gtype - is
+ status - NOT USED
+
+Every CPAN module has an antry in this table.
+
+=item posts
+
+ gid
+ uid
+ parent
+ thread
+ hidden
+ subject
+ text
+ date
+
+=item sessions
+
+Used for session management
+
+=item subscriptions
+
+ uid
+ gid
+ allposts
+ starters
+ followups
+ announcements
+
+=item usergroups
+
+ name - name of the group
+
+Currently we only have the 'admin' group
+
+=item user_in_group
+
+ uid - user id
+ gid - group id
+
+ Members of the usergroup.
+
+=item users
+
+ username - should be lower case,
+ password -
+ email - should be kept in lower case
+ fname
+ lname
+ update_on_new_user -
+ TRUE/FALSE, should be only relevant for users in the 'admin' group
+ status - NOT USED
+
+Registered users
+
+=back
+
=head1 METHODS
=cut
@@ -541,6 +618,27 @@
$self->param(path_parameters => []);
+ $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;
+
+ # Redirect to login, if necessary
+ if (not $self->session->param('loggedin') ) {
+ $self->log->debug("Showing login");
+ $self->session->param(request => $rm);
+ $self->prerun_mode('login');
+ return;
+ }
+ $self->log->debug("cgiapp_prerun ends");
+}
+
+sub _get_run_mode {
+ my ($self, $rm) = @_;
if (not $rm or $rm eq "home") {
if ($ENV{PATH_INFO} =~ m{^/
([^/]+) # first word till after the first /
@@ -561,26 +659,9 @@
}
}
}
-
- $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;
-
- # Redirect to login, if necessary
- if (not $self->session->param('loggedin') ) {
- $self->log->debug("Redirecting to login");
- $self->session->param(request => $ENV{PATH_INFO});
- $self->header_type("redirect");
- $self->header_props(-url => "http://$ENV{HTTP_HOST}/login/");
- return;
- }
- $self->log->debug("cgiapp_prerun ends");
+ return $rm;
}
-
=head2 autoload
Just to avoid real crashes when user types in bad URLs that happen to include
@@ -667,18 +748,6 @@
}
-=head2 redirect_home
-
-Just to easily redirect to the home page
-
-=cut
-
-sub redirect_home {
- my $self = shift;
- $self->header_type("redirect");
- $self->header_props(-url => "http://$ENV{HTTP_HOST}/");
-}
-
=head2 about
About box with some statistics.
@@ -810,13 +879,21 @@
}
}
- my $request = $session->param("request") || "";
+ my $request = $session->param("request") || "home";
$session->param("request" => "");
$session->flush();
$self->log->debug("Session flushed after login " . $session->param('loggedin'));
- $self->header_type("redirect");
- $request .= "/" if $request !~ m{/$};
- $self->header_props(-url => "http://$ENV{HTTP_HOST}/$request");
+ $self->log->debug("Request redirection: '$request'");
+ no strict 'refs';
+ my $response;
+ eval {
+ $response = &$request($self);
+ };
+ if ($@) {
+ $self->log->error($@);
+ die $@; # TODO: send error page?
+ }
+ return $response;
}
@@ -841,7 +918,7 @@
$session->flush();
$self->log->debug("logged out '$username'");
- $self->redirect_home;
+ $self->home;
}
@@ -1333,7 +1410,7 @@
$self->notify($pid);
- $self->redirect_home;
+ $self->home;
}
Deleted: trunk/t/lib/CPAN/Forum/TestApp.pm
===================================================================
--- trunk/t/lib/CPAN/Forum/TestApp.pm 2006-08-25 15:15:09 UTC (rev 166)
+++ trunk/t/lib/CPAN/Forum/TestApp.pm 2006-08-25 15:15:15 UTC (rev 167)
@@ -1,67 +0,0 @@
-package CPAN::Forum::TestApp;
-use strict;
-use warnings;
-
-use base 'CGI::Application::Test';
-sub new {
- my $class = shift;
- my $self = shift;
- bless $self, $class;
-}
-
-
-=head2 cgiapp
-
-$o->cgiapp(PATH_INFO, HTTP_COOKIE, CGI_PARAMS);
-
-CGI_PARAMS is a hash reference such as {a => 23, b => 19}
-
-=cut
-sub cgiapp {
- my $self = shift;
-
- local $ENV{PATH_INFO} = shift;
- my $cookie = shift;
- my $params = shift;
- local $ENV{HTTP_COOKIE} = "$self->{cookie}=$cookie" if defined $cookie;
-
- my $q = CGI->new($params);
- my $webapp = $self->{class}->new(
- TMPL_PATH => "$self->{root}/templates",
- QUERY => $q,
- PARAMS => {
- ROOT => $self->{root},
- },
- );
- return $webapp->run();
-}
-
-sub extract_cookie {
- my ($self, $result) = @_;
- if ($result =~ /^Set-Cookie: $self->{cookie}=([^;]*);/m) {
- return $1;
- }
-}
-
-=pod
-sub cookie_set {
- my ($result, $cookie) = @_;
- $T->like($result, qr{^Set-Cookie: $COOKIE=$cookie; domain=$ENV{HTTP_HOST}; path=/}m, 'cookie set');
-}
-
-
-sub setup_sessions {
- my $n = shift;
- my @sids;
- foreach my $i (1 .. $n) {
- my $s = PTI::DB::Session->create;
- push @sids, $s->sid;
- }
- return @sids;
-}
-
-=cut
-
-1;
-
-
Modified: trunk/t/mech/011-register.t
===================================================================
--- trunk/t/mech/011-register.t 2006-08-25 15:15:09 UTC (rev 166)
+++ trunk/t/mech/011-register.t 2006-08-25 15:15:15 UTC (rev 167)
@@ -21,12 +21,6 @@
my $w = CPAN::Forum::Test::get_mech();
my $url = CPAN::Forum::Test::get_url();
-#use CPAN::Forum::DBI;
-#CPAN::Forum::DBI->myinit("$ROOT/db/forum.db");
-
-#use CGI::Application::Test;
-#use CPAN::Forum;
-#my $cat = CGI::Application::Test->new({
{
$w->get_ok($url);
$w->content_like(qr{CPAN Forum});
Modified: trunk/t/mech/100-auth.t
===================================================================
--- trunk/t/mech/100-auth.t 2006-08-25 15:15:09 UTC (rev 166)
+++ trunk/t/mech/100-auth.t 2006-08-25 15:15:15 UTC (rev 167)
@@ -1,18 +1,52 @@
-#!/usr/bin/perl -w
+#!/usr/bin/perl
use strict;
-use Test::More tests => 3;
-use Test::WWW::Mechanize;
+use warnings;
-my $url = $ENV{CPAN_FORUM_URL};
+use Test::More;
+my $tests;
+plan tests => $tests;
-SKIP: {
- skip "Need to have CPAN_FORUM_URL to run these tests. See readme", 3 if not defined $url;
+use lib qw(t/lib);
+use CPAN::Forum::Test;
+my @users = @CPAN::Forum::Test::users;
-my $mech = Test::WWW::Mechanize->new();
+{
+ CPAN::Forum::Test::setup_database();
+ ok(-e "blib/db/forum.db");
+ BEGIN { $tests += 1; }
+}
-ok(1);
-ok(1);
-ok(1);
+my $w = CPAN::Forum::Test::get_mech();
+my $url = CPAN::Forum::Test::get_url();
+
+my %config = read_config();
+sub read_config {
+ my %c;
+ open my $in, '<', "t/CONFIG" or die;
+ while (my $line = <$in>) {
+ chomp $line;
+ my ($k, $v) = split /=/, $line;
+ $c{$k} = $v;
+ }
+ return %c;
}
+
+{
+ $w->get_ok($url);
+ $w->content_like(qr{CPAN Forum});
+
+ $w->follow_link_ok({ text => 'login' });
+ $w->content_like(qr{Login});
+ $w->content_like(qr{Nickname});
+ $w->submit_form(
+ fields => {
+ nickname => $config{username},
+ password => $config{password},
+ },
+ );
+ $w->content_like(qr{You are logged in as.*$config{username}});
+ BEGIN { $tests += 6; }
+}
+
More information about the Cpan-forum-commit
mailing list