[Yapcom-cvs] yapcom/yapcom/cgi yapcom.pl,1.5,1.6

[<sz...@us...>]

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
  }