Code:
#!/usr/bin/perl -w

use strict;
# Make these vars. globle to this program.
use vars qw($clump $tpl $cgi $next $bad_mail_domains);
use CGI;
use CGI::FastTemplate;

use WD::DBConnection;
use WD::NewUser;
use WD::Logger;
use WD::Clumps;
use WD::URL;

# get the Clumps and templates for this script on this site.
$0 =~ /([^\/]+)(\.\w+)?$/;
my $script_name = $1;
$cgi = new CGI();

# Generic Header End.
# Script Code Starts.

# $bad_mail_domains
# Sets which email domains can't be used to signup to which sites.
# The key is the email domain which is matched against what the user supplies.
# The value is a ref to an hash of sid's(site ID's).  If the current sid is 
# in the hash or the hash contains a 0 then the domain not allowed.
$bad_mail_domains = {
    'wapdrive.com'        => {0 => 1},
    'wapdrive.net'        => {0 => 1},
    'www.wapdrive.com'    => {0 => 1},
    'www.wapdrive.net'    => {0 => 1}
};

my $use_tpl = $cgi->param("tpl");
undef $clump;
undef $tpl;
if ( defined($use_tpl) ) {
    my $dir = "$ENV{SITE_ROOT}/templates/$script_name/$use_tpl";
    if ( -d $dir ) {
    if ( -f $dir.'/clumps' ) {
        # use template's clumps too.
        $clump = new Clumps( "$script_name/$use_tpl/clumps" );
    } else {
        # no template clumps.  Use default clumps.
        $clump = new Clumps( $1 );
    }
    $tpl = new CGI::FastTemplate($dir);
    }
} 

$clump = new Clumps($1) unless defined($clump);
$tpl = new CGI::FastTemplate("$ENV{SITE_ROOT}/templates/$script_name") unless defined($tpl);

$next = $cgi->param("next");

sub parse_get_info {
    my ($reason,$username,$password,$email,$tel) = @_;

    if ( !defined($reason) ) {
    $reason = \""
    }
    

    my $referer = $cgi->param("referer");

    $tpl->define(    main        => "get_info.tpl",
            top        => "top.tpl",
            bottom        => "bottom.tpl" );
    $tpl->assign(    REFERER        => ($referer) ? $referer : "",
            RETRY_REASON    => $$reason,
            USERNAME    => ($username) ? $username : "",
            PASSWORD    => ($password) ? $password : "",
            PASSWORD2    => ($password) ? $password : "",
            EMAIL        => ($email) ? $email : "",
            TEL        => ($tel) ? $tel : ""
        );
    return;
}

sub create_user {
    # Try and create the user.
    my $username = $cgi->param("username");
    my $password = $cgi->param("password");
    my $password2 = $cgi->param("password2");
    my $email = $cgi->param("email");
    my $tel = $cgi->param("tel");
    my $spam = $cgi->param('spam');

    if ( defined($tel) ) {
    $tel =~ s/[ \.\-]//g;
    } else {
        $tel = "";
    }

    my $new_user = new NewUser($username);
    unless ( defined($new_user) ) {
    parse_get_info($clump->get("BAD_USERNAME"),$username,"",$email,$tel);
    return undef;
    } 
    if ( defined($password2) &&  $password ne $password2 ) {
    parse_get_info($clump->get("PASSWORD_MISMATCH"),$username,"",$email,$tel);
        return undef;
    }
    if ( !$new_user->set_password($password) ) {
    parse_get_info($clump->get("BAD_PASSWORD"),$username,"",$email,$tel);
    return undef;
    }
    unless ( $new_user->set_email($email) ) {
    parse_get_info($clump->get("BAD_EMAIL"),$username,$password,$email,$tel);
    return undef;
    }
    # get the users email's domain.
    $email =~ /\@(.+)$/;
    my $h = $bad_mail_domains->{$1};
    if ( defined($h) && (defined($h->{0}) || defined($h->{$ENV{SITE_ID}})) ) {
    parse_get_info($clump->get("BAD_EMAIL_DOM"),$username,$password,$email,$tel);
    return undef;
    } 
    unless ( $new_user->set_tel($tel) ) {
    parse_get_info($clump->get("BAD_TEL"),$username,$password,$email,$tel);
    return undef;
    }

    if ( defined($spam) && $spam eq 'yesPlease' ) {
    $new_user->set_spamable();
    }

    my $uid = $new_user->create();
    if ( $uid !~ /^\d+$/ ) {
    if ( !defined($uid) ) {
        parse_get_info(\"Unexpected Error",$username,$password,$email,$tel);
    } else {
        # if $uid is defined but not a number then its an error
        # of type DUP_USERNAME, DUP_EMAIL, MAX_EMAIL
        parse_get_info($clump->get($uid),$username,$password,$email,$tel);
    }
    return undef;
    }
    my $params = 'NAME='.URL::encode_param($username);
    $params .= '&PASSWORD='.URL::encode_param($password);
    $params .= '&EMAIL='.URL::encode_param($email);
    $params .= '&TEL='.URL::encode_param($tel);
    Logger::mailq(\"$ENV{SITE_ID}:SignUp:$params");
    parse_success($username,$password,$email,$tel);
    return 1;
}

sub parse_success {
    my ($username,$password,$email,$tel) = @_;

    $tpl->define(       main            => "success.tpl",
            top        => "top.tpl",
            bottom        => "bottom.tpl" );
    $tpl->assign(       SITE_NAME    => $ENV{SITE_NAME},
            REFERER         => $cgi->param("referer"),
                        USERNAME        => $username,
                        PASSWORD        => $password,
                        EMAIL           => $email,
                        TEL             => $tel,
            NEXT        => ($next) ? $next : '/ACGI/Member'
                );
    return;
}

my $action;
if ($action = $cgi->param("action")) {
    $tpl->assign(    NEXT    => ($next) ? $next : '' );
    if ( $action eq "start" ) {
    # return the signup page.
    parse_get_info();
    } elsif ( $action eq "submit" ) {
    create_user();
    }

    $tpl->parse(    TOP    => "top",
            BOTTOM    => "bottom");
    $tpl->parse(    MAIN    => "main" );
    print CGI->header(    -expires=> '-1d');
    $tpl->print();
}