###########################################
package EmailReg;
###########################################
# Register and confirm Emails on the Web
# Mike Schilli, 2002 (m@perlmeister.com)
###########################################

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@service.org',
       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;