###########################################
package EmailReg;
###########################################
# Register and confirm Emails on the Web
# Mike Schilli, 2002 (
[email protected])
###########################################
use strict;
use warnings;
use CGI::Application;
use DB_File::Lock;
use Fcntl qw(:flock O_RDWR O_CREAT);
use Mail::Mailer;
our $DB_FILE = "/tmp/emails.dat";
our %ERRORS = (
1 => 'No email address given',
2 => 'Not a valid email address',
3 => 'Confirmation failed',
);
our @ISA = qw(CGI::Application);
our %EMAILS = ();
###########################################
sub setup {
###########################################
my($self) = @_;
$self->mode_param("mode");
$self->start_mode("signup");
$self->run_modes(
signup => "signup",
verify => "verify",
confirm => "confirm",
chk_confirm => "chk_confirm",
thanks => "thanks",
);
tie %EMAILS, 'DB_File::Lock', $DB_FILE,
O_RDWR|O_CREAT, 0644, $DB_HASH,
'write' or die $@;
}
###########################################
sub teardown {
###########################################
my($self) = @_;
untie %EMAILS;
}
###########################################
sub signup {
###########################################
my($self) = @_;
my $e = $self->query()->param('error');
return $self->_signup(error => $e || 0);
}
###########################################
sub _signup {
###########################################
my($self, %opt) = @_;
my $tmpl =
$self->load_tmpl("signup.tmpl");
$tmpl->param(err_text =>
$ERRORS{$opt{error}}) if $opt{error};
$tmpl->param(email => $opt{email}) if
exists $opt{email};
return $tmpl->output();
}
###########################################
sub verify {
###########################################
my($self) = @_;
my $email =
$self->query()->param('email');
return $self->_signup(error => 1)
unless $email;
if($email !~ /@/) {
return $self->_signup(email => $email,
error => 2);
}
require MD5;
my $code = substr(MD5->hexhash(
rand().$$), 0, 5);
$EMAILS{$email} = "U$code";
my $mail = Mail::Mailer->new("sendmail");
$mail->open(
{From => '
[email protected]',
To => $email,
Subject => 'Confirm'});
print $mail "Confirmation code: $code\n";
$mail->close;
return $self->_confirm(email => $email);
}
###########################################
sub _confirm {
###########################################
my($self, %opt) = @_;
my $tmpl =
$self->load_tmpl("confirm.tmpl");
$tmpl->param(err_text =>
$ERRORS{$opt{error}}) if $opt{error};
$tmpl->param(email => $opt{email})
if exists $opt{email};
return $tmpl->output();
}
###########################################
sub chk_confirm {
###########################################
my($self) = shift;
my $email=$self->query()->param('email');
my $code = $self->query()->param('code');
if(exists $EMAILS{$email} and
$EMAILS{$email} =~ /(.)(.*)/ and
$1 eq "U" and
$2 eq $code) {
$EMAILS{$email} = "C";
return $self->thanks(email => $email);
} else {
return $self->_confirm(error => 3,
email => $email);
}
}
###########################################
sub thanks {
###########################################
my($self, %opt) = @_;
my $template =
$self->load_tmpl("thanks.tmpl");
$template->param(email => $opt{email});
return $template->output();
}
1;