###########################################
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;