[Cpan-forum-commit] rev 151 - in branches/db_changes/t: .
lib/CGI/Application lib/CPAN/Forum
svn at pti.co.il
svn at pti.co.il
Sat Jan 21 10:01:39 IST 2006
Author: gabor
Date: 2006-01-21 10:01:39 +0200 (Sat, 21 Jan 2006)
New Revision: 151
Added:
branches/db_changes/t/lib/CPAN/Forum/TestApp.pm
Removed:
branches/db_changes/t/lib/CGI/Application/Test.pm
Modified:
branches/db_changes/t/001-users.t
branches/db_changes/t/011-register.t
Log:
some old changes
Modified: branches/db_changes/t/001-users.t
===================================================================
--- branches/db_changes/t/001-users.t 2005-05-06 17:59:24 UTC (rev 150)
+++ branches/db_changes/t/001-users.t 2006-01-21 08:01:39 UTC (rev 151)
@@ -16,16 +16,23 @@
use CGI::Application::Test;
use CPAN::Forum;
-my $cat = CGI::Application::Test->new({root => $ROOT, cookie => "cpanforum", class => "CPAN::Forum"});
+my $cat = CGI::Application::Test->new({
+ class => "CPAN::Forum",
+ cookie => "cpanforum",
+ app => {
+ TMPL_PATH => "$ROOT/templates",
+ PARAMS => {
+ ROOT => $ROOT,
+ },
+ }});
-
{
- my $r = $cat->cgiapp('/', '', {});
+ my $r = $cat->cgiapp(path_info => '/');
like($r, qr{CPAN Forum});
}
{
- my $r = $cat->cgiapp('/new_post', '', {});
+ my $r = $cat->cgiapp(path_info => '/new_post');
like($r, qr{Location: http://test-host/login});
#TODO: {
@@ -35,7 +42,7 @@
}
#{
-# my $r = $cat->cgiapp('/login', '', {});
+# my $r = $cat->cgiapp(path_info => '/login');
# like($r, qr{Login});
#}
Modified: branches/db_changes/t/011-register.t
===================================================================
--- branches/db_changes/t/011-register.t 2005-05-06 17:59:24 UTC (rev 150)
+++ branches/db_changes/t/011-register.t 2006-01-21 08:01:39 UTC (rev 151)
@@ -16,52 +16,63 @@
use CGI::Application::Test;
use CPAN::Forum;
-my $cat = CGI::Application::Test->new({root => $ROOT, cookie => "cpanforum", class => "CPAN::Forum"});
+my $cat = CGI::Application::Test->new({
+ class => "CPAN::Forum",
+ cookie => "cpanforum",
+ app => {
+ TMPL_PATH => "$ROOT/templates",
+ PARAMS => {
+ ROOT => $ROOT,
+ },
+ }});
+
{
- my $r = $cat->cgiapp('/', '', {});
+ my $r = $cat->cgiapp(path_info => '/');
like($r, qr{CPAN Forum});
}
{
- my $r = $cat->cgiapp('/register', '', {});
+ my $r = $cat->cgiapp(path_info => '/register');
like($r, qr{Registration Page});
}
{
- my $r = $cat->cgiapp('/', '', {rm => 'register_process', nickname => '', email => ''});
+ my $r = $cat->cgiapp(path_info => '/', params => {rm => 'register_process', nickname => '', email => ''});
like($r, qr{Registration Page});
like($r, qr{Need both nickname and password});
}
{
- my $r = $cat->cgiapp('/', '', {rm => 'register_process', nickname => '', email => 'some at email'});
+ my $r = $cat->cgiapp(path_info => '/', params => {rm => 'register_process', nickname => '', email => 'some at email'});
like($r, qr{Registration Page});
like($r, qr{Need both nickname and password});
}
{
- my $r = $cat->cgiapp('/', '', {rm => 'register_process', nickname => 'xyz', email => ''});
+ my $r = $cat->cgiapp(path_info => '/', params => {rm => 'register_process', nickname => 'xyz', email => ''});
like($r, qr{Registration Page});
like($r, qr{Need both nickname and password});
}
{
- my $r = $cat->cgiapp('/', '', {rm => 'register_process', nickname => 'xyzqwertyuiqwertyuiopqwert', email => 'a at com'});
+ my $r = $cat->cgiapp(path_info => '/',
+ params => {rm => 'register_process', nickname => 'xyzqwertyuiqwertyuiopqwert', email => 'a at com'});
like($r, qr{Registration Page});
like($r, qr{Nickname must be lower case alphanumeric between 1-25 characters});
}
# reject bad usernames
foreach my $username ("ab.c", "Abcde", "asd'er", "ab cd") {
- my $r = $cat->cgiapp('/', '', {rm => 'register_process', nickname => $username, email => 'a at com'});
+ my $r = $cat->cgiapp(path_info => '/',
+ params => {rm => 'register_process', nickname => $username, email => 'a at com'});
like($r, qr{Registration Page});
like($r, qr{Nickname must be lower case alphanumeric between 1-25 characters});
}
# reject bad usernames
foreach my $email ("adb-?", "Abcde", "asd'er", "ab cd") {
- my $r = $cat->cgiapp('/', '', {rm => 'register_process', nickname => "abcde", email => $email});
+ my $r = $cat->cgiapp(path_info => '/', params => {rm => 'register_process', nickname => "abcde", email => $email});
like($r, qr{Registration Page});
like($r, qr{Email must be a valid address writen in lower case letters});
}
@@ -88,7 +99,8 @@
{
$sendmail_count = 0;
$password = '';
- my $r = $cat->cgiapp('/', '', {rm => 'register_process', nickname => $users[0]{username}, email => $users[0]{email}});
+ my $r = $cat->cgiapp(path_info => '/',
+ params => {rm => 'register_process', nickname => $users[0]{username}, email => $users[0]{email}});
like($r, qr{Registration Page});
like($r, qr{Thank you for registering});
like($password, qr{\w{5}});
@@ -101,7 +113,8 @@
{
$sendmail_count = 0;
$password = '';
- my $r = $cat->cgiapp('/', '', {rm => 'register_process', nickname => $users[0]{username}, email => $users[0]{email}});
+ my $r = $cat->cgiapp(path_info => '/',
+ params => {rm => 'register_process', nickname => $users[0]{username}, email => $users[0]{email}});
like($r, qr{Registration Page});
like($r, qr{Nickname or e-mail already in use});
is($sendmail_count, 0);
Deleted: branches/db_changes/t/lib/CGI/Application/Test.pm
===================================================================
--- branches/db_changes/t/lib/CGI/Application/Test.pm 2005-05-06 17:59:24 UTC (rev 150)
+++ branches/db_changes/t/lib/CGI/Application/Test.pm 2006-01-21 08:01:39 UTC (rev 151)
@@ -1,78 +0,0 @@
-package CGI::Application::Test;
-use strict;
-use warnings;
-
-use base 'Exporter';
-use Test::Builder;
-use Test::More;
-use CGI;
-
-our @EXPORT = qw(&cgiapp &extract_cookie);
-
-my $T = Test::Builder->new;
-$ENV{CGI_APP_RETURN_ONLY} = 1; # to eliminate screen output
-$ENV{HTTP_HOST} = "test-host";
-
-# CGI::Application::Test->new({root => ROOT, cookie => COOKIE_NAME});
-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;
-
-
Copied: branches/db_changes/t/lib/CPAN/Forum/TestApp.pm (from rev 150, branches/db_changes/t/lib/CGI/Application/Test.pm)
===================================================================
--- branches/db_changes/t/lib/CGI/Application/Test.pm 2005-05-06 17:59:24 UTC (rev 150)
+++ branches/db_changes/t/lib/CPAN/Forum/TestApp.pm 2006-01-21 08:01:39 UTC (rev 151)
@@ -0,0 +1,67 @@
+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;
+
+
More information about the Cpan-forum-commit
mailing list