Update of /cvsroot/yapcom/yapcom/yapcom/cgi
In directory sc8-pr-cvs1:/tmp/cvs-serv31726/cgi
Modified Files:
yapcom.pl
Log Message:
registration form works, id counter works, rejects duplicate registrations with the same e-mail address but does not say anything about it.
List registered users
Index: yapcom.pl
===================================================================
RCS file: /cvsroot/yapcom/yapcom/yapcom/cgi/yapcom.pl,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** yapcom.pl 10 Jul 2003 18:36:07 -0000 1.5
--- yapcom.pl 12 Jul 2003 20:27:07 -0000 1.6
***************
*** 1,11 ****
! #!/usr/bin/perl -T
use strict;
use warnings;
use CGI::Application;
package YAPC::WebApp;
use base 'CGI::Application';
sub setup {
my $self = shift;
--- 1,33 ----
! #!/usr/bin/perl
use strict;
use warnings;
+
+ # it seems we cannot use FindBin with taint checking
+ # so we untaint it in a very unsecure way.
+ use FindBin qw($Bin);
+ BEGIN {
+ $Bin =~ /.*/;
+ $Bin = $&;
+ }
+ use lib "$Bin/../lib";
use CGI::Application;
+ use DBI;
+
+ # configuration that should be in a separate file
+ my $username = 'gabor';
+ my $password = 'gabor';
+ my $db_dir = '../ydb';
+ chdir $db_dir;
+
+ my $dbh = DBI->connect("DBI:Sprite:ydb", $username, $password,
+ { RaiseError => 1});
+ #die "Cannot connect to: " . $DBI::errstr;
+ $dbh->{FetchHashKeyName} = 'NAME_lc';
package YAPC::WebApp;
use base 'CGI::Application';
+ use Data::Dumper; # for playing with debugging
sub setup {
my $self = shift;
***************
*** 15,19 ****
'main' => 'main',
'registration_form' => 'do_pre_registration',
! 'mode3' => 'do_something_else'
);
}
--- 37,42 ----
'main' => 'main',
'registration_form' => 'do_pre_registration',
! 'mode3' => 'do_something_else',
! 'list_users' => 'do_list_users',
);
}
***************
*** 28,31 ****
--- 51,68 ----
}
+ sub do_list_users {
+ my $self = shift;
+
+ my $sth = $dbh->prepare("SELECT fname, lname FROM users");
+ $sth->execute;
+ my $ar = $sth->fetchall_arrayref({});
+ my $t = $self->load_tmpl('../templates/list_users.tmpl');
+ #print STDERR Dumper $ar;
+ $t->param(USERS => $ar);
+ return $t->output;
+
+ }
+
+
sub do_pre_registration {
my $self = shift;
***************
*** 37,41 ****
$q->param('pw1') and
$q->param('pw2') and
! $q->param('pw2') eq $q->param('pw2') {
my @str = ('a'..'z');
--- 74,78 ----
$q->param('pw1') and
$q->param('pw2') and
! $q->param('pw1') eq $q->param('pw2')) {
my @str = ('a'..'z');
***************
*** 53,58 ****
}
! sub save_user {
!
}
--- 90,119 ----
}
! sub save_new_user {
! my $q = shift;
! my $authcode = shift;
!
! # this code should be in transaction and/or the e-mail field should
! # be unique
! my $sth = $dbh->prepare("SELECT count(*) FROM users WHERE email = ?");
! $sth->execute($q->param('email'));
! my ($count) = $sth->fetchrow_array;
! if ($count) {
! print STDERR "email exists\n";
! return 0;
! }
! $sth = $dbh->prepare("INSERT INTO users
! (id, email, fname, lname, password)
! VALUES(user_id.NEXTVAL, ?,?,?,?)");
! $sth->execute($q->param('email'), $q->param('fname'),
! $q->param('lname'), $q->param('pw1'));
!
! # what about error checking ?
! return 1;
! }
!
! sub do_thank_registration {
! my $self = shift;
! $self->main; # temporary solution
}
|
