#!/usr/bin/perl -wT
use strict;
use warnings;
use diagnostics;

use DBI;
use CGI qw(:param);
use CGI::Carp qw(fatalsToBrowser); # will be removed for production

$|++;
$CGI::POST_MAX = 512;

# ##################################################################
sub main {
  my($action,
     $email,
     $name,
     $warning_msg) = check_params(param('action'),
                                  param('email'),
                                  param('name'));
  my $script_loc = 'xxxxx';
  write_header($script_loc); # HTML header, removed for brevity
  if ($action eq 'default') {
    write_default($script_loc);
  } elsif ($action eq 'confirm') {
    write_confirm($script_loc,
                  $email,
                  $name);
  } elsif ($action eq 'commit') {
    write_commit($email,
                 $name);
  } elsif ($action eq 'warning') {
    write_warning($script_loc,
                  $email,
                  $name,
                  $warning_msg);
  }
  write_footer(); # HTML footer, removed for brevity
}

# ##################################################################
sub check_params {
  my($action,
     $email,
     $name) = @_;
  my $warning_msg = '';

  if ($action eq 'Sign up') {
    $action = 'confirm';
  } elsif ($action eq 'Confirm signup') {
    $action = 'commit';
  }

  unless ($action =~ /^confirm|commit|warning$/) {
    return('default');
  } else {
    $email = "\L$email";
    if ($email =~ s/[^\w\-@\.\+]//gm) {
      $action = 'warning';
      $warning_msg .= 'illegal characters removed';
    }

    unless ($email =~ /^.+?@.+?\..+?/) {
      $action = 'warning';
      $warning_msg .= 'wrong form';
    }

    unless ($action eq 'warning') {
      if (duplicate_email($email)) {
        $action = 'warning';
        $warning_msg .= 'duplicate email';
      }
    }

    if ($name =~ s/[^\w \-]//g) {
      $action = 'warning';
      $warning_msg .= 'illegal characters removed';
    }

    return($action,
           $email,
           $name,
           $warning_msg);
  }
}

# ##################################################################
sub write_default {
  my($script_loc) = @_;

  print <<DEFAULT;
    <FORM ACTION="$script_loc" METHOD="post">
    <INPUT TYPE="submit" NAME="action" VALUE="Sign up"></FORM>
DEFAULT
}

# ##################################################################
sub write_confirm {
  my($script_loc,
     $email,
     $name) = @_;

  print <<CONFIRM;
    <FORM ACTION="$script_loc" METHOD="post">
    <INPUT TYPE="submit" NAME="action" VALUE="Confirm signup"></FORM>

    # to make changes ...
    <FORM ACTION="$script_loc" METHOD="post">
    <INPUT TYPE="submit"NAME="action" VALUE="Sign up"></FORM>
CONFIRM
}

# ##################################################################
sub write_warning {
  my($script_loc,
     $email,
     $name,
     $warning_msg) = @_;

  print <<WARNING;
    <FORM ACTION="$script_loc" METHOD="post">
    $warning_msg
    <INPUT TYPE="submit" NAME="action" VALUE="Sign up"></FORM>
WARNING
}

# ##################################################################
sub write_commit {
  my($email,
     $name) = @_;

  my $dbh = database_connect();
  my $origin = $ENV{'REMOTE_ADDR'};
  my $time = get_time();

  my $query = qq(INSERT INTO announce VALUES ('$email','$name','$origi
+n','$time'));
  my $sth = $dbh->prepare($query) || die 'Query failed to prepare: ' .
+ DBI->errstr;
  $sth->execute || die 'Query failed to prepare: ' . DBI->errstr;
  $dbh->disconnect;

  if ($name) { $name = " $name"; }

  print <<COMMIT;
    <P>You've just been signed up$name; thank you!</P>
COMMIT
}

# ##################################################################
sub duplicate_email {
  my($email) = @_;

  if ($email =~ /\@xxxxx$/) { # our domain ;)
    return 1;
  } else {
    my $dbh = database_connect();
    my $query = qq(SELECT email FROM announce WHERE email = '$email');
    my $sth = $dbh->prepare($query) || die 'Query failed to prepare: '
+ . DBI->errstr;
    $sth->execute || die 'Query failed to prepare: ' . DBI->errstr;
    my @rows = $sth->fetchrow_array;
    $dbh->disconnect;
    return @rows;
  }
}

# ##################################################################
sub get_time {
  my ($sec,
      $min,
      $hour,
      $mday,
      $mon,
      $year) = gmtime(time());
  $year += 1900;
  $mday += 1;
  $mon += 1;
  return("$year-$mon-$mday $hour:$min:$sec");
}

# ##################################################################
sub database_connect {
  my $dbh = DBI->connect("DBI:mysql:xxxxx;mysql_read_default_file=/usr
+/home/xxxxx/.my.cnf","","");
  unless (defined($dbh)) {
    die "Database error (connecting): " . DBI->errstr . "\n";
  }
  return $dbh;
}

# ##################################################################
main();
[download]