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();
}
#!/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();
}
Šta treba da se uradi? I ako ne može ovde da se registruje gde mogu da okačim WAP prezentaciju besplatno?
Bolje jedno vruće pivo nego četri ladna!