[prev] [thread] [next] [lurker] [Date index for 2003/12/2]
Author: gabor
Date: 2003-12-02 23:04:16 +0200 (Tue, 02 Dec 2003)
New Revision: 103
Modified:
yapcom/trunk/bin/install.pl
yapcom/trunk/bin/setup.pl
yapcom/trunk/bin/sqlite.pl
yapcom/trunk/cgi/yapc.pl
yapcom/trunk/lib/YAPC/Config.pm
yapcom/trunk/lib/YAPC/DBI.pm
yapcom/trunk/lib/YAPC/Error.pm
yapcom/trunk/lib/YAPC/Login.pm
yapcom/trunk/lib/YAPC/Organizer.pm
yapcom/trunk/lib/YAPC/Person.pm
yapcom/trunk/lib/YAPC/Talk.pm
yapcom/trunk/t/00-simple.t
yapcom/trunk/t/01-adduser.t
yapcom/trunk/t/02-login.t
yapcom/trunk/t/03-web-adduser.t
yapcom/trunk/t/04-proposals.t
yapcom/trunk/t/05-web-proposals.t
yapcom/trunk/t/07-web-change-data.t
yapcom/trunk/t/09-web-change-password.t
yapcom/trunk/t/10-use-html-template.t
yapcom/trunk/t/11-web-admin.t
yapcom/trunk/t/13-change-proposal.t
yapcom/trunk/t/lib/YAPC/Test.pm
yapcom/trunk/t/lib/YAPC/Test/Data.pm
Log:
nothing changed .... the results of running perltidy
Modified: yapcom/trunk/bin/install.pl
===================================================================
--- yapcom/trunk/bin/install.pl 2003-12-02 21:02:48 UTC (rev 102)
+++ yapcom/trunk/bin/install.pl 2003-12-02 21:04:16 UTC (rev 103)
@@ -11,33 +11,33 @@
my $dir = $YAPC::Config::dir;
if (not -e $dir) {
- mkpath $dir or die "Cannot create directory '$dir' $!\n";
+ mkpath $dir or die "Cannot create directory '$dir' $!\n";
}
-#die "'$dir' does not exist\n"
+#die "'$dir' does not exist\n"
#die "'$dir' is not a directory\n" if not -d $dir;
-
open my $m, "MANIFEST" or die "Could not find the MANIFEST file\n";
while (<$m>) {
- next if $_ !~ /\S/;
+ next if $_ !~ /\S/;
- my ($file, $skip) = split;
- if (not $skip) {
- my $subdir = $file;
- $subdir =~ s@[^/]+$@@;
- if ($subdir and not -e "$dir/$subdir") {
- print "Making $dir/$subdir\n";
- mkpath "$dir/$subdir" or die "Cannot create '$dir/$subdir'\n";
- }
- print "Copying '$file' to '$dir/$file'\n";
- copy ($file, "$dir/$file") or die "Could not copy '$file'\n";
- if ($file =~ /pl$/) {
- chmod 0755, "$dir/$file" or warn "Cannot chmod '$dir/$file'\n";
- }
- } else {
- print "Skiping '$file'\n";
- }
+ my ($file, $skip) = split;
+ if (not $skip) {
+ my $subdir = $file;
+ $subdir =~ s@[^/]+$@@;
+ if ($subdir and not -e "$dir/$subdir") {
+ print "Making $dir/$subdir\n";
+ mkpath "$dir/$subdir" or die "Cannot create '$dir/$subdir'\n";
+ }
+ print "Copying '$file' to '$dir/$file'\n";
+ copy($file, "$dir/$file") or die "Could not copy '$file'\n";
+ if ($file =~ /pl$/) {
+ chmod 0755, "$dir/$file" or warn "Cannot chmod '$dir/$file'\n";
+ }
+ }
+ else {
+ print "Skiping '$file'\n";
+ }
}
use Cwd;
@@ -45,10 +45,6 @@
chdir $dir;
system "$^X $localdir/bin/setup.pl";
-
-
-
-
sub usage_and_exit {
print <<END;
Usage:
@@ -66,4 +62,3 @@
=cut
-
Modified: yapcom/trunk/bin/setup.pl
===================================================================
--- yapcom/trunk/bin/setup.pl 2003-12-02 21:02:48 UTC (rev 102)
+++ yapcom/trunk/bin/setup.pl 2003-12-02 21:04:16 UTC (rev 103)
@@ -10,15 +10,16 @@
mkpath $YAPC::Config::db_dir;
if (@ARGV and $ARGV[0] eq '-force') {
- if (-e $YAPC::Config::db_file) {
- print "Removing '$YAPC::Config::db_file'\n";
- unlink $YAPC::Config::db_file;
- }
+ if (-e $YAPC::Config::db_file) {
+ print "Removing '$YAPC::Config::db_file'\n";
+ unlink $YAPC::Config::db_file;
+ }
}
if (-e $YAPC::Config::db_file) {
print "Skiping database creation as '$YAPC::Config::db_file' already exists.\n";
-} else {
+}
+else {
print "Creating database '$YAPC::Config::db_file'.\n";
YAPC::DBI->init_db;
chmod 0777, $YAPC::Config::db_dir;
@@ -33,4 +34,3 @@
=cut
-
Modified: yapcom/trunk/bin/sqlite.pl
===================================================================
--- yapcom/trunk/bin/sqlite.pl 2003-12-02 21:02:48 UTC (rev 102)
+++ yapcom/trunk/bin/sqlite.pl 2003-12-02 21:04:16 UTC (rev 103)
@@ -6,7 +6,7 @@
# all the information you wanted to know about the dbsql database
# probably I could use the dbsql commandline interface if it was installed...
-die "Usage: $0 database\n" if not @ARGV ==1;
+die "Usage: $0 database\n" if not @ARGV == 1;
#my $db_file = "db/yapc.db";
my $db_file = shift;
@@ -22,22 +22,23 @@
print keys %$hr;
}
=cut
+
my $sth;
-
print "-------\n";
print "People\n";
print "-------\n";
$sth = $dbh->prepare('select * from people');
$sth->execute;
while (my $hr = $sth->fetchrow_hashref) {
- #foreach my $field (keys %$hr) {
- # print "$field=$$hr{$field} ";
- #}
- #print "\n";
- no warnings 'uninitialized';
- print join "|", @$hr{qw(id fname lname email password authcode acked company country state city street zip phone pauseid url mongers photo)};
- print "\n";
+
+ #foreach my $field (keys %$hr) {
+ # print "$field=$$hr{$field} ";
+ #}
+ #print "\n";
+ no warnings 'uninitialized';
+ print join "|", @$hr{qw(id fname lname email password authcode acked company country state city street zip phone pauseid url mongers photo)};
+ print "\n";
}
$sth->finish;
@@ -47,9 +48,9 @@
$sth = $dbh->prepare('select * from login');
$sth->execute;
while (my $hr = $sth->fetchrow_hashref) {
- no warnings 'uninitialized';
- print join "|", @$hr{qw(user_id cookie timeout)};
- print "\n";
+ no warnings 'uninitialized';
+ print join "|", @$hr{qw(user_id cookie timeout)};
+ print "\n";
}
$sth->finish;
@@ -59,14 +60,11 @@
$sth = $dbh->prepare('select * from talks');
$sth->execute;
while (my $hr = $sth->fetchrow_hashref) {
- no warnings 'uninitialized';
- print join "|", @$hr{qw(id user_id title length language abstract other)};
- print "\n";
+ no warnings 'uninitialized';
+ print join "|", @$hr{qw(id user_id title length language abstract other)};
+ print "\n";
}
$sth->finish;
-
-
$dbh->disconnect;
-
Modified: yapcom/trunk/cgi/yapc.pl
===================================================================
--- yapcom/trunk/cgi/yapc.pl 2003-12-02 21:02:48 UTC (rev 102)
+++ yapcom/trunk/cgi/yapc.pl 2003-12-02 21:04:16 UTC (rev 103)
@@ -1,9 +1,9 @@
#!/usr/bin/perl
-# -d:ptkdb
+# -d:ptkdb
# -T
# -d:ptkdb
sub BEGIN {
- $ENV{'DISPLAY'} = "localhost:0.0" ;
+ $ENV{'DISPLAY'} = "localhost:0.0";
}
use FindBin;
@@ -16,7 +16,3 @@
my $webapp = YAPC::Organizer->new();
$webapp->run();
-
-
-
-
Modified: yapcom/trunk/lib/YAPC/Config.pm
===================================================================
--- yapcom/trunk/lib/YAPC/Config.pm 2003-12-02 21:02:48 UTC (rev 102)
+++ yapcom/trunk/lib/YAPC/Config.pm 2003-12-02 21:04:16 UTC (rev 103)
@@ -7,24 +7,24 @@
my %config;
if (open CONFIG, "$FindBin::Bin/../db/config") {
- local $/ = undef;
- %config = split(/\s*=\s*|\s*[\r\n]+\s*/, <CONFIG>);
- close CONFIG;
+ local $/ = undef;
+ %config = split(/\s*=\s*|\s*[\r\n]+\s*/, <CONFIG>);
+ close CONFIG;
}
-$dir = $config{'SITE_DIR'} || "/home/gabor/projects/perl/perl.org.il/YAPC/dev";
+$dir = $config{'SITE_DIR'} || "/home/gabor/projects/perl/perl.org.il/YAPC/dev";
$email_address = $config{'SITE_EMAIL'} || 'yapc@xxxx.xxx.xx';
# list of e-mail address of administrators whom will have extra rights
-@admins = ($config{'SITE_ADMINS'}) ? split /[\s,]+/, $config{'SITE_ADMINS'} : qw(gabor@xxx.xx.xx);
+@admins = ($config{'SITE_ADMINS'}) ? split /[\s,]+/, $config{'SITE_ADMINS'} : qw(gabor@xxx.xx.xx);
-$db_dir = "$dir/db";
-$db_file="$db_dir/yapc.db";
-@STORAGE = ("dbi:SQLite:$db_file", 'root', undef);
-$TIMEOUT = $config{'DB_TIMEOUT'} || 100;
+$db_dir = "$dir/db";
+$db_file = "$db_dir/yapc.db";
+@STORAGE = ("dbi:SQLite:$db_file", 'root', undef);
+$TIMEOUT = $config{'DB_TIMEOUT'} || 100;
$templates_dir = "$dir/templates";
-@proposal_lengths = ($config{'PROPOSAL_LENGTHS'}) ? split /[\s,]+/, $config{'PROPOSAL_LENGTHS'} : (5, 30, 60, 90, 180);
+@proposal_lengths = ($config{'PROPOSAL_LENGTHS'}) ? split /[\s,]+/, $config{'PROPOSAL_LENGTHS'} : (5, 30, 60, 90, 180);
@proposal_languages = ($config{'PROPOSAL_LANGUAGES'}) ? split /[\s,]+/, $config{'PROPOSAL_LANGUAGES'} : qw(English Hebrew);
1;
Modified: yapcom/trunk/lib/YAPC/DBI.pm
===================================================================
--- yapcom/trunk/lib/YAPC/DBI.pm 2003-12-02 21:02:48 UTC (rev 102)
+++ yapcom/trunk/lib/YAPC/DBI.pm 2003-12-02 21:04:16 UTC (rev 103)
@@ -4,52 +4,51 @@
use YAPC::Config;
use base 'Class::DBI::BaseDSN';
use Carp qw(croak);
-__PACKAGE__->set_db( 'Main', @YAPC::Config::STORAGE );
+__PACKAGE__->set_db('Main', @YAPC::Config::STORAGE);
__PACKAGE__->mk_classdata('load_alias');
-
-
=head2 init_db
Initialize the database
=cut
+
sub init_db {
- my $class = shift;
-# croak("Database '$YAPC::Config::db_file' already exists\n") if -e $YAPC::Config::db_file;
- my $dbh = $class->db_Main;
- my $sql = join ( '', (<DATA>) );
+ my $class = shift;
- for my $statement (split /;/, $sql) {
- if ($dbh->{Driver}{Name} eq 'SQLite') {
- $statement =~ s/auto_increment//g;
- $statement =~ s/,?FOREIGN .*$//mg;
- $statement =~ s/TYPE=INNODB//g;
- }
- $statement =~ s/\#.*$//mg; # strip # comments
- next unless $statement =~ /\S/;
- eval { $dbh->do($statement) };
- die "$@: $statement" if $@;
- }
- return 1;
+ # croak("Database '$YAPC::Config::db_file' already exists\n") if -e $YAPC::Config::db_file;
+ my $dbh = $class->db_Main;
+ my $sql = join('', (<DATA>));
+
+ for my $statement (split /;/, $sql) {
+ if ($dbh->{Driver}{Name} eq 'SQLite') {
+ $statement =~ s/auto_increment//g;
+ $statement =~ s/,?FOREIGN .*$//mg;
+ $statement =~ s/TYPE=INNODB//g;
+ }
+ $statement =~ s/\#.*$//mg; # strip # comments
+ next unless $statement =~ /\S/;
+ eval {$dbh->do($statement)};
+ die "$@: $statement" if $@;
+ }
+ return 1;
}
-
=head2 _random_string(n)
Internal function to generate a random string of n length.
=cut
+
sub _random_string {
- my $self = shift; # not used
+ my $self = shift; # not used
my $length = shift;
- my @a = ('A'..'Z', 'a'..'z', 0..9);
- my $str = '';
- $str .= $a[rand(@a)] for 1..$length;
+ my @a = ('A' .. 'Z', 'a' .. 'z', 0 .. 9);
+ my $str = '';
+ $str .= $a[ rand(@a) ] for 1 .. $length;
return $str;
}
-
1;
__DATA__
Modified: yapcom/trunk/lib/YAPC/Error.pm
===================================================================
--- yapcom/trunk/lib/YAPC/Error.pm 2003-12-02 21:02:48 UTC (rev 102)
+++ yapcom/trunk/lib/YAPC/Error.pm 2003-12-02 21:04:16 UTC (rev 103)
@@ -11,16 +11,15 @@
my @args = ();
local $Error::Depth = $Error::Depth + 1;
- local $Error::Debug = 1; # Enables storing of stacktrace
+ local $Error::Debug = 1; # Enables storing of stacktrace
$self->SUPER::new(-text => $text, @args);
}
1;
-
+
#package YAPC::DB::Error;
#use base qw(YAPC::Error);
#1;
-
1;
Modified: yapcom/trunk/lib/YAPC/Login.pm
===================================================================
--- yapcom/trunk/lib/YAPC/Login.pm 2003-12-02 21:02:48 UTC (rev 102)
+++ yapcom/trunk/lib/YAPC/Login.pm 2003-12-02 21:04:16 UTC (rev 103)
@@ -8,25 +8,26 @@
use YAPC::Person;
use YAPC::Error;
__PACKAGE__->set_up_table('login');
-__PACKAGE__->has_a( user_id => 'YAPC::Person' );
+__PACKAGE__->has_a(user_id => 'YAPC::Person');
-
=head2 logut
Remove the appropriate entry from the login table.
=cut
+
sub logout {
my $self = shift;
+
#my $arg = shift; # cookie =>
- my %args = @_; # cookie => ....
+ my %args = @_; # cookie => ....
my @logins = YAPC::Login->search(%args);
- carp('No such login') if @logins == 0; # No such cookie
- carp('Too many such logins') if @logins > 1; # this is contradicting the uniqueness of the cookie field
+ carp('No such login') if @logins == 0; # No such cookie
+ carp('Too many such logins') if @logins > 1; # this is contradicting the uniqueness of the cookie field
+ $logins[0]->delete;
- $logins[0]->delete;
#return 1;
}
@@ -36,35 +37,39 @@
create a new login if the authentication was successfull
=cut
+
sub new {
my $self = shift;
- my %args = @_; # email => password =>
-# warn Dumper \%args;
+ my %args = @_; # email => password =>
+ # warn Dumper \%args;
+
my @people = YAPC::Person->search(email => $args{email}, password => $args{password});
croak("Too many users fit the description\n") if @people > 1;
- croak("No match found\n") if @people == 0;
- throw YAPC::Error("Not validated.") if not $people[0]->acked;
+ croak("No match found\n") if @people == 0;
+ throw YAPC::Error("Not validated.") if not $people[0]->acked;
- $self->create({user_id => $people[0]->id});
+ $self->create({user_id => $people[0]->id});
}
+__PACKAGE__->add_trigger(
+ before_create => sub {
+ my $self = shift;
+ $self->{cookie} = $self->_random_string(60);
+ $self->{timeout} = time + $YAPC::Config::TIMEOUT;
+ }
+);
-__PACKAGE__->add_trigger(before_create => sub {
- my $self = shift;
- $self->{cookie} = $self->_random_string(60);
- $self->{timeout} = time + $YAPC::Config::TIMEOUT;
-});
-
=head2 by_email
return a list of YAPC::Login objects that are logins for the person with the given
e-mail address.
=cut
+
sub by_email {
my $self = shift;
- my %args = @_; # email => ...
+ my %args = @_; # email => ...
# This code is really bad here. Quick to write slow to execute.
my @people = YAPC::Person->search(%args);
@@ -72,18 +77,18 @@
my $id = $people[0]->id;
my @logins;
return __PACKAGE__->search(user_id => $id);
-}
+}
-
=head2 get_user_id
Returns the user id of the Person logged in with the give cookie
Arguments: (cookie => 'the value of the cookie')
=cut
+
sub get_user_id {
my $self = shift;
- my %args = @_; # cookie => ...
+ my %args = @_; # cookie => ...
return undef if not $args{cookie};
@@ -92,8 +97,7 @@
return undef if @logins != 1;
return $logins[0]->user_id;
-}
+}
-
1;
Modified: yapcom/trunk/lib/YAPC/Organizer.pm
===================================================================
--- yapcom/trunk/lib/YAPC/Organizer.pm 2003-12-02 21:02:48 UTC (rev 102)
+++ yapcom/trunk/lib/YAPC/Organizer.pm 2003-12-02 21:04:16 UTC (rev 103)
@@ -12,147 +12,145 @@
use YAPC::Talk;
use Error qw(:try);
use Mail::Sendmail;
-use HTML::Template; # we use it explicitely hence we need it here.
+use HTML::Template; # we use it explicitely hence we need it here.
my $templates_dir = $YAPC::Config::templates_dir;
use base 'CGI::Application';
-use Data::Dumper; # for playing with debugging
+use Data::Dumper; # for playing with debugging
-
# list pages that require valid login to access
-my @user_pages = qw(proposal personal_info change_password
- user_account logout list_my_proposals edit_my_proposal);
+my @user_pages = qw(proposal personal_info change_password
+ user_account logout list_my_proposals edit_my_proposal);
# list of pages accessible to administrators only
-my @admin_pages = qw(admin_list_proposals);
+my @admin_pages = qw(admin_list_proposals);
# other pages that can be directly access but which don't need any authentication
my @other_pages = qw(list_people login registration validation lost_validation lost_password
- person);
+ person);
my @run_modes = map {$_, $_} @user_pages, @admin_pages, @other_pages;
# turn urls to links
sub htmlize {
my $str = shift;
- $str =~ s@(http://\S+)@<a href="$1">$1</a>@g if $str; # turn urls to links
+ $str =~ s@(http://\S+)@<a href="$1">$1</a>@g if $str; # turn urls to links
return $str;
}
-
sub setup {
- my $self = shift;
- $self->start_mode('default');
- $self->mode_param('run');
- $self->run_modes(
- @run_modes,
- 'default' => 'default',
- 'no_such_page' => 'no_such_page',
- 'show_message' => 'show_message',
- );
+ my $self = shift;
+ $self->start_mode('default');
+ $self->mode_param('run');
+ $self->run_modes(
+ @run_modes,
+ 'default' => 'default',
+ 'no_such_page' => 'no_such_page',
+ 'show_message' => 'show_message',
+ );
}
sub cgiapp_prerun {
- my $self = shift;
+ my $self = shift;
my $run_mode = shift;
my ($page, $filename) = get_page();
- if (grep {$_ eq $page} @other_pages) { return $self->prerun_mode($page) }
-
+ if (grep {$_ eq $page} @other_pages) {
+ return $self->prerun_mode($page);
+ }
if (grep {$_ eq $page} (@user_pages, @admin_pages)) {
- if (my $id = $self->is_logged_in) {
- if (grep {$_ eq $page} @user_pages) {
- $self->prerun_mode($page);
- } else { # admin pages
- if ($self->is_admin_user($id)) {
- $self->prerun_mode($page);
- } else {
- $self->param('yapcom_message' => 'admins_only');
- $self->prerun_mode('show_message');
- }
- }
- } else {
- $self->param('yapcom_next_page' => "$page.html") if $page ne 'logout';
- $self->prerun_mode('login');
- }
- return;
- }
+ if (my $id = $self->is_logged_in) {
+ if (grep {$_ eq $page} @user_pages) {
+ $self->prerun_mode($page);
+ }
+ else { # admin pages
+ if ($self->is_admin_user($id)) {
+ $self->prerun_mode($page);
+ }
+ else {
+ $self->param('yapcom_message' => 'admins_only');
+ $self->prerun_mode('show_message');
+ }
+ }
+ }
+ else {
+ $self->param('yapcom_next_page' => "$page.html") if $page ne 'logout';
+ $self->prerun_mode('login');
+ }
+ return;
+ }
-
if (not -e $filename) {
- #warn "YAPC script called for not existing file. Original: '$ENV{REQUEST_URI}' cut down: '$filename'\n";
- $self->prerun_mode('no_such_page');
+
+ #warn "YAPC script called for not existing file. Original: '$ENV{REQUEST_URI}' cut down: '$filename'\n";
+ $self->prerun_mode('no_such_page');
}
$self->prerun_mode('default');
}
sub default {
- my $self = shift;
- my $q = $self->query;
+ my $self = shift;
+ my $q = $self->query;
- my $t = $self->_server_page(get_page());
- return $t->output;
+ my $t = $self->_server_page(get_page());
+ return $t->output;
}
sub get_page {
- # REQUEST_URI looks like this: /content.html
- my $page = $ENV{REQUEST_URI} || '';
- $page =~ s@.*/@@;
- $page =~ s/\.html(\?.*)?$//;
- $page ||= 'index';
+ # REQUEST_URI looks like this: /content.html
+ my $page = $ENV{REQUEST_URI} || '';
+ $page =~ s@.*/@@;
+ $page =~ s/\.html(\?.*)?$//;
+ $page ||= 'index';
- my $filename = "$templates_dir/$page.tmpl";
+ my $filename = "$templates_dir/$page.tmpl";
- return ($page, $filename);
+ return ($page, $filename);
}
# maybe this should be replaced with a generic show page call
sub user_account {
my $self = shift;
- my $t = $self->_server_page('user_account');
+ my $t = $self->_server_page('user_account');
-
- my $id = $self->is_logged_in();
+ my $id = $self->is_logged_in();
my $admin = $self->is_admin_user($id);
if ($admin) {
$t->param(ADMIN => 1);
}
if ($id) {
- $t->param(fname => $id->fname);
- $t->param(lname => $id->lname);
+ $t->param(fname => $id->fname);
+ $t->param(lname => $id->lname);
}
return $t->output;
}
sub is_logged_in {
- my $self = shift;
- my $q = $self->query;
+ my $self = shift;
+ my $q = $self->query;
- # retreive the Cookie and check if this represents a valid user
- my $cookie = $q->cookie('Yapcom');
- YAPC::Login->get_user_id(cookie => $cookie);
+ # retreive the Cookie and check if this represents a valid user
+ my $cookie = $q->cookie('Yapcom');
+ YAPC::Login->get_user_id(cookie => $cookie);
}
-
sub is_admin_user {
my $self = shift;
- my $id = shift;
+ my $id = shift;
return 0 if not defined $id;
- my ($person) = YAPC::Person->search(id => $id);
+ my ($person) = YAPC::Person->search(id => $id);
return grep {$_ eq $person->email} @YAPC::Config::admins;
}
-
-
sub no_such_page {
my $self = shift;
- my $t = $self->_server_page('error');
+ my $t = $self->_server_page('error');
return $t->output;
}
@@ -165,511 +163,500 @@
return $t->output;
}
-
sub change_password {
- my $self = shift;
- my $q = $self->query;
+ my $self = shift;
+ my $q = $self->query;
- my $id = $self->is_logged_in;
+ my $id = $self->is_logged_in;
+ # are the passwords good and equal ?
+ if ( defined $q->param('password')
+ and defined $q->param('password2')
+ and ($q->param('password') eq $q->param('password2')))
+ {
- # are the passwords good and equal ?
- if (defined $q->param('password') and
- defined $q->param('password2') and
- ($q->param('password') eq $q->param('password2'))) {
-
- # update database
- my ($person) = YAPC::Person->search(id => $id);
- $person->password($q->param('password'));
- $person->update();
+ # update database
+ my ($person) = YAPC::Person->search(id => $id);
+ $person->password($q->param('password'));
+ $person->update();
- my $t = $self->_server_page('message');
- $t->param(password_changed => 1);
- return $t->output;
- } else {
- my $t = $self->_server_page('change_password');
- return $t->output unless $q->param('submit');
- $t->param(message => "Error");
- return $t->output;
- }
+ my $t = $self->_server_page('message');
+ $t->param(password_changed => 1);
+ return $t->output;
+ }
+ else {
+ my $t = $self->_server_page('change_password');
+ return $t->output unless $q->param('submit');
+ $t->param(message => "Error");
+ return $t->output;
+ }
}
sub lost_validation {
- my $self = shift;
- my $q = $self->query;
+ my $self = shift;
+ my $q = $self->query;
- my $t = $self->_server_page('lost_validation');
- my $person;
+ my $t = $self->_server_page('lost_validation');
+ my $person;
-# The logic here is that the page 'lost_validation' is used when
-# displaying the page to get your lost validation, and also after submitting
-# the page to get your lost validation. If 'submit' is not present, we
-# display the form, otherwise, we process the results.
- return $t->output unless $q->param('submit');
+ # The logic here is that the page 'lost_validation' is used when
+ # displaying the page to get your lost validation, and also after submitting
+ # the page to get your lost validation. If 'submit' is not present, we
+ # display the form, otherwise, we process the results.
+ return $t->output unless $q->param('submit');
- eval {
- ($person) = YAPC::Person->search(email => $q->param('email'));
- };
+ eval {($person) = YAPC::Person->search(email => $q->param('email'));};
- if ($@ or not $person) {
- $t->param(MESSAGE => 'No such e-mail');
- return $t->output;
- }
+ if ($@ or not $person) {
+ $t->param(MESSAGE => 'No such e-mail');
+ return $t->output;
+ }
- # OK
- $t = $self->_server_page('email_sent');
- if ($person->authcode ) {
- $self->send_email_with_validation_code($person);
- $t->param(SENT_AUTHCODE => 1);
- } else {
- $t->param(NOT_SENT_AUTHCODE => 1);
- }
- return $t->output;
+ # OK
+ $t = $self->_server_page('email_sent');
+ if ($person->authcode) {
+ $self->send_email_with_validation_code($person);
+ $t->param(SENT_AUTHCODE => 1);
+ }
+ else {
+ $t->param(NOT_SENT_AUTHCODE => 1);
+ }
+ return $t->output;
}
sub lost_password {
- my $self = shift;
- my $q = $self->query;
+ my $self = shift;
+ my $q = $self->query;
- my $t = $self->_server_page('lost_password');
+ my $t = $self->_server_page('lost_password');
-# See logic in &lost_validation
- return $t->output unless $q->param('submit');
+ # See logic in &lost_validation
+ return $t->output unless $q->param('submit');
- my $person;
- eval {
- ($person) = YAPC::Person->search(email => $q->param('email'));
- };
- if ($@ or not $person) {
- $t->param(MESSAGE => 'No such e-mail');
- return $t->output;
- }
+ my $person;
+ eval {($person) = YAPC::Person->search(email => $q->param('email'));};
+ if ($@ or not $person) {
+ $t->param(MESSAGE => 'No such e-mail');
+ return $t->output;
+ }
- # OK
- $t = $self->_server_page('email_sent');
- $self->send_email_with_password($person);
- $t->param(SENT_PASSWORD => 1);
- return $t->output;
+ # OK
+ $t = $self->_server_page('email_sent');
+ $self->send_email_with_password($person);
+ $t->param(SENT_PASSWORD => 1);
+ return $t->output;
}
sub send_email_with_password {
- my $self = shift;
- my $person = shift;
- my $q = $self->query;
- my $mail = HTML::Template->new(
- filename => "$templates_dir/email/password.tmpl",
- die_on_bad_params => 0,
- associate => $q);
- $mail->param("password" => $person->password);
- my %mail = (To => $person->email,
- From => $YAPC::Config::email_address,
- Subject => "YAPC::Israel::2004 your password",
- Message => $mail->output,
- );
- sendmail(%mail) or die $Mail::Sendmail::error unless $ENV{YAPCOM_NOMAIL};
+ my $self = shift;
+ my $person = shift;
+ my $q = $self->query;
+ my $mail =
+ HTML::Template->new(
+ filename => "$templates_dir/email/password.tmpl",
+ die_on_bad_params => 0,
+ associate => $q
+ );
+ $mail->param("password" => $person->password);
+ my %mail = (
+ To => $person->email,
+ From => $YAPC::Config::email_address,
+ Subject => "YAPC::Israel::2004 your password",
+ Message => $mail->output,
+ );
+ sendmail(%mail) or die $Mail::Sendmail::error unless $ENV{YAPCOM_NOMAIL};
}
sub send_email_with_validation_code {
- my $self = shift;
- my $person = shift;
- my $q = $self->query;
+ my $self = shift;
+ my $person = shift;
+ my $q = $self->query;
-
- # sending e-mail
- my $mail = HTML::Template->new(
- filename => "$templates_dir/email/register.tmpl",
- die_on_bad_params => 0,
- associate => $q);
- $mail->param("authcode" => $person->authcode);
- my $validation_url = "http://$ENV{HTTP_HOST}$ENV{REQUEST_URI}";
- $validation_url =~ s/\w+.html$/validation.html/;
- $validation_url .= "?email=" . $person->email . "&authcode=" . $person->authcode;
- $mail->param("validation_url" => $validation_url);
- my %mail = (To => $person->email,
- From => $YAPC::Config::email_address,
- Subject => "YAPC::Israel::2004 registration information",
- Message => $mail->output,
- );
- sendmail(%mail) or die $Mail::Sendmail::error unless $ENV{YAPCOM_NOMAIL};
+ # sending e-mail
+ my $mail =
+ HTML::Template->new(
+ filename => "$templates_dir/email/register.tmpl",
+ die_on_bad_params => 0,
+ associate => $q
+ );
+ $mail->param("authcode" => $person->authcode);
+ my $validation_url = "http://$ENV{HTTP_HOST}$ENV{REQUEST_URI}";
+ $validation_url =~ s/\w+.html$/validation.html/;
+ $validation_url .= "?email=" . $person->email . "&authcode=" . $person->authcode;
+ $mail->param("validation_url" => $validation_url);
+ my %mail = (
+ To => $person->email,
+ From => $YAPC::Config::email_address,
+ Subject => "YAPC::Israel::2004 registration information",
+ Message => $mail->output,
+ );
+ sendmail(%mail) or die $Mail::Sendmail::error unless $ENV{YAPCOM_NOMAIL};
}
-
-
-
sub _server_page {
- my $self = shift;
- my ($page) = @_;
- my $q = $self->query;
+ my $self = shift;
+ my ($page) = @_;
+ my $q = $self->query;
- # we allow tags like this in our templates that will define values
- # to be set as parameters
- # <TMPL_VALUE NAME="name" VALUE="value">
- my %h;
- my $filter = sub {
- my $text_ref = shift;
- while ($$text_ref =~ s/<\s*TMPL_VALUE\s+NAME="([^"]*)"\s+VALUE="([^"]*)"\s*>//) {
- $h{$1} = $2;
- }
- };
+ # we allow tags like this in our templates that will define values
+ # to be set as parameters
+ # <TMPL_VALUE NAME="name" VALUE="value">
+ my %h;
+ my $filter = sub {
+ my $text_ref = shift;
+ while ($$text_ref =~ s/<\s*TMPL_VALUE\s+NAME="([^"]*)"\s+VALUE="([^"]*)"\s*>//) {
+ $h{$1} = $2;
+ }
+ };
-# eval, because sub dies if template doesn't exists
- my $t;
- eval {
- $t = $self->load_tmpl(
- "$page.tmpl",
- die_on_bad_params => 0,
- filter => $filter,
- associate => $q,
- path => $templates_dir,
- );
- };
+ # eval, because sub dies if template doesn't exists
+ my $t;
+ eval {$t = $self->load_tmpl("$page.tmpl", die_on_bad_params => 0, filter => $filter, associate => $q, path => $templates_dir,);};
- $t = $self->load_tmpl(
- "error.tmpl",
- die_on_bad_params => 0,
- filter => $filter,
- associate => $q,
- path => $templates_dir,
- ) if $@;
+ $t =
+ $self->load_tmpl(
+ "error.tmpl",
+ die_on_bad_params => 0,
+ filter => $filter,
+ associate => $q,
+ path => $templates_dir,
+ )
+ if $@;
- $t->param(%h);
- $t->param(VERSION => $YAPC::Organizer::VERSION);
+ $t->param(%h);
+ $t->param(VERSION => $YAPC::Organizer::VERSION);
- return $t;
+ return $t;
}
sub list_people {
- my $self = shift;
+ my $self = shift;
- my $id = $self->is_logged_in;
- my $admin = $self->is_admin_user($id);
+ my $id = $self->is_logged_in;
+ my $admin = $self->is_admin_user($id);
- my $ar = [];
- my @people;
+ my $ar = [];
+ my @people;
- if ($admin) {
- @people = YAPC::Person->retrieve_all;
- } else {
- @people = YAPC::Person->search(acked => 1, { order_by=>'fname' });
- }
+ if ($admin) {
+ @people = YAPC::Person->retrieve_all;
+ }
+ else {
+ @people = YAPC::Person->search(acked => 1, {order_by => 'fname'});
+ }
- foreach my $p (@people) {
- my $url = $p->url;
- $url = "http://$url"; if ($url and substr($url, 0, 7) ne 'http://');
- $p->{admin} = 1 if $admin; # in each row we'll have to know if adminstrator looks at it or not.
- push @$ar, $p;
- }
- my $t = $self->_server_page('list_people');
- my $stat = YAPC::Person->get_statistics();
- $t->param(%$stat);
- $t->param(USERS => $ar);
-# $t->param(admin => 1) if $admin;
- return $t->output;
+ foreach my $p (@people) {
+ my $url = $p->url;
+ $url = "http://$url"; if ($url and substr($url, 0, 7) ne 'http://');
+ $p->{admin} = 1 if $admin; # in each row we'll have to know if adminstrator looks at it or not.
+ push @$ar, $p;
+ }
+ my $t = $self->_server_page('list_people');
+ my $stat = YAPC::Person->get_statistics();
+ $t->param(%$stat);
+ $t->param(USERS => $ar);
+
+ # $t->param(admin => 1) if $admin;
+ return $t->output;
}
sub admin {
my $self = shift;
- my $t = $self->_server_page('admin');
+ my $t = $self->_server_page('admin');
return $t->output;
}
sub admin_list_proposals {
- my $self = shift;
+ my $self = shift;
- my $ar = [];
- foreach my $p (YAPC::Talk->retrieve_all) {
- push @$ar,
- {
- abstract => htmlize($p->abstract),
- other => htmlize($p->other),
- title => $p->title,
- length => $p->length,
- fname => $p->user_id->fname,
- lname => $p->user_id->lname,
- id => $p->user_id->id,
- };
- }
+ my $ar = [];
+ foreach my $p (YAPC::Talk->retrieve_all) {
+ push @$ar,
+ {
+ abstract => htmlize($p->abstract),
+ other => htmlize($p->other),
+ title => $p->title,
+ length => $p->length,
+ fname => $p->user_id->fname,
+ lname => $p->user_id->lname,
+ id => $p->user_id->id,
+ };
+ }
- my $t = $self->_server_page('admin_list_proposals');
- $t->param(TALKS => $ar);
- return $t->output;
+ my $t = $self->_server_page('admin_list_proposals');
+ $t->param(TALKS => $ar);
+ return $t->output;
}
sub login {
- my $self = shift;
- my $q = $self->query;
+ my $self = shift;
+ my $q = $self->query;
if ($self->is_logged_in) {
- return $self->user_account;
+ return $self->user_account;
}
+ my $t = $self->_server_page('login');
+ my $login;
- my $t = $self->_server_page('login');
- my $login;
+ # See logic in &lost_validation
+ unless ($q->param('submit')) {
+ $t->param('next' => $self->param('yapcom_next_page')) if $self->param('yapcom_next_page');
+ return $t->output;
+ }
-# See logic in &lost_validation
- unless ($q->param('submit')) {
- $t->param('next' => $self->param('yapcom_next_page')) if $self->param('yapcom_next_page');
- return $t->output;
- }
-
- try {
+ try {
$login = YAPC::Login->new($q->Vars);
- }
+ }
catch YAPC::Error with {
my $er = shift;
$t->param(MESSAGE => $er);
- }
- catch Error with {
+ }
+ catch Error with {
$t->param(MESSAGE => 'Login failed.');
- } or return $t->output; # on error
+ } or return $t->output; # on error
- # success
- my $path = $ENV{REQUEST_URI};
- $path =~ s@[^/]*$@@; # remove everything after last /
- my $cookie = $q->cookie(
- -name =>'Yapcom',
- -value => $login->cookie,
- -expires =>'+1d',
- -path => $path,
- -domain => $ENV{HTTP_HOST},
- );
- $self->header_props(-cookie => $cookie);
+ # success
+ my $path = $ENV{REQUEST_URI};
+ $path =~ s@[^/]*$@@; # remove everything after last /
+ my $cookie =
+ $q->cookie(
+ -name => 'Yapcom',
+ -value => $login->cookie,
+ -expires => '+1d',
+ -path => $path,
+ -domain => $ENV{HTTP_HOST},
+ );
+ $self->header_props(-cookie => $cookie);
- my $page = $q->param("next") || 'user_account';
- if (grep {$_ eq $page} @run_modes) {
- return $self->$page;
- }
+ my $page = $q->param("next") || 'user_account';
+ if (grep {$_ eq $page} @run_modes) {
+ return $self->$page;
+ }
- my $tm = $self->_server_page($page);
- return $tm->output;
+ my $tm = $self->_server_page($page);
+ return $tm->output;
}
-
=head2 logout
Removes the entry from the login table.
Does NOT remove the cookie from the browser.
=cut
+
sub logout {
- my $self = shift;
- my $q = $self->query;
- my $cookie = $q->cookie('Yapcom');
- eval {
- YAPC::Login->logout(cookie => $cookie);
- };
- my $err = $@;
- my $t = $self->_server_page('logout');
- $t->param(ERROR => $err);
- $t->output;
+ my $self = shift;
+ my $q = $self->query;
+ my $cookie = $q->cookie('Yapcom');
+ eval {YAPC::Login->logout(cookie => $cookie);};
+ my $err = $@;
+ my $t = $self->_server_page('logout');
+ $t->param(ERROR => $err);
+ $t->output;
}
-
sub registration {
- my $self = shift;
- my $q = $self->query;
+ my $self = shift;
+ my $q = $self->query;
- my $t = $self->_server_page('registration');
- my $person;
+ my $t = $self->_server_page('registration');
+ my $person;
-# See logic in &lost_validation
- return $t->output unless $q->param('submit');
+ # See logic in &lost_validation
+ return $t->output unless $q->param('submit');
- try {
- $person = YAPC::Person->new($q->Vars);
- }
+ try {
+ $person = YAPC::Person->new($q->Vars);
+ }
catch YAPC::Error with {
my $er = shift;
$t->param(MESSAGE => $er);
- }
- catch Error with {
+ }
+ catch Error with {
$t->param(MESSAGE => 'Registration failed.');
- } or return $t->output; # on error
+ } or return $t->output; # on error
+ # success
+ $self->send_email_with_validation_code($person);
+ $self->send_email_to_admin_about_new_registration($person);
- # success
- $self->send_email_with_validation_code($person);
- $self->send_email_to_admin_about_new_registration($person);
+ my $validation_url = "http://$ENV{HTTP_HOST}$ENV{REQUEST_URI}";
+ $validation_url =~ s/\w+.html$/validation.html/;
- my $validation_url = "http://$ENV{HTTP_HOST}$ENV{REQUEST_URI}";
- $validation_url =~ s/\w+.html$/validation.html/;
-
- $self->header_type('redirect');
- $self->header_props(-url => $validation_url);
+ $self->header_type('redirect');
+ $self->header_props(-url => $validation_url);
}
sub validation {
- my $self = shift;
- my $q = $self->query;
+ my $self = shift;
+ my $q = $self->query;
- eval {
- my $gbr = YAPC::Person->acknowladge($q->Vars);
- };
- if ($@) {
- my $t = $self->_server_page('validation');
- return $t->output;
- } else {
- my $t = $self->_server_page('thankyou');
- return $t->output;
- }
+ eval {my $gbr = YAPC::Person->acknowladge($q->Vars);};
+ if ($@) {
+ my $t = $self->_server_page('validation');
+ return $t->output;
+ }
+ else {
+ my $t = $self->_server_page('thankyou');
+ return $t->output;
+ }
}
sub _build_prop_page {
my $self = shift;
- my $q = $self->query;
- my $t = shift;
+ my $q = $self->query;
+ my $t = shift;
-
- my $length = $q->param('length') || '';
+ my $length = $q->param('length') || '';
my $language = $q->param('language') || '';
- my @length_selection = map {{ value => $_, text => $_, selected => ($length eq $_)} } @YAPC::Config::proposal_lengths;
+ my @length_selection = map {{value => $_, text => $_, selected => ($length eq $_)}} @YAPC::Config::proposal_lengths;
$t->param(length => \@length_selection);
- my @language_selection = map {{ value => $_, text => $_, selected => ($language eq $_)} } @YAPC::Config::proposal_languages;
+ my @language_selection = map {{value => $_, text => $_, selected => ($language eq $_)}} @YAPC::Config::proposal_languages;
$t->param(language => \@language_selection);
return $t->output;
}
sub proposal {
- my $self = shift;
- my $update = shift;
+ my $self = shift;
+ my $update = shift;
- my $q = $self->query;
- my $talk;
- my $id = $self->is_logged_in;
+ my $q = $self->query;
+ my $talk;
+ my $id = $self->is_logged_in;
- my $t = $self->_server_page('proposal');
+ my $t = $self->_server_page('proposal');
-# See logic in &lost_validation
- return $self->_build_prop_page($t) if not $q->param('submit');
+ # See logic in &lost_validation
+ return $self->_build_prop_page($t) if not $q->param('submit');
- eval {
- if ($update) {
+ eval {
+ if ($update)
+ {
$talk = YAPC::Talk->change_talk($q->Vars, user_id => $id);
- } else {
+ }
+ else {
$talk = YAPC::Talk->propose($q->Vars, user_id => $id);
}
- };
+ };
- if ($@) {
- my $msg = $@;
- $t->param(MESSAGE => 'There was an error in the provided data.');
- return $self->_build_prop_page($t);
- }
+ if ($@) {
+ my $msg = $@;
+ $t->param(MESSAGE => 'There was an error in the provided data.');
+ return $self->_build_prop_page($t);
+ }
- # success
- $self->send_new_proposal_to_admin($talk);
- $t = $self->_server_page('thank_proposal');
- return $t->output;
+ # success
+ $self->send_new_proposal_to_admin($talk);
+ $t = $self->_server_page('thank_proposal');
+ return $t->output;
}
sub edit_my_proposal {
my $self = shift;
- my $q = $self->query;
+ my $q = $self->query;
$self->send_message('no_such_proposal') if not $q->param('id');
-# return $self->_build_prop_page($t) unless $q->param('submit');
+ # return $self->_build_prop_page($t) unless $q->param('submit');
+ my $user_id = $self->is_logged_in;
+ my $t;
+ eval {($t) = YAPC::Talk->search(user_id => $user_id, id => $q->param('id'));};
+ return $self->send_message('no_such_proposal') if not $t;
- my $user_id = $self->is_logged_in;
- my $t;
- eval {
- ($t) = YAPC::Talk->search(user_id => $user_id, id => $q->param('id'));
- };
- return $self->send_message('no_such_proposal') if not $t;
+ return $self->proposal('update') if $q->param('submit');
- return $self->proposal('update') if $q->param('submit');
-
- $self->query->param(abstract => $t->abstract);
- $self->query->param(subject => $t->title);
- $self->query->param('length' => $t->length);
- $self->query->param(language => $t->language);
- $self->query->param(comment => $t->other);
- $self->query->param(id => $t->id);
+ $self->query->param(abstract => $t->abstract);
+ $self->query->param(subject => $t->title);
+ $self->query->param('length' => $t->length);
+ $self->query->param(language => $t->language);
+ $self->query->param(comment => $t->other);
+ $self->query->param(id => $t->id);
- $self->proposal('update');
+ $self->proposal('update');
}
-
sub send_new_proposal_to_admin {
- my $self = shift;
- my $talk = shift;
+ my $self = shift;
+ my $talk = shift;
- my $person = $talk->user_id;
- my $text = "Subject: " . $talk->title . "\n";
- $text .= "Speaker: ". $person->fname . " " . $person->lname . " " . $person->email . "\n";
- $text .= "Language: " . $talk->language . "\n";
- $text .= "Length: " . $talk->length . "\n";
- $text .= "Abstract: " . $talk->abstract . "\n";
- $text .= "Comments: " . $talk->other . "\n";
+ my $person = $talk->user_id;
+ my $text = "Subject: " . $talk->title . "\n";
+ $text .= "Speaker: " . $person->fname . " " . $person->lname . " " . $person->email . "\n";
+ $text .= "Language: " . $talk->language . "\n";
+ $text .= "Length: " . $talk->length . "\n";
+ $text .= "Abstract: " . $talk->abstract . "\n";
+ $text .= "Comments: " . $talk->other . "\n";
- # sending e-mail to administrator about new proposal
- my %mail = (To => $YAPC::Config::email_address,
- From => $YAPC::Config::email_address,
- Subject => "[YAPC talk] " . $talk->title,
- Message => $text,
- );
- sendmail(%mail) or die $Mail::Sendmail::error unless $ENV{YAPCOM_NOMAIL};
+ # sending e-mail to administrator about new proposal
+ my %mail = (
+ To => $YAPC::Config::email_address,
+ From => $YAPC::Config::email_address,
+ Subject => "[YAPC talk] " . $talk->title,
+ Message => $text,
+ );
+ sendmail(%mail) or die $Mail::Sendmail::error unless $ENV{YAPCOM_NOMAIL};
}
-
- # send e-mail to administrator
+# send e-mail to administrator
sub send_email_to_admin_about_new_registration {
- my $self = shift;
+ my $self = shift;
my $person = shift;
my $text = "Registrant\n";
$text .= sprintf "Name: %s %s <%s>\n", $person->fname, $person->lname, $person->email;
- $text .= sprintf "Phone: %s\n", $person->phone if defined $person->phone;
+ $text .= sprintf "Phone: %s\n", $person->phone if defined $person->phone;
$text .= sprintf "Company: %s\n", $person->company if defined $person->company;
my %spymail = (
- To => $YAPC::Config::email_address,
- From => $YAPC::Config::email_address,
- Subject => "new YAPC::Israel::2004 registration received",
- Message => $text,
- );
- sendmail(%spymail) or die $Mail::Sendmail::error unless $ENV{YAPCOM_NOMAIL};
+ To => $YAPC::Config::email_address,
+ From => $YAPC::Config::email_address,
+ Subject => "new YAPC::Israel::2004 registration received",
+ Message => $text,
+ );
+ sendmail(%spymail) or die $Mail::Sendmail::error unless $ENV{YAPCOM_NOMAIL};
}
-
sub personal_info {
- my $self = shift;
- my $q = $self->query;
+ my $self = shift;
+ my $q = $self->query;
- my $id = $self->is_logged_in;
- my ($person) = YAPC::Person->search(id => $id);
+ my $id = $self->is_logged_in;
+ my ($person) = YAPC::Person->search(id => $id);
- my @fields = qw(fname lname phone company country state city street zip pauseid url mongers bio);
+ my @fields = qw(fname lname phone company country state city street zip pauseid url mongers bio);
- my $t = $self->_server_page('personal_info');
- if (not $q->param('submit')) {
- foreach my $field (@fields) {
- my $v = $person->get($field) or next;
- $t->param($field => $v)
- }
- return $t->output;
- }
+ my $t = $self->_server_page('personal_info');
+ if (not $q->param('submit')) {
+ foreach my $field (@fields) {
+ my $v = $person->get($field) or next;
+ $t->param(
+ $field => $v
+ );
+ }
+ return $t->output;
+ }
- # are the password good and equal ?
- my %args;
- foreach my $f (@fields) {
- $args{$f} = $q->param($f) || '';
- }
+ # are the password good and equal ?
+ my %args;
+ foreach my $f (@fields) {
+ $args{$f} = $q->param($f) || '';
+ }
- if ($args{fname} and $args{lname} and $args{phone} ){
- $person->set($_ => $args{$_}) foreach @fields;
- $person->update;
+ if ($args{fname} and $args{lname} and $args{phone}) {
+ $person->set($_ => $args{$_}) foreach @fields;
+ $person->update;
- my $t = $self->_server_page('message');
- $t->param(personal_info_changed => 1);
- $t->param(id => $id);
- return $t->output;
- } else {
- $t->param(message => "Error");
- return $t->output;
- }
+ my $t = $self->_server_page('message');
+ $t->param(personal_info_changed => 1);
+ $t->param(id => $id);
+ return $t->output;
+ }
+ else {
+ $t->param(message => "Error");
+ return $t->output;
+ }
}
sub list_my_proposals {
@@ -679,16 +666,16 @@
my $ar = [];
foreach my $p (YAPC::Talk->search(user_id => $id)) {
- push @$ar,
+ push @$ar,
{
- title => $p->title,
- id => $p->id,
+ title => $p->title,
+ id => $p->id,
};
- }
+ }
- my $t = $self->_server_page('list_my_proposals');
- $t->param(TALKS => $ar);
- return $t->output;
+ my $t = $self->_server_page('list_my_proposals');
+ $t->param(TALKS => $ar);
+ return $t->output;
}
sub send_message {
@@ -702,14 +689,15 @@
Public view of details of a person
=cut
+
sub person {
my $self = shift;
- my $q = $self->query;
+ my $q = $self->query;
- my $id = $self->is_logged_in;
+ my $id = $self->is_logged_in;
my $admin = $self->is_admin_user($id);
- return $self->send_message('no_such_person') if not $q->param('id');
+ return $self->send_message('no_such_person') if not $q->param('id');
my $p;
# for administrators get back everyone, for non admins only validated people
@@ -717,37 +705,36 @@
if (not $admin) {
$search{acked} = 1;
}
- eval {
- ($p) = YAPC::Person->search(%search);
- };
+ eval {($p) = YAPC::Person->search(%search);};
return $self->send_message('no_such_person') if not $p;
- my $url = $p->url;
+ my $url = $p->url;
$url = "http://$url"; if ($url and substr($url, 0, 7) ne 'http://');
-
+
my $bio = $p->bio;
- $bio = htmlize($bio);
-
+ $bio = htmlize($bio);
+
my $t = $self->_server_page('person');
$t->param($_ => $p->get($_)) foreach (qw(fname lname pauseid mongers));
- $t->param(url => $url);
- $t->param(bio => $bio);
+ $t->param(url => $url);
+ $t->param(bio => $bio);
$t->param(owner => (defined $id and $id eq $q->param('id')));
if ($id and $self->is_admin_user($id)) {
- $t->param(admin => 1);
- $t->param(email => $p->email);
+ $t->param(admin => 1);
+ $t->param(email => $p->email);
$t->param(company => $p->company);
- $t->param(phone => $p->phone);
+ $t->param(phone => $p->phone);
my @prop = YAPC::Talk->search(user_id => $q->param('id'));
my @ar;
foreach my $prop (@prop) {
- push @ar, {
- id => $prop->id,
- title => $prop->title,
- };
+ push @ar,
+ {
+ id => $prop->id,
+ title => $prop->title,
+ };
}
- $t->param(PROPOSALS => \@ar);
+ $t->param(PROPOSALS => \@ar);
}
return $t->output;
@@ -755,7 +742,6 @@
1;
-
=pod
=head1 NAME
Modified: yapcom/trunk/lib/YAPC/Person.pm
===================================================================
--- yapcom/trunk/lib/YAPC/Person.pm 2003-12-02 21:02:48 UTC (rev 102)
+++ yapcom/trunk/lib/YAPC/Person.pm 2003-12-02 21:04:16 UTC (rev 103)
@@ -6,81 +6,88 @@
use base 'YAPC::DBI';
use YAPC::Error;
__PACKAGE__->set_up_table('people');
-__PACKAGE__->set_sql(total => qq{SELECT COUNT(*) total FROM people});
+__PACKAGE__->set_sql(total => qq{SELECT COUNT(*) total FROM people});
__PACKAGE__->set_sql(validated => qq{SELECT COUNT(*) validated FROM people WHERE acked=1});
sub new {
- my $self = shift;
- my %arg = @_;
+ my $self = shift;
+ my %arg = @_;
- croak("acked should not be defined\n") if defined $arg{acked};
- croak("authcode should not be defined\n") if defined $arg{authcode};
- croak("id should not be defined\n") if defined $arg{id};
+ croak("acked should not be defined\n") if defined $arg{acked};
+ croak("authcode should not be defined\n") if defined $arg{authcode};
+ croak("id should not be defined\n") if defined $arg{id};
- throw YAPC::Error("No First Name provided\n") if not $arg{fname};
- throw YAPC::Error("No Last Name provided\n") if not $arg{lname};
- throw YAPC::Error("No Phone provided\n") if not $arg{phone};
+ throw YAPC::Error("No First Name provided\n") if not $arg{fname};
+ throw YAPC::Error("No Last Name provided\n") if not $arg{lname};
+ throw YAPC::Error("No Phone provided\n") if not $arg{phone};
- my @valid_args = qw(fname lname phone email password company pauseid url mongers bio);
+ my @valid_args = qw(fname lname phone email password company pauseid url mongers bio);
- if (not defined $arg{email} or
- $arg{email} !~ /^[\w\d+=@.-]{5,}$/ or
- $arg{email} !~ /@/) {
+ if ( not defined $arg{email}
+ or $arg{email} !~ /^[\w\d+=@.-]{5,}$/
+ or $arg{email} !~ /@/)
+ {
- throw YAPC::Error("Bad e-mail given\n")
- }
- if ($arg{password} and $arg{password2} and
- $arg{password} eq $arg{password2}) {
- my %passed_args;
- @passed_args{@valid_args}= @arg{@valid_args};
- __PACKAGE__->create(\%passed_args); # could be $self-> also
- } else {
- throw YAPC::Error("Bad password pair given\n");
- }
+ throw YAPC::Error(
+ "Bad e-mail given\n");
+ }
+ if ( $arg{password}
+ and $arg{password2}
+ and $arg{password} eq $arg{password2})
+ {
+ my %passed_args;
+ @passed_args{@valid_args} = @arg{@valid_args};
+ __PACKAGE__->create(\%passed_args); # could be $self-> also
+ }
+ else {
+ throw YAPC::Error("Bad password pair given\n");
+ }
}
+__PACKAGE__->add_trigger(
+ before_create => sub {
+ my $self = shift;
+ $self->{authcode} = $self->_random_string(20);
+ $self->{acked} = 0; # default value
+ }
+);
-__PACKAGE__->add_trigger(before_create => sub {
- my $self = shift;
- $self->{authcode} = $self->_random_string(20);
- $self->{acked} = 0; # default value
-});
-
=head2 acknowladge
=cut
+
sub acknowladge {
my $self = shift;
my %arg = @_;
- delete $arg{run}; # was added for CGI::Application
+ delete $arg{run}; # was added for CGI::Application
-
my @people = __PACKAGE__->search(email => $arg{email});
- croak("Given e-mail was not unique\n") if @people > 1; # should never happen as email is unique in the databse
- croak("No such e-mail\n") if @people == 0;
- croak("No authcode provided\n") if not $arg{authcode};
- croak("Authcode is already empty\n") if $people[0]->authcode eq '';
- croak("Authcode is not correct\n") if $people[0]->authcode ne $arg{authcode};
- croak("Ack was already set\n") if $people[0]->acked;
+ croak("Given e-mail was not unique\n") if @people > 1; # should never happen as email is unique in the databse
+ croak("No such e-mail\n") if @people == 0;
+ croak("No authcode provided\n") if not $arg{authcode};
+ croak("Authcode is already empty\n") if $people[0]->authcode eq '';
+ croak("Authcode is not correct\n") if $people[0]->authcode ne $arg{authcode};
+ croak("Ack was already set\n") if $people[0]->acked;
- $people[0]->authcode('');
- $people[0]->acked(1);
+ $people[0]->authcode('');
+ $people[0]->acked(1);
$people[0]->update;
return $people[0];
}
-
=head2 retrieve_all_validated
Returns all the people whom have already validated their registration
=cut
+
sub retrieve_all_validated {
- #__PACKAGE__->retrieve_all;
- __PACKAGE__->search(acked => 1);
+
+ #__PACKAGE__->retrieve_all;
+ __PACKAGE__->search(acked => 1);
}
=head2 get_statistics
@@ -89,12 +96,12 @@
total => total number of registered people
validated => total number of registered and validated people
=cut
+
sub get_statistics {
- my @total = __PACKAGE__->search_total();
- my @valid = __PACKAGE__->search_validated();
- return {%{$total[0]}, %{$valid[0]}};
+ my @total = __PACKAGE__->search_total();
+ my @valid = __PACKAGE__->search_validated();
+ return {%{$total[0]}, %{$valid[0]}};
}
-
1;
Modified: yapcom/trunk/lib/YAPC/Talk.pm
===================================================================
--- yapcom/trunk/lib/YAPC/Talk.pm 2003-12-02 21:02:48 UTC (rev 102)
+++ yapcom/trunk/lib/YAPC/Talk.pm 2003-12-02 21:04:16 UTC (rev 103)
@@ -14,68 +14,65 @@
arguments and add the user id to it
=cut
+
sub propose {
- my $self = shift;
- my %args = $self->_check_values(@_);
+ my $self = shift;
+ my %args = $self->_check_values(@_);
- #croak("id should not be defined\n") if defined $args{id};
- delete $args{id};
+ #croak("id should not be defined\n") if defined $args{id};
+ delete $args{id};
- __PACKAGE__->create(\%args);
+ __PACKAGE__->create(\%args);
}
sub change_talk {
- my $self = shift;
- my %args = $self->_check_values(@_);
+ my $self = shift;
+ my %args = $self->_check_values(@_);
- croak("id should be defined\n") if not defined $args{id};
- my ($t) = __PACKAGE__->search(id => $args{id});
- my @valid_args = qw(id user_id title language length abstract other accepted);
- foreach my $a (@valid_args) {
- next if( $a eq 'user_id' or $a eq 'id' or $a eq 'accepted');
- $t->set($a => $args{$a});
- }
- $t->update;
- return $t;
+ croak("id should be defined\n") if not defined $args{id};
+ my ($t) = __PACKAGE__->search(id => $args{id});
+ my @valid_args = qw(id user_id title language length abstract other accepted);
+ foreach my $a (@valid_args) {
+ next if ($a eq 'user_id' or $a eq 'id' or $a eq 'accepted');
+ $t->set($a => $args{$a});
+ }
+ $t->update;
+ return $t;
}
-
sub _check_values {
- my $self = shift;
- my %args = @_;
+ my $self = shift;
+ my %args = @_;
- croak("Only authenticated users can submit proposals\n") if not $args{user_id};
- croak("No title provided\n") if not $args{subject};
- $args{title} = $args{subject};
- croak("No length provided\n") if not $args{'length'};
- croak("No abstract provided\n") if not $args{abstract};
- $args{accepted} = 0; # no trick from the outside please !
+ croak("Only authenticated users can submit proposals\n") if not $args{user_id};
+ croak("No title provided\n") if not $args{subject};
+ $args{title} = $args{subject};
+ croak("No length provided\n") if not $args{'length'};
+ croak("No abstract provided\n") if not $args{abstract};
+ $args{accepted} = 0; # no trick from the outside please !
- # the form will have comment field and now we use the other field for our purposes
- $args{other} = $args{comment};
+ # the form will have comment field and now we use the other field for our purposes
+ $args{other} = $args{comment};
- if (not grep {$args{language} eq $_} @YAPC::Config::proposal_languages) {
- croak("Incorrect language\n");
- }
+ if (not grep {$args{language} eq $_} @YAPC::Config::proposal_languages) {
+ croak("Incorrect language\n");
+ }
- if (not grep {$args{'length'} eq $_} @YAPC::Config::proposal_lengths) {
- croak("Incorrect length\n");
- }
+ if (not grep {$args{'length'} eq $_} @YAPC::Config::proposal_lengths) {
+ croak("Incorrect length\n");
+ }
- my @valid_args = qw(id user_id title language length abstract other accepted);
- my %passed_args;
- @passed_args{@valid_args}= @args{@valid_args};
- return %passed_args;
+ my @valid_args = qw(id user_id title language length abstract other accepted);
+ my %passed_args;
+ @passed_args{@valid_args} = @args{@valid_args};
+ return %passed_args;
}
-
-
=head2 VERSION
$Id:$
=cut
-
1;
Modified: yapcom/trunk/t/00-simple.t
===================================================================
--- yapcom/trunk/t/00-simple.t 2003-12-02 21:02:48 UTC (rev 102)
+++ yapcom/trunk/t/00-simple.t 2003-12-02 21:04:16 UTC (rev 103)
@@ -7,9 +7,9 @@
use Test::More qw(no_plan);
use lib qw(lib t/lib);
use YAPC::Test qw(init_db);
-BEGIN { use_ok( 'YAPC::Talk' ); }
-BEGIN { use_ok( 'YAPC::Person' ); }
-BEGIN { use_ok( 'YAPC::Login' ); }
-BEGIN { use_ok( 'YAPC::Config' ); }
-BEGIN { use_ok( 'YAPC::Organizer' ); }
+BEGIN {use_ok('YAPC::Talk');}
+BEGIN {use_ok('YAPC::Person');}
+BEGIN {use_ok('YAPC::Login');}
+BEGIN {use_ok('YAPC::Config');}
+BEGIN {use_ok('YAPC::Organizer');}
Modified: yapcom/trunk/t/01-adduser.t
===================================================================
--- yapcom/trunk/t/01-adduser.t 2003-12-02 21:02:48 UTC (rev 102)
+++ yapcom/trunk/t/01-adduser.t 2003-12-02 21:04:16 UTC (rev 103)
@@ -9,80 +9,73 @@
use YAPC::Test 'init_db';
use YAPC::Test::Data;
-BEGIN { use_ok( 'YAPC::Person' ); }
+BEGIN {use_ok('YAPC::Person');}
-is(YAPC::Person->retrieve_all, 0, 'no one in the database yet');
+is(YAPC::Person->retrieve_all, 0, 'no one in the database yet');
is(YAPC::Person->retrieve_all_validated, 0, 'no one in the database yet');
######### add the first person
my $p0 = YAPC::Person->new(%{$people[0]});
isa_ok($p0, 'YAPC::Person', 'First person added to database');
-is($p0->fname, $people[0]{fname}, 'First name is OK');
-is($p0->id, 1, 'Allocated first ID');
-is($p0->acked, 0, 'Acked set to 0');
-is($p0->password, $people[0]{password}, 'Password setup correctly');
-is(length $p0->authcode, 20, 'Authorization code is the right length');
+is($p0->fname, $people[0]{fname}, 'First name is OK');
+is($p0->id, 1, 'Allocated first ID');
+is($p0->acked, 0, 'Acked set to 0');
+is($p0->password, $people[0]{password}, 'Password setup correctly');
+is(length $p0->authcode, 20, 'Authorization code is the right length');
-is(YAPC::Person->retrieve_all, 1, '1 person is in the database');
+is(YAPC::Person->retrieve_all, 1, '1 person is in the database');
is(YAPC::Person->retrieve_all_validated, 0, 'No one was validated yet');
is_deeply(YAPC::Person->get_statistics, {total => 1, validated => 0}, 'get_statistics works');
-######### try to register the same person again
+######### try to register the same person again
{
- eval {
- YAPC::Person->new(%{$people[0]});
- };
- like($@, qr/^Can.t insert/, 'Duplicate entry rejected');
+ eval {YAPC::Person->new(%{$people[0]});};
+ like($@, qr/^Can.t insert/, 'Duplicate entry rejected');
}
-######## Register another person
+######## Register another person
my $p1 = YAPC::Person->new(%{$people[1]});
isa_ok($p1, 'YAPC::Person', 'Second person was added to the database');
is($p1->id, 2, 'Allocated second ID');
-
-is(YAPC::Person->retrieve_all, 2, 'There are 2 people in the database');
+is(YAPC::Person->retrieve_all, 2, 'There are 2 people in the database');
is(YAPC::Person->retrieve_all_validated, 0, 'No one was validated yet');
is_deeply(YAPC::Person->get_statistics, {total => 2, validated => 0}, 'get_statistics works');
-
######## check if the data in the database equals to the data we provided.
-{
- my @p = YAPC::Person->search(email => $people[0]->{email});
- is(@p, 1, 'There is only one man on the fields ..... with this e-mail address');
- isa_ok($p[0], 'YAPC::Person', 'Person retrieved');
- is($p[0]->email, $people[0]{email}, 'indeed the same e-mail');
- is($p[0]->acked, 0, 'acked=0');
- is($p[0]->authcode, $p0->authcode, 'authcode is the same in database as in original object');
- is($p[0]->company, $p0->company, 'Company is the same in database as in original object');
+{
+ my @p = YAPC::Person->search(email => $people[0]->{email});
+ is(@p, 1, 'There is only one man on the fields ..... with this e-mail address');
+ isa_ok($p[0], 'YAPC::Person', 'Person retrieved');
+ is($p[0]->email, $people[0]{email}, 'indeed the same e-mail');
+ is($p[0]->acked, 0, 'acked=0');
+ is($p[0]->authcode, $p0->authcode, 'authcode is the same in database as in original object');
+ is($p[0]->company, $p0->company, 'Company is the same in database as in original object');
}
############# avoid registering bad e-mail addresses, missing information, compare passwords
######## try to register users without any information
-eval {
- YAPC::Person->new();
-};
+eval {YAPC::Person->new();};
like($@, qr/./, 'could not create Person without data');
is(YAPC::Person->retrieve_all, 2, 'There are only two here');
is_deeply(YAPC::Person->get_statistics, {total => 2, validated => 0}, 'get_statistics works');
-
######## try to register users without one of the required fields (both undef and '' is checked)
### this part tests the various error messages of YAPC::Person without checking the
### exact phrases
foreach my $field (qw(fname lname email password password2)) {
eval {
- my %user = %{$people[2]};
- delete $user{$field};
- YAPC::Person->new(%user);
+ my %user = %{$people[2]};
+ delete $user{$field};
+ YAPC::Person->new(%user);
};
like($@, qr/./, "could not create Person without '$field'");
eval {
- my %user = %{$people[2]};
- $user{$field} = '';
- YAPC::Person->new(%user);
+ my %user = %{$people[2]};
+ $user{$field} = '';
+ YAPC::Person->new(%user);
};
like($@, qr/./, "could not create Person with empty '$field'");
}
@@ -107,73 +100,52 @@
######## two passwords are different
eval {
- my %user = %{$people[2]};
- $user{password2} = "$user{password}x";
- YAPC::Person->new(%user);
+ my %user = %{$people[2]};
+ $user{password2} = "$user{password}x";
+ YAPC::Person->new(%user);
};
like($@, qr/./, 'could not create Person with bad e-mail address');
-
-
######### number of People should be still the same at the end of so many unsuccessful registrations
my @all_people = YAPC::Person->retrieve_all;
is(@all_people, 2, 'There are only two here');
is_deeply(YAPC::Person->get_statistics, {total => 2, validated => 0}, 'get_statistics works');
-
-
-
-
-
-
-##########
+##########
# after registering a user we will have to send a respons to the browser and
# an e-mail with the authcode
# then the user comes to another URL where s/he will provide
-# e-mail and authcode. If they exists and the entry is not acked yet then we
-# change the acked to 1 and reset the authcode to ''
-##########
+# e-mail and authcode. If they exists and the entry is not acked yet then we
+# change the acked to 1 and reset the authcode to ''
+##########
##### bad acknowladgement, wrong e-mail provied
-eval {
- YAPC::Person->acknowladge((email => 'wrong email', authcode => 'any authcode'));
-};
-like ($@, qr/No such e-mail/, 'No such e-mail');
+eval {YAPC::Person->acknowladge((email => 'wrong email', authcode => 'any authcode'));};
+like($@, qr/No such e-mail/, 'No such e-mail');
##### bad acknowladgement, good e-mail but empty authcode
-eval {
- YAPC::Person->acknowladge((email => $people[0]{email}, authcode => ''));
-};
-like ($@, qr/No authcode provided/, 'No authcode provided');
+eval {YAPC::Person->acknowladge((email => $people[0]{email}, authcode => ''));};
+like($@, qr/No authcode provided/, 'No authcode provided');
##### bad acknowladgement, good e-mail but empty authcode
-eval {
- YAPC::Person->acknowladge((email => $people[0]{email}, authcode => 'bad code'));
-};
-like ($@, qr/Authcode is not correct/, 'Authcode is not correct');
+eval {YAPC::Person->acknowladge((email => $people[0]{email}, authcode => 'bad code'));};
+like($@, qr/Authcode is not correct/, 'Authcode is not correct');
-
-
######## good acknowladgement
{
- my $p = YAPC::Person->acknowladge((email => $people[0]{email}, authcode => $p0->authcode));
- isa_ok($p, 'YAPC::Person', 'Person retrieved');
- is($p->acked, 1, 'acked=1');
- is($p->authcode, '', 'authcode reset');
- is($p->email, $people[0]{email}, 'email is the same');
- is($p->password, $people[0]{password}, 'password is OK');
+ my $p = YAPC::Person->acknowladge((email => $people[0]{email}, authcode => $p0->authcode));
+ isa_ok($p, 'YAPC::Person', 'Person retrieved');
+ is($p->acked, 1, 'acked=1');
+ is($p->authcode, '', 'authcode reset');
+ is($p->email, $people[0]{email}, 'email is the same');
+ is($p->password, $people[0]{password}, 'password is OK');
}
-
-is(YAPC::Person->retrieve_all, 2, 'There are still two in the database');
+is(YAPC::Person->retrieve_all, 2, 'There are still two in the database');
is(YAPC::Person->retrieve_all_validated, 1, 'One was validated');
is_deeply(YAPC::Person->get_statistics, {total => 2, validated => 1}, 'get_statistics works');
########## Try to acknowladge the same e-mail again
-eval {
- YAPC::Person->acknowladge((email => $people[0]{email}, authcode => $p0->authcode));
-};
+eval {YAPC::Person->acknowladge((email => $people[0]{email}, authcode => $p0->authcode));};
like($@, qr/^Authcode is already empty/, 'Authcode is already empty');
-
-
Modified: yapcom/trunk/t/02-login.t
===================================================================
--- yapcom/trunk/t/02-login.t 2003-12-02 21:02:48 UTC (rev 102)
+++ yapcom/trunk/t/02-login.t 2003-12-02 21:04:16 UTC (rev 103)
@@ -10,84 +10,74 @@
use YAPC::Test::Data;
use Error qw(:try);
-BEGIN { use_ok( 'YAPC::Person' ); }
-BEGIN { use_ok( 'YAPC::Login' ); }
+BEGIN {use_ok('YAPC::Person');}
+BEGIN {use_ok('YAPC::Login');}
######### Register two people
my $p0 = YAPC::Person->new(%{$people[0]});
my $p1 = YAPC::Person->new(%{$people[1]});
-
######### number of People should be still the same
{
- my @all_people = YAPC::Person->retrieve_all;
- is(@all_people, 2, 'There are only two here');
+ my @all_people = YAPC::Person->retrieve_all;
+ is(@all_people, 2, 'There are only two here');
}
-
######## Login to not acknowladged account should fail
{
- my $ex;
- try {
- YAPC::Login->new((email => $people[1]{email}, password => $people[1]{password}));
- }
- catch YAPC::Error with {
- $ex = shift;
- };
- like($ex, qr/Not validated./, 'Login to not acknowladged account failed');
+ my $ex;
+ try {
+ YAPC::Login->new((email => $people[1]{email}, password => $people[1]{password}));
+ }
+ catch YAPC::Error with {
+ $ex = shift;
+ };
+ like($ex, qr/Not validated./, 'Login to not acknowladged account failed');
}
-
######## acknowladge user
YAPC::Person->acknowladge((email => $people[1]{email}, authcode => $p1->authcode));
-
##########
# login to the account with e-mail and password, get cookie
# after timeout cannot connect again (how to fake timeout ?)
# with the cookie list all the information
# with the cookie of one user should not be able to access the information of the other
-# with the cookie update some of the information
+# with the cookie update some of the information
# with the cookie submit a proposal
##########
{
- my $login = YAPC::Login->new((email => $people[1]{email}, password => $people[1]{password}));
- isa_ok($login, 'YAPC::Login', 'Login successful');
- is(length $login->cookie, 60, 'Cookie is the right length');
- is($login->user_id, 2, 'Got back the correct user id');
+ my $login = YAPC::Login->new((email => $people[1]{email}, password => $people[1]{password}));
+ isa_ok($login, 'YAPC::Login', 'Login successful');
+ is(length $login->cookie, 60, 'Cookie is the right length');
+ is($login->user_id, 2, 'Got back the correct user id');
-
######## check if the entry was correctly recorded in the database
- my @logins = YAPC::Login->retrieve_all;
- is(@logins, 1, 'there is exactly one login in the whole system');
- is($logins[0]->user_id, 2, 'it has the right user id');
- is($logins[0]->cookie, $login->cookie, 'it has the same cookie we set');
- my $timeout = time + $YAPC::Config::TIMEOUT;
- ok($logins[0]->timeout <= $timeout, 'timeout was set correctly');
- ok($logins[0]->timeout > $timeout-4 , 'timeout was set correctly');
+ my @logins = YAPC::Login->retrieve_all;
+ is(@logins, 1, 'there is exactly one login in the whole system');
+ is($logins[0]->user_id, 2, 'it has the right user id');
+ is($logins[0]->cookie, $login->cookie, 'it has the same cookie we set');
+ my $timeout = time + $YAPC::Config::TIMEOUT;
+ ok($logins[0]->timeout <= $timeout, 'timeout was set correctly');
+ ok($logins[0]->timeout > $timeout - 4, 'timeout was set correctly');
}
######## login with bad password should fail
-eval {
- YAPC::Login->new((email => $people[1]{email}, password => "bad_password"));
-};
+eval {YAPC::Login->new((email => $people[1]{email}, password => "bad_password"));};
like($@, qr/No match found/, 'Correct error thrown');
-
{
- my @logins = YAPC::Login->retrieve_all;
- is(@logins, 1, 'still only one login in the system');
+ my @logins = YAPC::Login->retrieve_all;
+ is(@logins, 1, 'still only one login in the system');
-
- ######## logout from the system (remove cookie from the database)
- my $ret = YAPC::Login->logout(cookie => $logins[0]->cookie);
- is($ret,1,'logout returned true');
+ ######## logout from the system (remove cookie from the database)
+ my $ret = YAPC::Login->logout(cookie => $logins[0]->cookie);
+ is($ret, 1, 'logout returned true');
}
{
- my @logins = YAPC::Login->retrieve_all;
- is(@logins, 0, 'no one is logged in any more');
+ my @logins = YAPC::Login->retrieve_all;
+ is(@logins, 0, 'no one is logged in any more');
}
-
Modified: yapcom/trunk/t/03-web-adduser.t
===================================================================
--- yapcom/trunk/t/03-web-adduser.t 2003-12-02 21:02:48 UTC (rev 102)
+++ yapcom/trunk/t/03-web-adduser.t 2003-12-02 21:04:16 UTC (rev 103)
@@ -10,33 +10,32 @@
use YAPC::Test::Data;
use YAPC::Person;
-use CGI; # needed for some of the tests
+use CGI; # needed for some of the tests
-$ENV{CGI_APP_RETURN_ONLY} = 1; # to eliminate screen output
+$ENV{CGI_APP_RETURN_ONLY} = 1; # to eliminate screen output
# to avoid warning caused my lack of web server in the test environment
-$ENV{HTTP_HOST} = 'test-host';
+$ENV{HTTP_HOST} = 'test-host';
+
# $ENV{REQUEST_URI} = 'test-uri'; #should be set for each request as we are using it
$ENV{YAPCOM_NOMAIL} = 1;
$ENV{REQUEST_URI} = '/';
-BEGIN { use_ok( 'YAPC::Organizer' ); }
+BEGIN {use_ok('YAPC::Organizer');}
-
my %user1 = %{$people[0]};
+
#YAPC::Test::Data::register_user(1);
-
{
- my $q = new CGI;
+ my $q = new CGI;
my $header = $q->header;
my $webapp = YAPC::Organizer->new;
is(ref($webapp), 'YAPC::Organizer', 'YAPC::Organizer object created');
ok($webapp->isa('CGI::Application'), 'The object is a CGI::Application object');
- like($webapp->run(), qr/^$header/ , 'Get back the same header as from CGI');
+ like($webapp->run(), qr/^$header/, 'Get back the same header as from CGI');
}
-
{
my $webapp = YAPC::Organizer->new;
$webapp->query(CGI->new());
@@ -48,7 +47,7 @@
# that won't change with time and we might need to have a set of tests that are installation
# specific.
{
- local $ENV{REQUEST_URI} = '/list_people.html';
+ local $ENV{REQUEST_URI} = '/list_people.html';
my $webapp = YAPC::Organizer->new;
$webapp->query(CGI->new());
my $result = $webapp->run();
@@ -60,11 +59,10 @@
is(@people, 0, 'no person is listed in the database');
}
-
##### access the registration page for the first time
{
- local $ENV{REQUEST_URI} = '/registration.html';
- my $q = CGI->new();
+ local $ENV{REQUEST_URI} = '/registration.html';
+ my $q = CGI->new();
my $webapp = YAPC::Organizer->new;
$webapp->query($q);
my $result = $webapp->run();
@@ -74,19 +72,21 @@
##### register a user
{
- local $ENV{REQUEST_URI} = '/registration.html';
+ local $ENV{REQUEST_URI} = '/registration.html';
my %user = %user1;
$user{pauseid} = 'MYPAUSEID';
- $user{submit} = 1;
- my $q = CGI->new(\%user);
+ $user{submit} = 1;
+ my $q = CGI->new(\%user);
my $webapp = YAPC::Organizer->new;
$webapp->query($q);
my $result = $webapp->run();
like($result, qr@Location: http://test-host/validation.html@, 'User registered, page redirected');
+
#like($result, qr/Thank you for registering/, 'User registered');
}
my $authcode1;
+
# fetch the authcode firectly from the database
{
my @people = YAPC::Person->search(email => $user1{email});
@@ -94,74 +94,70 @@
$authcode1 = $people[0]->authcode;
}
-
# try to register with not-existing field
{
- local $ENV{REQUEST_URI} = '/registration.html';
+ local $ENV{REQUEST_URI} = '/registration.html';
my %user = %user1;
- $user{email} = 'dudu@tomtom';
- $user{submit} = 1;
+ $user{email} = 'dudu@tomtom';
+ $user{submit} = 1;
$user{notexisting_field} = 'bad value';
- my $q = CGI->new(\%user);
+ my $q = CGI->new(\%user);
my $webapp = YAPC::Organizer->new;
$webapp->query($q);
my $result = $webapp->run();
like($result, qr@Location: http://test-host/validation.html@, 'User registered with extra fields, page redirected');
}
-
# try to supply value to fields we do not want to be overwrittent
-# id, acked, authcode
+# id, acked, authcode
{
- local $ENV{REQUEST_URI} = '/registration.html';
+ local $ENV{REQUEST_URI} = '/registration.html';
my %user = %user1;
- $user{email} = 'dudu@bad-id';
- $user{id} = 100;
+ $user{email} = 'dudu@bad-id';
+ $user{id} = 100;
$user{submit} = 1;
- my $q = CGI->new(\%user);
+ my $q = CGI->new(\%user);
my $webapp = YAPC::Organizer->new;
$webapp->query($q);
my $result = $webapp->run();
like($result, qr/Registration failed./, 'registration failed');
}
{
- local $ENV{REQUEST_URI} = '/registration.html';
+ local $ENV{REQUEST_URI} = '/registration.html';
my %user = %user1;
- $user{email} = 'dudu@bad-acked';
- $user{acked} = 100;
+ $user{email} = 'dudu@bad-acked';
+ $user{acked} = 100;
$user{submit} = 1;
- my $q = CGI->new(\%user);
+ my $q = CGI->new(\%user);
my $webapp = YAPC::Organizer->new;
$webapp->query($q);
my $result = $webapp->run();
like($result, qr/>Registration failed./, 'User failed to registere');
}
{
- local $ENV{REQUEST_URI} = '/registration.html';
+ local $ENV{REQUEST_URI} = '/registration.html';
my %user = %user1;
- $user{email} = 'dudu@bad-authcode';
+ $user{email} = 'dudu@bad-authcode';
$user{authcode} = 100;
- $user{submit} = 1;
+ $user{submit} = 1;
- my $q = CGI->new(\%user);
+ my $q = CGI->new(\%user);
my $webapp = YAPC::Organizer->new;
$webapp->query($q);
my $result = $webapp->run();
like($result, qr/Registration failed./, 'User faled because of bad authcode');
}
-
-
###### Login before validation
{
- local $ENV{REQUEST_URI} = '/login.html';
+ local $ENV{REQUEST_URI} = '/login.html';
my %user = %user1;
$user{submit} = 1;
- my $q = CGI->new(\%user);
+ my $q = CGI->new(\%user);
my $webapp = YAPC::Organizer->new;
$webapp->query($q);
my $result = $webapp->run();
@@ -170,7 +166,7 @@
##### show information about one person before validation should fail
{
- local $ENV{REQUEST_URI} = '/person.html';
+ local $ENV{REQUEST_URI} = '/person.html';
my $q = CGI->new({id => 1});
my $webapp = YAPC::Organizer->new;
$webapp->query($q);
@@ -178,15 +174,14 @@
like($result, qr/No such person/, 'Received error page');
}
-
###### validation
{
- local $ENV{REQUEST_URI} = '/validation.html';
+ local $ENV{REQUEST_URI} = '/validation.html';
my %user;
$user{email} = $user1{email};
- $user{authcode} = $authcode1;
+ $user{authcode} = $authcode1;
- my $q = CGI->new(\%user);
+ my $q = CGI->new(\%user);
my $webapp = YAPC::Organizer->new;
$webapp->query($q);
my $result = $webapp->run();
@@ -195,7 +190,7 @@
##### check if the link to search.cpan.org shows the PAUSEID
eval {
- local $ENV{REQUEST_URI} = '/list_people.html';
+ local $ENV{REQUEST_URI} = '/list_people.html';
my $webapp = YAPC::Organizer->new;
$webapp->query(CGI->new());
my $result = $webapp->run();
@@ -203,11 +198,9 @@
like($result, qr@http://search.cpan.org/author/MYPAUSEID@, 'PAUSEID was included');
};
-
-
##### show information about one person (without id it fails)
{
- local $ENV{REQUEST_URI} = '/person.html';
+ local $ENV{REQUEST_URI} = '/person.html';
my $webapp = YAPC::Organizer->new;
$webapp->query(CGI->new());
my $result = $webapp->run();
@@ -215,7 +208,7 @@
}
##### show information about one person (with not exiting id it fails)
{
- local $ENV{REQUEST_URI} = '/person.html';
+ local $ENV{REQUEST_URI} = '/person.html';
my $q = CGI->new({id => 30});
my $webapp = YAPC::Organizer->new;
$webapp->query($q);
@@ -224,7 +217,7 @@
}
##### show information about one person after validation
{
- local $ENV{REQUEST_URI} = '/person.html';
+ local $ENV{REQUEST_URI} = '/person.html';
my $q = CGI->new({id => 1});
my $webapp = YAPC::Organizer->new;
$webapp->query($q);
@@ -232,16 +225,12 @@
like($result, qr/$user1{fname}/, 'fname shown correctly');
}
-
-
-
-
-
###### login page
{
- local $ENV{REQUEST_URI} = '/login.html';
- my $q = CGI->new();
+ local $ENV{REQUEST_URI} = '/login.html';
+ my $q = CGI->new();
my $webapp = YAPC::Organizer->new;
+
#$webapp->query($q);
my $result = $webapp->run();
like($result, qr/<h2>Login<\/h2>/, 'Login page received');
@@ -250,15 +239,16 @@
my $cookie_value;
###### login after validation
{
- my $path = '/';
- local $ENV{REQUEST_URI} = '/login.html';
+ my $path = '/';
+ local $ENV{REQUEST_URI} = '/login.html';
my %user;
+
#$user{run} = 'login';
- $user{email} = $user1{email};
+ $user{email} = $user1{email};
$user{password} = $user1{password};
- $user{submit} = 1;
+ $user{submit} = 1;
- my $q = CGI->new(\%user);
+ my $q = CGI->new(\%user);
my $webapp = YAPC::Organizer->new;
$webapp->query($q);
my $result = $webapp->run();
@@ -269,6 +259,7 @@
is(length($cookie_value), 60, 'cookie is the right length');
like($result, qr@<h2>My YAPC</h2>@, 'User logged in');
+
# check the cookie
like($result, qr@^Content-Type: text/html@m, 'header received');
like($result, qr@^Set-Cookie: Yapcom=$cookie_value; domain=$ENV{HTTP_HOST}; path=$path@m, 'cookie set');
@@ -279,17 +270,18 @@
}
my $cookie_value2;
-###### login with the same user from a different browser
+###### login with the same user from a different browser
{
- my $path = '/';
- local $ENV{REQUEST_URI} = '/login.html';
+ my $path = '/';
+ local $ENV{REQUEST_URI} = '/login.html';
my %user;
+
#$user{run} = 'login';
- $user{email} = $user1{email};
+ $user{email} = $user1{email};
$user{password} = $user1{password};
- $user{submit} = 1;
+ $user{submit} = 1;
- my $q = CGI->new(\%user);
+ my $q = CGI->new(\%user);
my $webapp = YAPC::Organizer->new;
$webapp->query($q);
my $result = $webapp->run();
@@ -298,6 +290,7 @@
is(@logins, 2, 'there are two entries in the login table for this e-mail');
$cookie_value2 = $logins[1]->cookie;
like($result, qr@<h2>My YAPC</h2>@, 'User logged in');
+
# check the cookie
# this test assumes a certain order in the results of the by_email query.
@@ -306,30 +299,27 @@
}
-
-
-
###### login fails
{
- local $ENV{REQUEST_URI} = '/login.html';
+ local $ENV{REQUEST_URI} = '/login.html';
my %user;
+
#$user{run} = 'login';
- $user{email} = $user1{email};
+ $user{email} = $user1{email};
$user{password} = "$user1{password}xxx";
- $user{submit} = 1;
+ $user{submit} = 1;
- my $q = CGI->new(\%user);
+ my $q = CGI->new(\%user);
my $webapp = YAPC::Organizer->new;
$webapp->query($q);
my $result = $webapp->run();
like($result, qr/Login failed/, 'login failed');
}
-
####### accessing the proposal page without logging in first
-####### leads us to the login page with next=proposal.html set
+####### leads us to the login page with next=proposal.html set
{
- local $ENV{REQUEST_URI} = '/proposal.html';
+ local $ENV{REQUEST_URI} = '/proposal.html';
my $webapp = YAPC::Organizer->new;
$webapp->query();
my $result = $webapp->run();
@@ -338,9 +328,9 @@
}
####### accessing the user account page without logging in first
-####### leads us to the login page with next=user_account.html set
+####### leads us to the login page with next=user_account.html set
{
- local $ENV{REQUEST_URI} = '/user_account.html';
+ local $ENV{REQUEST_URI} = '/user_account.html';
my $webapp = YAPC::Organizer->new;
$webapp->query();
my $result = $webapp->run();
@@ -348,12 +338,11 @@
like($result, qr@<input type="hidden" name="next" value="user_account.html" />@, 'next set to user_account.html');
}
-
####### accessing the proposal page after logging in
{
- local $ENV{REQUEST_URI} = '/proposal.html';
+ local $ENV{REQUEST_URI} = '/proposal.html';
local $ENV{HTTP_COOKIE} = "Yapcom=$cookie_value";
- my $q = CGI->new();
+ my $q = CGI->new();
my $webapp = YAPC::Organizer->new;
$webapp->query($q);
my $result = $webapp->run();
@@ -362,9 +351,9 @@
####### accessing the proposal page after logging in but with different cookie
{
- local $ENV{REQUEST_URI} = '/proposal.html';
+ local $ENV{REQUEST_URI} = '/proposal.html';
local $ENV{HTTP_COOKIE} = "Yapcom=other $cookie_value";
- my $q = CGI->new();
+ my $q = CGI->new();
my $webapp = YAPC::Organizer->new;
$webapp->query($q);
my $result = $webapp->run();
@@ -374,20 +363,19 @@
###### accessing the login page when the users is logged in should bring up the My YAPC page
{
- local $ENV{REQUEST_URI} = '/login.html';
+ local $ENV{REQUEST_URI} = '/login.html';
local $ENV{HTTP_COOKIE} = "Yapcom=$cookie_value";
- my $q = CGI->new();
+ my $q = CGI->new();
my $webapp = YAPC::Organizer->new;
$webapp->query($q);
my $result = $webapp->run();
like($result, qr@<h2>My YAPC</h2>@, 'user is already logged in');
}
-
###### Accessing logout page while you are not loged in leads to the login page, next should NOT be set to logout !
{
- local $ENV{REQUEST_URI} = '/logout.html';
- my $q = CGI->new();
+ local $ENV{REQUEST_URI} = '/logout.html';
+ my $q = CGI->new();
my $webapp = YAPC::Organizer->new;
$webapp->query($q);
my $result = $webapp->run();
@@ -395,11 +383,11 @@
like($result, qr@<input type="hidden" name="next" value="" />@, 'next set to empty string');
}
-###### Accessing logout page
+###### Accessing logout page
{
- local $ENV{REQUEST_URI} = '/logout.html';
+ local $ENV{REQUEST_URI} = '/logout.html';
local $ENV{HTTP_COOKIE} = "Yapcom=$cookie_value";
- my $q = CGI->new();
+ my $q = CGI->new();
my $webapp = YAPC::Organizer->new;
$webapp->query($q);
my $result = $webapp->run();
@@ -407,9 +395,9 @@
}
####### accessing the proposal page after logout (cookie is still supplied)
-####### leads us to the login page with next=proposal.html set
+####### leads us to the login page with next=proposal.html set
{
- local $ENV{REQUEST_URI} = '/proposal.html';
+ local $ENV{REQUEST_URI} = '/proposal.html';
local $ENV{HTTP_COOKIE} = "Yapcom=$cookie_value";
my $webapp = YAPC::Organizer->new;
$webapp->query();
@@ -418,73 +406,69 @@
like($result, qr@<input type="hidden" name="next" value="proposal.html" />@, 'next set to proposal.html');
}
-
####### accessing the proposal page after logging in, from the other browser
{
- local $ENV{REQUEST_URI} = '/proposal.html';
+ local $ENV{REQUEST_URI} = '/proposal.html';
local $ENV{HTTP_COOKIE} = "Yapcom=$cookie_value2";
- my $q = CGI->new();
+ my $q = CGI->new();
my $webapp = YAPC::Organizer->new;
$webapp->query($q);
my $result = $webapp->run();
like($result, qr/<h2>Submit Proposal<\/h2>/, 'proposal page received');
}
-
####### get back lost password (user provides e-mail address we send the password)
###### show lost_validation page
{
- local $ENV{REQUEST_URI} = '/lost_validation.html';
- my $q = CGI->new();
+ local $ENV{REQUEST_URI} = '/lost_validation.html';
+ my $q = CGI->new();
my $webapp = YAPC::Organizer->new;
$webapp->query($q);
my $result = $webapp->run();
like($result, qr@<h2>Send lost validation code</h2>@, 'Send lost validation code');
-}
+}
####### get validation code if not validated yet
{
- local $ENV{REQUEST_URI} = '/lost_validation.html';
- my $q = CGI->new({email => 'bad-email', submit=>1});
+ local $ENV{REQUEST_URI} = '/lost_validation.html';
+ my $q = CGI->new({email => 'bad-email', submit => 1});
my $webapp = YAPC::Organizer->new;
$webapp->query($q);
my $result = $webapp->run();
like($result, qr/No such e-mail/, 'No such e-mail');
-}
+}
## already validated
{
- local $ENV{REQUEST_URI} = '/lost_validation.html';
+ local $ENV{REQUEST_URI} = '/lost_validation.html';
my $q = CGI->new({email => $people[0]{email}, submit => 1});
my $webapp = YAPC::Organizer->new;
$webapp->query($q);
my $result = $webapp->run();
like($result, qr/already validated/, 'already validated');
-}
+}
-
-
###### registering without validation
{
- local $ENV{REQUEST_URI} = '/registration.html';
+ local $ENV{REQUEST_URI} = '/registration.html';
my %user = %{$people[1]};
- $user{run} = 'registration';
+ $user{run} = 'registration';
$user{pauseid} = 'MYPAUSEID';
- $user{submit} = 1;
- my $q = CGI->new(\%user);
+ $user{submit} = 1;
+ my $q = CGI->new(\%user);
my $webapp = YAPC::Organizer->new;
$webapp->query($q);
my $result = $webapp->run();
like($result, qr@Location: http://test-host/validation.html@, 'User registered, page redirected');
+
#like($result, qr/Thank you for registering/, 'User registered');
}
-
## validation sent (we should check the real e-mail somehow)
{
- local $ENV{REQUEST_URI} = '/lost_validation.html';
- my $q = CGI->new({email => $people[1]{email}, submit =>1});
+ local $ENV{REQUEST_URI} = '/lost_validation.html';
+ my $q = CGI->new({email => $people[1]{email}, submit => 1});
my $webapp = YAPC::Organizer->new;
$webapp->query($q);
my $result = $webapp->run();
@@ -493,29 +477,27 @@
####### access lost_password page with no data
{
- local $ENV{REQUEST_URI} = '/lost_password.html';
- my $q = CGI->new();
+ local $ENV{REQUEST_URI} = '/lost_password.html';
+ my $q = CGI->new();
my $webapp = YAPC::Organizer->new;
$webapp->query($q);
my $result = $webapp->run();
like($result, qr@<h2>Send lost password</h2>@, 'lost_password page accessed');
}
-
####### get lost password
{
- local $ENV{REQUEST_URI} = '/lost_password.html';
- my $q = CGI->new({email => 'bad-email', submit =>1});
+ local $ENV{REQUEST_URI} = '/lost_password.html';
+ my $q = CGI->new({email => 'bad-email', submit => 1});
my $webapp = YAPC::Organizer->new;
$webapp->query($q);
my $result = $webapp->run();
like($result, qr/No such e-mail/, 'No such e-mail');
}
-
## password sent (we should check the real e-mail somehow)
{
- local $ENV{REQUEST_URI} = '/lost_password.html';
+ local $ENV{REQUEST_URI} = '/lost_password.html';
my $q = CGI->new({email => $people[0]{email}, submit => 1});
my $webapp = YAPC::Organizer->new;
$webapp->query($q);
@@ -526,8 +508,3 @@
##### get password of an e-mail which was never validated might need to fail
##### though this is not a real issue I think.
-
-
-
-
-
Modified: yapcom/trunk/t/04-proposals.t
===================================================================
--- yapcom/trunk/t/04-proposals.t 2003-12-02 21:02:48 UTC (rev 102)
+++ yapcom/trunk/t/04-proposals.t 2003-12-02 21:04:16 UTC (rev 103)
@@ -9,133 +9,125 @@
use YAPC::Test 'init_db';
use YAPC::Test::Data;
-BEGIN { use_ok( 'YAPC::Person' ); }
-BEGIN { use_ok( 'YAPC::Login' ); }
-BEGIN { use_ok( 'YAPC::Talk' ); }
+BEGIN {use_ok('YAPC::Person');}
+BEGIN {use_ok('YAPC::Login');}
+BEGIN {use_ok('YAPC::Talk');}
-
-
######### Register two people and acknowladge one of them
my $p0 = YAPC::Person->new(%{$people[0]});
my $p1 = YAPC::Person->new(%{$people[1]});
YAPC::Person->acknowladge((email => $people[1]{email}, authcode => $p1->authcode));
-
######## login
my $login = YAPC::Login->new((email => $people[1]{email}, password => $people[1]{password}));
isa_ok($login, 'YAPC::Login', 'Login successful');
my $work_cookie = $login->cookie;
-my $work_uid = $login->user_id;
+my $work_uid = $login->user_id;
##########
# login to the account with e-mail and password, get cookie
# after timeout cannot connect again (how to fake timeout ?)
# with the cookie list all the information
# with the cookie of one user should not be able to access the information of the other
-# with the cookie update some of the information
+# with the cookie update some of the information
# with the cookie submit a proposal
##########
my %proposal = (
- subject => 'The history of the Praying Mantis',
+ subject => 'The history of the Praying Mantis',
'length' => 5,
language => 'Hebrew',
abstract => "I am going to talk about how the creature was born.\nWhy is that not a camel and how to feed it\n",
comment => "Are you serious?\n I need at least 6 minutes to talk about this subject\n",
user_id => $work_uid,
bad_field => 'should be ignored',
-# cookie => $work_cookie,
+
+ # cookie => $work_cookie,
);
###### Check if the database is empty
{
my @talks = YAPC::Talk->retrieve_all;
- is(@talks, 0, 'There are NO talks in the database');
+ is(@talks, 0, 'There are NO talks in the database');
}
###### Submit a proposal with a valid cookie
{
YAPC::Talk->propose(%proposal);
my @talks = YAPC::Talk->retrieve_all;
- is(@talks, 1, 'There is one talk in the database');
+ is(@talks, 1, 'There is one talk in the database');
is($talks[0]->title, $proposal{subject}, 'The title was recorded correctly');
}
-
###### Cannot submit a proposal without a valid cookie
{
my %prop = %proposal;
+
#delete $prop{cookie};
delete $prop{user_id};
- eval {
- YAPC::Talk->propose(%prop);
- };
+ eval {YAPC::Talk->propose(%prop);};
like($@, qr/Only authenticated users can submit proposals/, 'Only authenticated users can submit proposals');
my @talks = YAPC::Talk->retrieve_all;
- is(@talks, 1, 'There is one talk in the database');
+ is(@talks, 1, 'There is one talk in the database');
}
###### Submit a second proposal with a valid cookie
{
my %prop = %proposal;
- $prop{subject} = q(New day, new talk, all kinds of strang characters ~!@#$%^&*<>/?`=-[]\{}"|");
- $prop{length} = 30;
+ $prop{subject} = q(New day, new talk, all kinds of strang characters ~!@#$%^&*<>/?`=-[]\{}"|");
+ $prop{length} = 30;
YAPC::Talk->propose(%prop);
my @talks = YAPC::Talk->retrieve_all;
- is(@talks, 2, 'There are now two talks in the database');
+ is(@talks, 2, 'There are now two talks in the database');
is($talks[0]->title, $proposal{subject}, 'The title was recorded correctly');
- is($talks[1]->title, $prop{subject}, 'The title was recorded correctly');
+ is($talks[1]->title, $prop{subject}, 'The title was recorded correctly');
}
###### Submit a third proposal with a valid cookie and and the id field set to ''
{
my %prop = %proposal;
- $prop{subject} = q(akdjakhdsakf);
- $prop{length} = 90;
- $prop{id} = '';
+ $prop{subject} = q(akdjakhdsakf);
+ $prop{length} = 90;
+ $prop{id} = '';
YAPC::Talk->propose(%prop);
my @talks = YAPC::Talk->retrieve_all;
- is(@talks, 3, 'There are now two talks in the database');
+ is(@talks, 3, 'There are now two talks in the database');
is($talks[0]->title, $proposal{subject}, 'The title was recorded correctly');
- is($talks[2]->title, $prop{subject}, 'The title was recorded correctly');
+ is($talks[2]->title, $prop{subject}, 'The title was recorded correctly');
}
###### Submit a third proposal with a valid cookie and and the id field set to 1 an exising talk id
{
my %prop = %proposal;
- $prop{subject} = YAPC::DBI->_random_string(20);
- $prop{length} = 90;
- $prop{id} = 1;
+ $prop{subject} = YAPC::DBI->_random_string(20);
+ $prop{length} = 90;
+ $prop{id} = 1;
YAPC::Talk->propose(%prop);
my @talks = YAPC::Talk->retrieve_all;
- is(@talks, 4, 'There are now two talks in the database');
- is($talks[0]->title, $proposal{subject}, 'The title was recorded correctly');
- is($talks[-1]->title, $prop{subject}, 'The title was recorded correctly');
+ is(@talks, 4, 'There are now two talks in the database');
+ is($talks[0]->title, $proposal{subject}, 'The title was recorded correctly');
+ is($talks[-1]->title, $prop{subject}, 'The title was recorded correctly');
}
###### Submit a third proposal with a valid cookie and and the id field set to 9 a not exising talk id
{
my %prop = %proposal;
- $prop{subject} = YAPC::DBI->_random_string(20);
- $prop{length} = 90;
- $prop{id} = 9;
+ $prop{subject} = YAPC::DBI->_random_string(20);
+ $prop{length} = 90;
+ $prop{id} = 9;
YAPC::Talk->propose(%prop);
my @talks = YAPC::Talk->retrieve_all;
- is(@talks, 5, 'There are now two talks in the database');
- is($talks[0]->title, $proposal{subject}, 'The title was recorded correctly');
- is($talks[-1]->title, $prop{subject}, 'The title was recorded correctly');
+ is(@talks, 5, 'There are now two talks in the database');
+ is($talks[0]->title, $proposal{subject}, 'The title was recorded correctly');
+ is($talks[-1]->title, $prop{subject}, 'The title was recorded correctly');
}
-
-
-
######## logout from the system (remove cookie from the database)
my $ret = YAPC::Login->logout(cookie => $work_cookie);
-is($ret,1,'logout returned true');
+is($ret, 1, 'logout returned true');
my @logins = YAPC::Login->retrieve_all;
is(@logins, 0, 'no one is logged in any more');
-
=pod
###### Cannot submit a proposal after logout even with cookie that was valid once
{
@@ -149,5 +141,3 @@
}
=cut
-
-
Modified: yapcom/trunk/t/05-web-proposals.t
===================================================================
--- yapcom/trunk/t/05-web-proposals.t 2003-12-02 21:02:48 UTC (rev 102)
+++ yapcom/trunk/t/05-web-proposals.t 2003-12-02 21:04:16 UTC (rev 103)
@@ -10,59 +10,57 @@
use YAPC::Test::Data;
use YAPC::Person;
-use CGI; # needed for some of the tests
+use CGI; # needed for some of the tests
-$ENV{CGI_APP_RETURN_ONLY} = 1; # to eliminate screen output
+$ENV{CGI_APP_RETURN_ONLY} = 1; # to eliminate screen output
# to avoid warning caused my lack of web server in the test environment
-$ENV{HTTP_HOST} = 'test-host';
+$ENV{HTTP_HOST} = 'test-host';
+
# $ENV{REQUEST_URI} = 'test-uri'; #should be set for each request as we are using it
$ENV{YAPCOM_NOMAIL} = 1;
$ENV{REQUEST_URI} = '/';
-BEGIN { use_ok( 'YAPC::Organizer' ); }
+BEGIN {use_ok('YAPC::Organizer');}
###### prepare the environment: create and validate users and make them login
my @cookies;
my @uids;
-push @uids, YAPC::Test::Data::register_user(0);
-push @uids, YAPC::Test::Data::register_user(1);
+push @uids, YAPC::Test::Data::register_user(0);
+push @uids, YAPC::Test::Data::register_user(1);
push @cookies, YAPC::Test::Data::login_user(0);
-
####### accessing the proposal page after logging in
{
- local $ENV{REQUEST_URI} = '/proposal.html';
+ local $ENV{REQUEST_URI} = '/proposal.html';
local $ENV{HTTP_COOKIE} = "Yapcom=$cookies[0]";
- my $q = CGI->new();
+ my $q = CGI->new();
my $webapp = YAPC::Organizer->new;
$webapp->query($q);
my $result = $webapp->run();
like($result, qr/<h2>Submit Proposal<\/h2>/, 'proposal page received');
like($result, qr/<option value="English" >/, 'proposal page received');
- like($result, qr/<option value="180" >/, 'proposal page received');
+ like($result, qr/<option value="180" >/, 'proposal page received');
}
-
-
-
# submit a proposal
my %proposal = (
- subject => "Nice talk",
- 'length' => 5,
- 'language' => 'English',
- 'abstract' => 'This is my abstract',
- 'comment' => 'There can be a comment, no ?',
- 'submit' => 1,
+ subject => "Nice talk",
+ 'length' => 5,
+ 'language' => 'English',
+ 'abstract' => 'This is my abstract',
+ 'comment' => 'There can be a comment, no ?',
+ 'submit' => 1,
);
####### sending a proposal
{
- local $ENV{REQUEST_URI} = '/proposal.html';
+ local $ENV{REQUEST_URI} = '/proposal.html';
local $ENV{HTTP_COOKIE} = "Yapcom=$cookies[0]";
my %prop = %proposal;
+
#$prop{run} = 'send_proposal';
- my $q = CGI->new(\%prop);
+ my $q = CGI->new(\%prop);
my $webapp = YAPC::Organizer->new;
$webapp->query($q);
my $result = $webapp->run();
@@ -75,10 +73,11 @@
####### sending a proposal without a cookie
{
- local $ENV{REQUEST_URI} = '/proposal.html';
+ local $ENV{REQUEST_URI} = '/proposal.html';
my %prop = %proposal;
+
#$prop{run} = 'send_proposal';
- my $q = CGI->new(\%prop);
+ my $q = CGI->new(\%prop);
my $webapp = YAPC::Organizer->new;
$webapp->query($q);
my $result = $webapp->run();
@@ -89,12 +88,13 @@
####### sending a proposal with missing or bad information
{
- local $ENV{REQUEST_URI} = '/proposal.html';
+ local $ENV{REQUEST_URI} = '/proposal.html';
local $ENV{HTTP_COOKIE} = "Yapcom=$cookies[0]";
my %prop = %proposal;
+
#$prop{run} = 'send_proposal';
$prop{subject} = '';
- my $q = CGI->new(\%prop);
+ my $q = CGI->new(\%prop);
my $webapp = YAPC::Organizer->new;
$webapp->query($q);
my $result = $webapp->run();
@@ -103,14 +103,14 @@
is(@talks, 1, 'There is one talk in the database');
}
-
{
- local $ENV{REQUEST_URI} = '/proposal.html';
+ local $ENV{REQUEST_URI} = '/proposal.html';
local $ENV{HTTP_COOKIE} = "Yapcom=$cookies[0]";
my %prop = %proposal;
+
#$prop{run} = 'send_proposal';
$prop{abstract} = '';
- my $q = CGI->new(\%prop);
+ my $q = CGI->new(\%prop);
my $webapp = YAPC::Organizer->new;
$webapp->query($q);
my $result = $webapp->run();
@@ -119,12 +119,12 @@
is(@talks, 1, 'There is one talk in the database');
}
{
- local $ENV{REQUEST_URI} = '/proposal.html';
+ local $ENV{REQUEST_URI} = '/proposal.html';
local $ENV{HTTP_COOKIE} = "Yapcom=$cookies[0]";
my %prop = %proposal;
- $prop{run} = 'send_proposal';
+ $prop{run} = 'send_proposal';
$prop{length} = '';
- my $q = CGI->new(\%prop);
+ my $q = CGI->new(\%prop);
my $webapp = YAPC::Organizer->new;
$webapp->query($q);
my $result = $webapp->run();
@@ -134,12 +134,12 @@
}
{
- local $ENV{REQUEST_URI} = '/proposal.html';
+ local $ENV{REQUEST_URI} = '/proposal.html';
local $ENV{HTTP_COOKIE} = "Yapcom=$cookies[0]";
my %prop = %proposal;
- $prop{run} = 'send_proposal';
+ $prop{run} = 'send_proposal';
$prop{length} = 6;
- my $q = CGI->new(\%prop);
+ my $q = CGI->new(\%prop);
my $webapp = YAPC::Organizer->new;
$webapp->query($q);
my $result = $webapp->run();
@@ -148,12 +148,12 @@
is(@talks, 1, 'There is one talk in the database');
}
{
- local $ENV{REQUEST_URI} = '/proposal.html';
+ local $ENV{REQUEST_URI} = '/proposal.html';
local $ENV{HTTP_COOKIE} = "Yapcom=$cookies[0]";
my %prop = %proposal;
- $prop{run} = 'send_proposal';
+ $prop{run} = 'send_proposal';
$prop{language} = 'Esperanto';
- my $q = CGI->new(\%prop);
+ my $q = CGI->new(\%prop);
my $webapp = YAPC::Organizer->new;
$webapp->query($q);
my $result = $webapp->run();
@@ -162,16 +162,15 @@
is(@talks, 1, 'There is one talk in the database');
}
-
##### sending proposal with the user_id of someone else
## maybe this should fail as it is or whould be logged
{
- local $ENV{REQUEST_URI} = '/proposal.html';
+ local $ENV{REQUEST_URI} = '/proposal.html';
local $ENV{HTTP_COOKIE} = "Yapcom=$cookies[0]";
my %prop = %proposal;
- $prop{run} = 'send_proposal';
+ $prop{run} = 'send_proposal';
$prop{user_id} = $uids[1];
- my $q = CGI->new(\%prop);
+ my $q = CGI->new(\%prop);
my $webapp = YAPC::Organizer->new;
$webapp->query($q);
my $result = $webapp->run();
@@ -182,20 +181,14 @@
is($talker_id, $uids[0], 'Talk registered to the correct user (the one logged in)');
}
-
-
-###### Accessing logout page
+###### Accessing logout page
{
- local $ENV{REQUEST_URI} = '/logout.html';
+ local $ENV{REQUEST_URI} = '/logout.html';
local $ENV{HTTP_COOKIE} = "Yapcom=$cookies[0]";
- my $q = CGI->new();
+ my $q = CGI->new();
my $webapp = YAPC::Organizer->new;
$webapp->query($q);
my $result = $webapp->run();
like($result, qr@You have successfully loged out@, 'user was logged out');
}
-
-
-
-
Modified: yapcom/trunk/t/07-web-change-data.t
===================================================================
--- yapcom/trunk/t/07-web-change-data.t 2003-12-02 21:02:48 UTC (rev 102)
+++ yapcom/trunk/t/07-web-change-data.t 2003-12-02 21:04:16 UTC (rev 103)
@@ -1,10 +1,9 @@
#!/usr/bin/perl
# -T
-# Testing how can a user change the information about himself
+# Testing how can a user change the information about himself
# using the web interface
-
use strict;
use warnings;
use Test::More qw(no_plan);
@@ -14,17 +13,18 @@
use YAPC::Test::Data;
use YAPC::Person;
-use CGI; # needed for some of the tests
+use CGI; # needed for some of the tests
-$ENV{CGI_APP_RETURN_ONLY} = 1; # to eliminate screen output
+$ENV{CGI_APP_RETURN_ONLY} = 1; # to eliminate screen output
# to avoid warning caused my lack of web server in the test environment
-$ENV{HTTP_HOST} = 'test-host';
+$ENV{HTTP_HOST} = 'test-host';
+
# $ENV{REQUEST_URI} = 'test-uri'; #should be set for each request as we are using it
$ENV{YAPCOM_NOMAIL} = 1;
$ENV{REQUEST_URI} = '/';
-BEGIN { use_ok( 'YAPC::Organizer' ); }
+BEGIN {use_ok('YAPC::Organizer');}
###### prepare the environment: create and validate users and make them login
my @cookies;
@@ -38,12 +38,12 @@
isnt($cookies[0], $cookies[2], 'cookies are different');
isnt($cookies[1], $cookies[2], 'cookies are different');
-
# access the change personal_info page fails if not authenticated
{
- local $ENV{REQUEST_URI} = '/personal_info.html';
+ local $ENV{REQUEST_URI} = '/personal_info.html';
+
#local $ENV{HTTP_COOKIE} = "Yapcom=$cookies[0]";
- my $q = CGI->new();
+ my $q = CGI->new();
my $webapp = YAPC::Organizer->new;
$webapp->query($q);
my $result = $webapp->run();
@@ -52,9 +52,10 @@
# update personal_information fails if not authenticated
{
- local $ENV{REQUEST_URI} = '/personal_info.html';
+ local $ENV{REQUEST_URI} = '/personal_info.html';
+
#local $ENV{HTTP_COOKIE} = "Yapcom=$cookies[0]";
- my $q = CGI->new();
+ my $q = CGI->new();
my $webapp = YAPC::Organizer->new;
$webapp->query($q);
my $result = $webapp->run();
@@ -63,26 +64,27 @@
# access to personl_info page is successful when authenticated
{
- local $ENV{REQUEST_URI} = '/personal_info.html';
+ local $ENV{REQUEST_URI} = '/personal_info.html';
local $ENV{HTTP_COOKIE} = "Yapcom=$cookies[0]";
- my $q = CGI->new();
+ my $q = CGI->new();
my $webapp = YAPC::Organizer->new;
$webapp->query($q);
my $result = $webapp->run();
- like($result, qr@<h2>Change Personal Information</h2>@, 'personal_info page accessed');
+ like($result, qr@<h2>Change Personal Information</h2>@, 'personal_info page accessed');
like($result, qr@\Q<tr><td>First Name:</td><td><input size="40" name="fname" value="$people[0]{fname}" /> *</td></tr>@, 'old fname filled in correclty');
- like($result, qr@\Q<tr><td>Last Name:</td><td><input size="40" name="lname" value="$people[0]{lname}" /> *</td></tr>@, 'old lname filled in correclty');
- like($result, qr@\Q<tr><td>Phone:</td><td><input size="40" name="phone" value="$people[0]{phone}" /> *</td></tr>@, 'old phone filled in correclty');
- like($result, qr@\Q<tr><td>Company:</td><td><input size="40" name="company" value="" /></td></tr>@, 'old company filled in correctly');
- # $people[0]{company}
+ like($result, qr@\Q<tr><td>Last Name:</td><td><input size="40" name="lname" value="$people[0]{lname}" /> *</td></tr>@, 'old lname filled in correclty');
+ like($result, qr@\Q<tr><td>Phone:</td><td><input size="40" name="phone" value="$people[0]{phone}" /> *</td></tr>@, 'old phone filled in correclty');
+ like($result, qr@\Q<tr><td>Company:</td><td><input size="40" name="company" value="" /></td></tr>@, 'old company filled in correctly');
+
+ # $people[0]{company}
}
-
# submit change to personl_info page when not authenticated
# no value submitted:
{
- local $ENV{REQUEST_URI} = '/personal_info.html';
-# local $ENV{HTTP_COOKIE} = "Yapcom=$cookies[0]";
+ local $ENV{REQUEST_URI} = '/personal_info.html';
+
+ # local $ENV{HTTP_COOKIE} = "Yapcom=$cookies[0]";
my $q = CGI->new({submit => 1});
my $webapp = YAPC::Organizer->new;
$webapp->query($q);
@@ -90,57 +92,67 @@
like($result, qr@<h2>Login</h2>@, 'Redirected to login page');
}
-
# like($result, qr@<h2>Change Personal Information</h2>@, 'personal_info page accessed');
# submit change to personl_info page gives error when authenticated but not enough data provided.
{
- local $ENV{REQUEST_URI} = '/personal_info.html';
+ local $ENV{REQUEST_URI} = '/personal_info.html';
local $ENV{HTTP_COOKIE} = "Yapcom=$cookies[0]";
my $q = CGI->new({submit => 1});
my $webapp = YAPC::Organizer->new;
$webapp->query($q);
my $result = $webapp->run();
- like($result, qr@Error@, 'Error');
- like($result, qr@<h2>Change Personal Information</h2>@, 'personal_info page accessed');
+ like($result, qr@Error@, 'Error');
+ like($result, qr@<h2>Change Personal Information</h2>@, 'personal_info page accessed');
like($result, qr@\Q<tr><td>First Name:</td><td><input size="40" name="fname" value="" /> *</td></tr>@, 'old fname filled in correclty');
- like($result, qr@\Q<tr><td>Last Name:</td><td><input size="40" name="lname" value="" /> *</td></tr>@, 'old lname filled in correclty');
- like($result, qr@\Q<tr><td>Phone:</td><td><input size="40" name="phone" value="" /> *</td></tr>@, 'old phone filled in correclty');
- like($result, qr@\Q<tr><td>Company:</td><td><input size="40" name="company" value="" /></td></tr>@, 'old company filled in correclty');
+ like($result, qr@\Q<tr><td>Last Name:</td><td><input size="40" name="lname" value="" /> *</td></tr>@, 'old lname filled in correclty');
+ like($result, qr@\Q<tr><td>Phone:</td><td><input size="40" name="phone" value="" /> *</td></tr>@, 'old phone filled in correclty');
+ like($result, qr@\Q<tr><td>Company:</td><td><input size="40" name="company" value="" /></td></tr>@, 'old company filled in correclty');
}
{
- local $ENV{REQUEST_URI} = '/personal_info.html';
+ local $ENV{REQUEST_URI} = '/personal_info.html';
local $ENV{HTTP_COOKIE} = "Yapcom=$cookies[0]";
- my $q = CGI->new({submit => 1, fname => $people[3]{fname}, lname => $people[3]{lname}, company=>$people[3]{company}});
+ my $q =
+ CGI->new(
+ {
+ submit => 1,
+ fname => $people[3]{fname},
+ lname => $people[3]{lname},
+ company => $people[3]{company}
+ }
+ );
my $webapp = YAPC::Organizer->new;
$webapp->query($q);
my $result = $webapp->run();
- like($result, qr@Error@, 'Error');
- like($result, qr@<h2>Change Personal Information</h2>@, 'personal_info page accessed');
+ like($result, qr@Error@, 'Error');
+ like($result, qr@<h2>Change Personal Information</h2>@, 'personal_info page accessed');
like($result, qr@\Q<tr><td>First Name:</td><td><input size="40" name="fname" value="$people[3]{fname}" /> *</td></tr>@, 'old fname filled in correclty');
- like($result, qr@\Q<tr><td>Last Name:</td><td><input size="40" name="lname" value="$people[3]{lname}" /> *</td></tr>@, 'old lname filled in correclty');
- like($result, qr@\Q<tr><td>Phone:</td><td><input size="40" name="phone" value="" /> *</td></tr>@, 'old phone filled in correclty');
+ like($result, qr@\Q<tr><td>Last Name:</td><td><input size="40" name="lname" value="$people[3]{lname}" /> *</td></tr>@, 'old lname filled in correclty');
+ like($result, qr@\Q<tr><td>Phone:</td><td><input size="40" name="phone" value="" /> *</td></tr>@, 'old phone filled in correclty');
like($result, qr@\Q<tr><td>Company:</td><td><input size="40" name="company" value="$people[3]{company}" /></td></tr>@, 'old company filled in correclty');
}
##### submitted data gets updated in the database
{
- local $ENV{REQUEST_URI} = '/personal_info.html';
+ local $ENV{REQUEST_URI} = '/personal_info.html';
local $ENV{HTTP_COOKIE} = "Yapcom=$cookies[0]";
- my $q = CGI->new({submit => 1, fname => $people[3]{fname}, lname => $people[3]{lname}, phone => $people[3]{phone}, company=>$people[3]{company}});
+ my $q =
+ CGI->new(
+ {
+ submit => 1,
+ fname => $people[3]{fname},
+ lname => $people[3]{lname},
+ phone => $people[3]{phone},
+ company => $people[3]{company}
+ }
+ );
my $webapp = YAPC::Organizer->new;
$webapp->query($q);
my $result = $webapp->run();
like($result, qr@Your personal information has been successfully updated.@, 'updated');
# check data in database
- my ($p) = YAPC::Person->search(email => $people[0]->{email}); # we did not change the e-mail so it is still the same e-mail address
+ my ($p) = YAPC::Person->search(email => $people[0]->{email}); # we did not change the e-mail so it is still the same e-mail address
is($p->get('fname'), $people[3]{fname}, 'fname was updated correctly');
}
-
-
-
-
-
-
Modified: yapcom/trunk/t/09-web-change-password.t
===================================================================
--- yapcom/trunk/t/09-web-change-password.t 2003-12-02 21:02:48 UTC (rev 102)
+++ yapcom/trunk/t/09-web-change-password.t 2003-12-02 21:04:16 UTC (rev 103)
@@ -4,7 +4,6 @@
# Testing how can a user change the password
# using the web interface
-
use strict;
use warnings;
use Test::More qw(no_plan);
@@ -14,17 +13,18 @@
use YAPC::Test::Data;
use YAPC::Person;
-use CGI; # needed for some of the tests
+use CGI; # needed for some of the tests
-$ENV{CGI_APP_RETURN_ONLY} = 1; # to eliminate screen output
+$ENV{CGI_APP_RETURN_ONLY} = 1; # to eliminate screen output
# to avoid warning caused my lack of web server in the test environment
-$ENV{HTTP_HOST} = 'test-host';
+$ENV{HTTP_HOST} = 'test-host';
+
# $ENV{REQUEST_URI} = 'test-uri'; #should be set for each request as we are using it
$ENV{YAPCOM_NOMAIL} = 1;
$ENV{REQUEST_URI} = '/';
-BEGIN { use_ok( 'YAPC::Organizer' ); }
+BEGIN {use_ok('YAPC::Organizer');}
###### prepare the environment: create and validate users and make them login
my @cookies;
@@ -40,9 +40,10 @@
# access the change password page fails if not authenticated
{
- local $ENV{REQUEST_URI} = '/change_password.html';
+ local $ENV{REQUEST_URI} = '/change_password.html';
+
#local $ENV{HTTP_COOKIE} = "Yapcom=$cookies[0]";
- my $q = CGI->new();
+ my $q = CGI->new();
my $webapp = YAPC::Organizer->new;
$webapp->query($q);
my $result = $webapp->run();
@@ -52,13 +53,16 @@
# update password failes if not authenticated
# redirect to login page and do not touch database
{
- local $ENV{REQUEST_URI} = '/change_password.html';
+ local $ENV{REQUEST_URI} = '/change_password.html';
+
#local $ENV{HTTP_COOKIE} = "Yapcom=$cookies[0]";
- my $q = CGI->new(
- {
- password => 'somenewpw',
- password2 => 'somenewpw',
- });
+ my $q =
+ CGI->new(
+ {
+ password => 'somenewpw',
+ password2 => 'somenewpw',
+ }
+ );
my $webapp = YAPC::Organizer->new;
$webapp->query($q);
my $result = $webapp->run();
@@ -70,32 +74,30 @@
is(@ppl, @all, 'Non of the passwords were changed.');
}
-
-
# fetch form by authenticated user
{
- local $ENV{REQUEST_URI} = '/change_password.html';
+ local $ENV{REQUEST_URI} = '/change_password.html';
local $ENV{HTTP_COOKIE} = "Yapcom=$cookies[0]";
- my $q = CGI->new();
+ my $q = CGI->new();
my $webapp = YAPC::Organizer->new;
$webapp->query($q);
my $result = $webapp->run();
like($result, qr@<h2>Change Password Form</h2>@, 'Display change password form');
}
-
-
# submit form with bad passwords should yield an error message
# and database should not change
{
- local $ENV{REQUEST_URI} = '/change_password.html';
+ local $ENV{REQUEST_URI} = '/change_password.html';
local $ENV{HTTP_COOKIE} = "Yapcom=$cookies[0]";
- my $q = CGI->new(
- {
- password => 'somenewpw',
- password2 => 'somenewpwx',
- submit => '1',
- });
+ my $q =
+ CGI->new(
+ {
+ password => 'somenewpw',
+ password2 => 'somenewpwx',
+ submit => '1',
+ }
+ );
my $webapp = YAPC::Organizer->new;
$webapp->query($q);
my $result = $webapp->run();
@@ -108,18 +110,18 @@
is(@ppl, @all, 'Non of the passwords were changed.');
}
-
-
# submit form with good password should yield a success message
# database should be updated.
{
- local $ENV{REQUEST_URI} = '/change_password.html';
+ local $ENV{REQUEST_URI} = '/change_password.html';
local $ENV{HTTP_COOKIE} = "Yapcom=$cookies[0]";
- my $q = CGI->new(
- {
- password => 'somenewpw',
- password2 => 'somenewpw',
- });
+ my $q =
+ CGI->new(
+ {
+ password => 'somenewpw',
+ password2 => 'somenewpw',
+ }
+ );
my $webapp = YAPC::Organizer->new;
$webapp->query($q);
my $result = $webapp->run();
@@ -128,9 +130,6 @@
is(@ppl, 1, 'One password was set to the new password in the database');
@ppl = YAPC::Person->search(password => 'nopassword');
my @all = YAPC::Person->retrieve_all();
- is(@ppl, @all-1, 'Non of the other passwords were changed.');
+ is(@ppl, @all - 1, 'Non of the other passwords were changed.');
}
-
-
-
Modified: yapcom/trunk/t/10-use-html-template.t
===================================================================
--- yapcom/trunk/t/10-use-html-template.t 2003-12-02 21:02:48 UTC (rev 102)
+++ yapcom/trunk/t/10-use-html-template.t 2003-12-02 21:04:16 UTC (rev 103)
@@ -10,17 +10,18 @@
use YAPC::Test::Data;
use YAPC::Person;
-use CGI; # needed for some of the tests
+use CGI; # needed for some of the tests
-$ENV{CGI_APP_RETURN_ONLY} = 1; # to eliminate screen output
+$ENV{CGI_APP_RETURN_ONLY} = 1; # to eliminate screen output
# to avoid warning caused my lack of web server in the test environment
-$ENV{HTTP_HOST} = 'test-host';
+$ENV{HTTP_HOST} = 'test-host';
+
# $ENV{REQUEST_URI} = 'test-uri'; #should be set for each request as we are using it
$ENV{YAPCOM_NOMAIL} = 1;
$ENV{REQUEST_URI} = '/';
-BEGIN { use_ok( 'YAPC::Organizer' ); }
+BEGIN {use_ok('YAPC::Organizer');}
my %user1 = %{$people[0]};
@@ -32,26 +33,25 @@
=cut
{
- $ENV{REQUEST_URI} = '/registration.html';
+ $ENV{REQUEST_URI} = '/registration.html';
my %user = %user1;
$user{pauseid} = 'MYPAUSEID';
- $user{submit} = 1;
- my $q = CGI->new(\%user);
+ $user{submit} = 1;
+ my $q = CGI->new(\%user);
my $webapp = YAPC::Organizer->new;
$webapp->query($q);
-
+
my $result;
- eval {
- $result = $webapp->run();
- };
+ eval {$result = $webapp->run();};
is($@, '', 'HTML::Template loeaded');
like($result, qr@Location: http://test-host/validation.html@, 'User registered, page redirected');
+
#like($result, qr/Thank you for registering/, 'User registered');
}
{
- $ENV{REQUEST_URI} = '/not_existing_page.html';
- my $q = CGI->new();
+ $ENV{REQUEST_URI} = '/not_existing_page.html';
+ my $q = CGI->new();
my $webapp = YAPC::Organizer->new;
$webapp->query($q);
my $result;
@@ -59,6 +59,3 @@
like($result, qr/Timeline Error/, 'Accessing not existing page');
}
-
-
-
Modified: yapcom/trunk/t/11-web-admin.t
===================================================================
--- yapcom/trunk/t/11-web-admin.t 2003-12-02 21:02:48 UTC (rev 102)
+++ yapcom/trunk/t/11-web-admin.t 2003-12-02 21:04:16 UTC (rev 103)
@@ -1,7 +1,6 @@
#!/usr/bin/perl
# -T
-
# Testing the administrative web interface that can be reachable only by administrators
use strict;
@@ -13,17 +12,18 @@
use YAPC::Test::Data;
#use YAPC::Person;
-use CGI; # needed for some of the tests
+use CGI; # needed for some of the tests
-$ENV{CGI_APP_RETURN_ONLY} = 1; # to eliminate screen output
+$ENV{CGI_APP_RETURN_ONLY} = 1; # to eliminate screen output
# to avoid warning caused my lack of web server in the test environment
-$ENV{HTTP_HOST} = 'test-host';
+$ENV{HTTP_HOST} = 'test-host';
+
# $ENV{REQUEST_URI} = 'test-uri'; #should be set for each request as we are using it
$ENV{YAPCOM_NOMAIL} = 1;
$ENV{REQUEST_URI} = '/';
-BEGIN { use_ok( 'YAPC::Organizer' ); }
+BEGIN {use_ok('YAPC::Organizer');}
###### prepare the environment: create and validate users and make them login
my @cookies;
@@ -38,27 +38,24 @@
isnt($cookies[1], $cookies[2], 'cookies are different');
YAPC::Test::Data::submit_talk(0, $cookies[0]);
-
-
### access admin page(s) by authenticated user who is not an admin
-### this should check with the regualar pages and see if the reveal sensitive information to
+### this should check with the regualar pages and see if the reveal sensitive information to
### someone who is not an admin ?
foreach my $page (qw(admin_list_proposals)) {
- local $ENV{REQUEST_URI} = "/$page.html";
+ local $ENV{REQUEST_URI} = "/$page.html";
local $ENV{HTTP_COOKIE} = "Yapcom=$cookies[0]";
- my $q = CGI->new();
+ my $q = CGI->new();
my $webapp = YAPC::Organizer->new;
$webapp->query($q);
my $result = $webapp->run();
like($result, qr/Access to administrators only/, "Access to '$page.html' refused for authenticated nonadmin");
}
-
### access page(s) by authenticated user who is an admin
{
- local $ENV{REQUEST_URI} = '/list_people.html';
+ local $ENV{REQUEST_URI} = '/list_people.html';
local $ENV{HTTP_COOKIE} = "Yapcom=$cookies[2]";
- my $q = CGI->new();
+ my $q = CGI->new();
my $webapp = YAPC::Organizer->new;
$webapp->query($q);
my $result = $webapp->run();
@@ -67,19 +64,18 @@
### access admin page(s) by authenticated user who is an admin
{
- local $ENV{REQUEST_URI} = '/admin_list_proposals.html';
+ local $ENV{REQUEST_URI} = '/admin_list_proposals.html';
local $ENV{HTTP_COOKIE} = "Yapcom=$cookies[2]";
- my $q = CGI->new();
+ my $q = CGI->new();
my $webapp = YAPC::Organizer->new;
$webapp->query($q);
my $result = $webapp->run();
like($result, qr/$YAPC::Test::Data::talks[0]{subject}/, 'talk listed');
}
-
-### access admin page(s) by unauthenticated user using run=admin on the URL
+### access admin page(s) by unauthenticated user using run=admin on the URL
foreach my $page (qw(admin_list_proposals)) {
- local $ENV{REQUEST_URI} = '/index.html';
+ local $ENV{REQUEST_URI} = '/index.html';
my $q = CGI->new({run => $page});
my $webapp = YAPC::Organizer->new;
$webapp->query($q);
@@ -87,5 +83,3 @@
like($result, qr/2nd Perl Conference in Israel/, 'Could not fetch admin page(s) - gets the page really requested');
}
-
-
Modified: yapcom/trunk/t/13-change-proposal.t
===================================================================
--- yapcom/trunk/t/13-change-proposal.t 2003-12-02 21:02:48 UTC (rev 102)
+++ yapcom/trunk/t/13-change-proposal.t 2003-12-02 21:04:16 UTC (rev 103)
@@ -4,7 +4,6 @@
# Testing how can a user change a proposal
# using the web interface
-
use strict;
use warnings;
use Test::More qw(no_plan);
@@ -14,17 +13,18 @@
use YAPC::Test::Data;
use YAPC::Person;
-use CGI; # needed for some of the tests
+use CGI; # needed for some of the tests
-$ENV{CGI_APP_RETURN_ONLY} = 1; # to eliminate screen output
+$ENV{CGI_APP_RETURN_ONLY} = 1; # to eliminate screen output
# to avoid warning caused my lack of web server in the test environment
-$ENV{HTTP_HOST} = 'test-host';
+$ENV{HTTP_HOST} = 'test-host';
+
# $ENV{REQUEST_URI} = 'test-uri'; #should be set for each request as we are using it
$ENV{YAPCOM_NOMAIL} = 1;
$ENV{REQUEST_URI} = '/';
-BEGIN { use_ok( 'YAPC::Organizer' ); }
+BEGIN {use_ok('YAPC::Organizer');}
###### prepare the environment: create and validate users and make them login
my @cookies;
@@ -40,25 +40,23 @@
YAPC::Test::Data::submit_talk(0, $cookies[0]);
YAPC::Test::Data::submit_talk(1, $cookies[2]);
-
-
# access the change personal_info page fails if not authenticated
{
- local $ENV{REQUEST_URI} = '/list_my_proposals.html';
+ local $ENV{REQUEST_URI} = '/list_my_proposals.html';
+
#local $ENV{HTTP_COOKIE} = "Yapcom=$cookies[0]";
- my $q = CGI->new();
+ my $q = CGI->new();
my $webapp = YAPC::Organizer->new;
$webapp->query($q);
my $result = $webapp->run();
like($result, qr@<h2>Login</h2>@, 'Redirected to login page');
}
-
# list proposals
{
- local $ENV{REQUEST_URI} = '/list_my_proposals.html';
+ local $ENV{REQUEST_URI} = '/list_my_proposals.html';
local $ENV{HTTP_COOKIE} = "Yapcom=$cookies[0]";
- my $q = CGI->new();
+ my $q = CGI->new();
my $webapp = YAPC::Organizer->new;
$webapp->query($q);
my $result = $webapp->run();
@@ -70,9 +68,10 @@
# access edit_my_proposal should fail for unauthenticated
{
- local $ENV{REQUEST_URI} = '/edit_my_proposal.html';
+ local $ENV{REQUEST_URI} = '/edit_my_proposal.html';
+
#local $ENV{HTTP_COOKIE} = "Yapcom=$cookies[0]";
- my $q = CGI->new();
+ my $q = CGI->new();
my $webapp = YAPC::Organizer->new;
$webapp->query($q);
my $result = $webapp->run();
@@ -81,9 +80,9 @@
# access edit_my_proposal without an id should give an error message
{
- local $ENV{REQUEST_URI} = '/edit_my_proposal.html';
+ local $ENV{REQUEST_URI} = '/edit_my_proposal.html';
local $ENV{HTTP_COOKIE} = "Yapcom=$cookies[0]";
- my $q = CGI->new();
+ my $q = CGI->new();
my $webapp = YAPC::Organizer->new;
$webapp->query($q);
my $result = $webapp->run();
@@ -93,7 +92,7 @@
# access edit_my_proposal with an id that does not belong to the user should give an error message
{
- local $ENV{REQUEST_URI} = '/edit_my_proposal.html';
+ local $ENV{REQUEST_URI} = '/edit_my_proposal.html';
local $ENV{HTTP_COOKIE} = "Yapcom=$cookies[0]";
my $q = CGI->new({id => 2});
my $webapp = YAPC::Organizer->new;
@@ -102,28 +101,27 @@
like($result, qr@We could not find this proposal.@, 'proposals refused');
}
-
# show details of a proposal
{
- local $ENV{REQUEST_URI} = '/edit_my_proposal.html';
+ local $ENV{REQUEST_URI} = '/edit_my_proposal.html';
local $ENV{HTTP_COOKIE} = "Yapcom=$cookies[0]";
my $q = CGI->new({id => 1});
my $webapp = YAPC::Organizer->new;
$webapp->query($q);
my $result = $webapp->run();
- like($result, qr@Proposal@, 'proposal title');
- like($result, qr@\Q$talks[0]{subject}@, 'proposal displayed');
+ like($result, qr@Proposal@, 'proposal title');
+ like($result, qr@\Q$talks[0]{subject}@, 'proposal displayed');
like($result, qr@\Q"$talks[0]{language}" selected@, 'proposal displayed');
like($result, qr@\Q"$talks[0]{'length'}" selected@, 'proposal displayed');
}
# submit new data without an id
{
- local $ENV{REQUEST_URI} = '/edit_my_proposal.html';
+ local $ENV{REQUEST_URI} = '/edit_my_proposal.html';
local $ENV{HTTP_COOKIE} = "Yapcom=$cookies[0]";
my %talk = %{$talks[2]};
$talk{submit} = 1;
- my $q = CGI->new(\%talk);
+ my $q = CGI->new(\%talk);
my $webapp = YAPC::Organizer->new;
$webapp->query($q);
my $result = $webapp->run();
@@ -132,12 +130,12 @@
# submit new data to the wrong id
{
- local $ENV{REQUEST_URI} = '/edit_my_proposal.html';
+ local $ENV{REQUEST_URI} = '/edit_my_proposal.html';
local $ENV{HTTP_COOKIE} = "Yapcom=$cookies[0]";
my %talk = %{$talks[2]};
$talk{submit} = 1;
- $talk{id} = 2;
- my $q = CGI->new(\%talk);
+ $talk{id} = 2;
+ my $q = CGI->new(\%talk);
my $webapp = YAPC::Organizer->new;
$webapp->query($q);
my $result = $webapp->run();
@@ -146,12 +144,12 @@
# submit new data with good id
{
- local $ENV{REQUEST_URI} = '/edit_my_proposal.html';
+ local $ENV{REQUEST_URI} = '/edit_my_proposal.html';
local $ENV{HTTP_COOKIE} = "Yapcom=$cookies[0]";
my %talk = %{$talks[2]};
$talk{submit} = 1;
- $talk{id} = 1;
- my $q = CGI->new(\%talk);
+ $talk{id} = 1;
+ my $q = CGI->new(\%talk);
my $webapp = YAPC::Organizer->new;
$webapp->query($q);
my $result = $webapp->run();
@@ -161,5 +159,3 @@
# test if no other proposal was changed
}
-
-
Modified: yapcom/trunk/t/lib/YAPC/Test/Data.pm
===================================================================
--- yapcom/trunk/t/lib/YAPC/Test/Data.pm 2003-12-02 21:02:48 UTC (rev 102)
+++ yapcom/trunk/t/lib/YAPC/Test/Data.pm 2003-12-02 21:04:16 UTC (rev 103)
@@ -6,70 +6,67 @@
our @EXPORT = qw(@people @talks);
-
our @people = (
- {
- fname => 'Gabor',
- lname => 'Szabo',
- email => 'gabor@xxxx.xxx.xx',
- phone => '054-624648',
- password => 'nopassword',
- password2 => 'nopassword',
- },
- {
- fname => 'Gabor',
- lname => 'Szabo',
- email => 'gabor@xxx.xx.xx',
- phone => '08-9716380',
- password => 'nopassword',
- password2 => 'nopassword',
- },
- {
- fname => 'Gabor',
- lname => 'Szabo',
- email => 'gaborwork@xxx.xx.xx',
- password => 'nopassword',
- password2 => 'nopassword',
- },
- {
- fname => 'asldhsaldj',
- lname => 'skdh asda 8dl',
- email => 'aksdahsdk@xxxxxxxx.xxxxxxxxxxxx.xxx',
- phone => 'aduaofuo la8',
- company => 'aklsjd asdoi934285wefl @$@#',
- password => 'wertyu',
- password2 => 'wertyu',
- },
+ {
+ fname => 'Gabor',
+ lname => 'Szabo',
+ email => 'gabor@xxxx.xxx.xx',
+ phone => '054-624648',
+ password => 'nopassword',
+ password2 => 'nopassword',
+ },
+ {
+ fname => 'Gabor',
+ lname => 'Szabo',
+ email => 'gabor@xxx.xx.xx',
+ phone => '08-9716380',
+ password => 'nopassword',
+ password2 => 'nopassword',
+ },
+ {
+ fname => 'Gabor',
+ lname => 'Szabo',
+ email => 'gaborwork@xxx.xx.xx',
+ password => 'nopassword',
+ password2 => 'nopassword',
+ },
+ {
+ fname => 'asldhsaldj',
+ lname => 'skdh asda 8dl',
+ email => 'aksdahsdk@xxxxxxxx.xxxxxxxxxxxx.xxx',
+ phone => 'aduaofuo la8',
+ company => 'aklsjd asdoi934285wefl @$@#',
+ password => 'wertyu',
+ password2 => 'wertyu',
+ },
);
our @talks = (
- {
- subject => 'Name of the first one, is it ?',
- 'length' => 30,
- language => 'English',
- abstract => 'This is the body of the proposal',
- comment => 'My comment',
- },
- {
- 'subject' => "Nice talk",
- 'length' => 5,
- 'language' => 'Hebrew',
- 'abstract' => 'This is my abstract',
- 'comment' => 'There can be a comment, no ?',
- },
- {
- 'subject' => "Bad talk",
- 'length' => 60,
- 'language' => 'Hebrew',
- 'abstract' => "lajdlsafsvsdkvkds\n\n\nkhadasd adkah #%^#!^vv\n adlafJ\n dksfh",
- 'comment' => "aldadadfkaf a\n\n akdahkhsfakd\n\n\t\nasdkahdk",
- },
+ {
+ subject => 'Name of the first one, is it ?',
+ 'length' => 30,
+ language => 'English',
+ abstract => 'This is the body of the proposal',
+ comment => 'My comment',
+ },
+ {
+ 'subject' => "Nice talk",
+ 'length' => 5,
+ 'language' => 'Hebrew',
+ 'abstract' => 'This is my abstract',
+ 'comment' => 'There can be a comment, no ?',
+ },
+ {
+ 'subject' => "Bad talk",
+ 'length' => 60,
+ 'language' => 'Hebrew',
+ 'abstract' => "lajdlsafsvsdkvkds\n\n\nkhadasd adkah #%^#!^vv\n adlafJ\n dksfh",
+ 'comment' => "aldadadfkaf a\n\n akdahkhsfakd\n\n\t\nasdkahdk",
+ },
-
);
-
=head2 prepare
Prepare the test environment
@@ -84,79 +81,80 @@
- Validate e-mail address
=cut
+
sub register_user {
my $i = shift;
# register user
{
- local $ENV{REQUEST_URI} = '/registration.html';
- my %user = %{$people[$i]};
- $user{submit} = 1;
- my $q = CGI->new(\%user);
- my $webapp = YAPC::Organizer->new;
- $webapp->query($q);
- my $result = $webapp->run();
+ local $ENV{REQUEST_URI} = '/registration.html';
+ my %user = %{$people[$i]};
+ $user{submit} = 1;
+ my $q = CGI->new(\%user);
+ my $webapp = YAPC::Organizer->new;
+ $webapp->query($q);
+ my $result = $webapp->run();
}
# fetch the authcode directly from the database
- my @p = YAPC::Person->search(email => $people[$i]{email});
+ my @p = YAPC::Person->search(email => $people[$i]{email});
my $authcode = $p[0]->authcode;
###### validate e-mail
{
- local $ENV{REQUEST_URI} = '/validation.html';
- my %user;
- $user{email} = $people[$i]{email};
- $user{authcode} = $authcode;
+ local $ENV{REQUEST_URI} = '/validation.html';
+ my %user;
+ $user{email} = $people[$i]{email};
+ $user{authcode} = $authcode;
- my $q = CGI->new(\%user);
- my $webapp = YAPC::Organizer->new;
- $webapp->query($q);
- my $result = $webapp->run();
+ my $q = CGI->new(\%user);
+ my $webapp = YAPC::Organizer->new;
+ $webapp->query($q);
+ my $result = $webapp->run();
}
return $p[0]->id;
}
-
=head2 login_user
login the user with the given index and return the cookie
=cut
+
sub login_user {
my $i = shift;
my $path = '/';
- local $ENV{REQUEST_URI} = '/login.html';
+ local $ENV{REQUEST_URI} = '/login.html';
my %user;
- $user{email} = $people[$i]{email};
+ $user{email} = $people[$i]{email};
$user{password} = $people[$i]{password};
- $user{submit} = 1;
+ $user{submit} = 1;
- my $q = CGI->new(\%user);
+ my $q = CGI->new(\%user);
my $webapp = YAPC::Organizer->new;
$webapp->query($q);
my $result = $webapp->run();
my @logins = YAPC::Login->by_email(email => $people[$i]{email});
+
#is(@logins, 1, 'there is exactly one entry in the login table for this e-mail');
return $logins[-1]->cookie;
}
sub submit_talk {
- my $t = shift; # talk id
- my $cookie = shift;
-
- local $ENV{REQUEST_URI} = '/proposal.html';
- local $ENV{HTTP_COOKIE} = "Yapcom=$cookie";
- my %prop = %{$talks[$t]};
- $prop{submit} = 1;
- my $q = CGI->new(\%prop);
- my $webapp = YAPC::Organizer->new;
- $webapp->query($q);
- my $result = $webapp->run();
+ my $t = shift; # talk id
+ my $cookie = shift;
+
+ local $ENV{REQUEST_URI} = '/proposal.html';
+ local $ENV{HTTP_COOKIE} = "Yapcom=$cookie";
+ my %prop = %{$talks[$t]};
+ $prop{submit} = 1;
+ my $q = CGI->new(\%prop);
+ my $webapp = YAPC::Organizer->new;
+ $webapp->query($q);
+ my $result = $webapp->run();
}
-
1;
Modified: yapcom/trunk/t/lib/YAPC/Test.pm
===================================================================
--- yapcom/trunk/t/lib/YAPC/Test.pm 2003-12-02 21:02:48 UTC (rev 102)
+++ yapcom/trunk/t/lib/YAPC/Test.pm 2003-12-02 21:04:16 UTC (rev 103)
@@ -1,41 +1,46 @@
package YAPC::Test;
+
# set up some stuff for testing
use YAPC::Config;
use Cwd;
+
BEGIN {
- my %dbs = (
- pg => [ 'dbi:Pg:dbname=yapcom', 'user', undef ],
- mysql => [ 'dbi:mysql:yapcom_test', 'root', undef ],
- sqlite => [ 'dbi:SQLite:t/test.db', '', '' ],
- );
- @YAPC::Config::STORAGE = @{ $dbs{ $ENV{YAPC_TEST_DB} || 'sqlite' } };
- @YAPC::Config::admins = (qw(gabor@xxx.xx.xx));
- #$YAPC::Config::MESSAGES = 'messages';
- #$YAPC::Config::ARCHIVE = 't/root/archive';
- #$YAPC::Config::LOG_PATH = 't/temp_error';
+ my %dbs = (
+ pg => [ 'dbi:Pg:dbname=yapcom', 'user', undef ],
+ mysql => [ 'dbi:mysql:yapcom_test', 'root', undef ],
+ sqlite => [ 'dbi:SQLite:t/test.db', '', '' ],
+ );
+ @YAPC::Config::STORAGE = @{$dbs{$ENV{YAPC_TEST_DB} || 'sqlite'}};
+ @YAPC::Config::admins = (qw(gabor@xxx.xx.xx));
- $YAPC::Config::templates_dir = cwd . "/templates";
+ #$YAPC::Config::MESSAGES = 'messages';
+ #$YAPC::Config::ARCHIVE = 't/root/archive';
+ #$YAPC::Config::LOG_PATH = 't/temp_error';
+
+ $YAPC::Config::templates_dir = cwd . "/templates";
}
use YAPC::DBI;
sub import {
- my $class = shift;
+ my $class = shift;
- if (@_ && $_[0] eq 'init_db') {
- print "# nuking test database\n";
- if ($YAPC::Config::STORAGE[0] =~ /^dbi:SQLite:(.*)/) {
- unlink $1;
- }
- else {
- # assume mysql
- YAPC::DBI->db_Main->do("drop database yapc_test");
- YAPC::DBI->db_Main->do("create database yapc_test");
- }
- YAPC::DBI->init_db;
- }
- #require YAPC;
- #YAPC->set_sender('Test');
+ if (@_ && $_[0] eq 'init_db') {
+ print "# nuking test database\n";
+ if ($YAPC::Config::STORAGE[0] =~ /^dbi:SQLite:(.*)/) {
+ unlink $1;
+ }
+ else {
+ # assume mysql
+ YAPC::DBI->db_Main->do("drop database yapc_test");
+ YAPC::DBI->db_Main->do("create database yapc_test");
+ }
+ YAPC::DBI->init_db;
+ }
+
+ #require YAPC;
+ #YAPC->set_sender('Test');
+
}
1;
Generated at 00:45 on 03 Dec 2003 by mariachi 0.51