use base 'BSE::UI::UserCommon';
use Carp qw(confess);
-our $VERSION = "1.022";
+our $VERSION = "1.023";
use constant MAX_UNACKED_CONF_MSGS => 3;
use constant MIN_UNACKED_CONF_GAP => 2 * 24 * 60 * 60;
+=head1 NAME
+
+BSE::UserReg - member (site user) registration and handling
+
+=head1 SYNOPSIS
+
+ /cgi-bin/user.pl?...
+
+=head1 DESCRIPTION
+
+BSE::UserReg is the user interface handler for user.pl.
+
+=head1 TARGETS
+
+=over
+
+=cut
+
my %actions =
(
show_logon => 'show_logon',
(BSE::Session->make_cookie(BSE::Cfg->single, userid => $value));
}
+=item show_logon
+
+Display the logon page.
+
+Tags: standard dynamic tags and the following:
+
+=over
+
+=item *
+
+C<message> - HTML encoded error message text
+
+=item *
+
+C<error_img> - field error indicators.
+
+=back
+
+Template: F<user/logon>
+
+=cut
+
sub req_show_logon {
my ($self, $req, $message) = @_;
},
);
+=item logon
+
+Process a logon request.
+
+Parameters:
+
+=over
+
+=item *
+
+C<userid> - the user's logon
+
+=item *
+
+C<password> - the user's password.
+
+=back
+
+On success, redirect to the L</userpage>.
+
+On failure, re-display the L</logon> form.
+
+=cut
+
sub req_logon {
my ($self, $req) = @_;
}
}
+=item setcookie
+
+Used internally to propagate session cookie changes between the SSL
+and non-SSL hosts.
+
+=cut
+
sub req_setcookie {
my ($self, $req) = @_;
return;
}
+=item logoff
+
+Log the user off.
+
+This removes the user's session.
+
+Redirects to the L</logon> page.
+
+=cut
+
sub req_logoff {
my ($self, $req) = @_;
return $cfg->entryBool('site users', "require_$args", 0);
}
+=item show_register
+
+Display the member registration page.
+
+Tags: standard dynamic tags and:
+
+=over
+
+=item *
+
+C<< old I<field> >> - display the value of I<field> as it was
+previously submitted.
+
+=item *
+
+C<message> - any error messages from the form submission.
+
+=item *
+
+C<< iterator ... subscriptions >>, C<< subscription I<field> >> -
+iterate over configured newsletter subscriptions.
+
+=item *
+
+C<< ifSubscribed >> - test if the user selected a subscription on
+their previous form submission.
+
+=item *
+
+C<< ifRequired I<field> >> - test if the specified member field is required.
+
+=item *
+
+C<< error_img I<field> >> - display an error indicator for I<field>
+
+=back
+
+Template: F<user/register>
+
+=cut
+
sub req_show_register {
my ($self, $req, $message, $errors) = @_;
return $req->dyn_response($template, \%acts);
}
-sub _get_user {
- my ($self, $req, $name, $result) = @_;
+=item register
- defined $result or confess "Missing result parameter";
+Register a new user.
+
+=cut
+
+sub req_register {
+ my ($self, $req) = @_;
my $cfg = $req->cfg;
my $cgi = $req->cgi;
my $session = $req->session;
+
+ my $msgs = BSE::Message->new(cfg=>$cfg, section=>'user');
+
+ my $user_register = $cfg->entryBool('site users', 'user_register', 1);
my $nopassword = $cfg->entryBool('site users', 'nopassword', 0);
- if ($nopassword) {
- my $password;
- $password = $cgi->param($name) if $name;
- $password ||= $cgi->param('p');
- my $uid = $cgi->param('u');
- defined $uid && $uid =~ /^\d+$/ && defined $password
- or do { refresh_to($ENV{SCRIPT}."?nopassword=1"); return };
+ unless ($user_register) {
+ my $msg = $msgs->(regdisabled => "Registration disabled");
+ if ($nopassword) {
+ return $self->req_show_lost_password($req, $msg);
+ }
+ else {
+ return $self->req_show_logon($req, $msg);
+ }
+ }
- my $user = SiteUsers->getByPkey($uid)
- or do { refresh_to($ENV{SCRIPT}."?nopassword=1"); return };
+ my %user;
+ my @cols = SiteUser->columns;
+ shift @cols;
- $user->{password} eq $password
- or do { refresh_to($ENV{SCRIPT}."?nopassword=1"); return };
+ my %errors;
+ my %fields = SiteUser->valid_fields($cfg);
+ my %rules = SiteUser->valid_rules($cfg);
+ $req->validate(errors => \%errors,
+ fields => \%fields,
+ rules => \%rules,
+ section => 'site user validation');
- return $user;
+ my $email = $cgi->param('email');
+ if (!defined $email or !length $email) {
+ $errors{email} = $msgs->(regnoemail => "Please enter an email address");
+ $email = ''; # prevent undefined value warnings later
+ }
+ elsif ($email !~ /.\@./) {
+ $errors{email} = $msgs->(regbademail => "Please enter a valid email address");
+ }
+ if ($nopassword) {
+ my $confemail = $cgi->param('confirmemail');
+ if (!defined $confemail or !length $confemail) {
+ $errors{confirmemail} = $msgs->(regnoconfemail => "Please enter a confirmation email address");
+ }
+ elsif ($email ne $confemail) {
+ $errors{confirmemail} = $msgs->(regbadconfemail => "Confirmation email must match the email address");
+ }
+ my $user = SiteUsers->getBy(userId=>$email);
+ if ($user) {
+ $errors{email} = $msgs->(regemailexists=>
+ "Sorry, email $email already exists as a user",
+ $email);
+ }
+ $user{userId} = $email;
+ $user{password} = '';
}
else {
- if ($cfg->entryBool('custom', 'user_auth')) {
- my $custom = custom_class($cfg);
-
- return $custom->siteuser_auth($session, $cgi, $cfg);
+ my $min_pass_length = $cfg->entry('basic', 'minpassword') || 4;
+ my $userid = $cgi->param('userid');
+ if (!defined $userid || length $userid == 0) {
+ $errors{userid} = $msgs->(reguser=>"Please enter your username");
}
- else {
- my $user = $req->siteuser;
- unless ($user) {
- $$result = $self->req_show_logon($req);
- return;
- }
- if ($user->{disabled}) {
- $$result = $self->req_show_logon($req, "Account disabled");
- return;
+ my $pass = $cgi->param('password');
+ my $pass2 = $cgi->param('confirm_password');
+ if (!defined $pass || length $pass == 0) {
+ $errors{password} = $msgs->(regpass=>"Please enter your password");
+ }
+ elsif (length $pass < $min_pass_length) {
+ $errors{password} = $msgs->(regpasslen=>"The password must be at least $min_pass_length characters");
+ }
+ elsif (!defined $pass2 || length $pass2 == 0) {
+ $errors{confirm_password} =
+ $msgs->(regconfpass=>"Please enter a confirmation password");
+ }
+ elsif ($pass ne $pass2) {
+ $errors{confirm_password} =
+ $msgs->(regconfmismatch=>"The confirmation password is different from the password");
+ }
+ my $user = SiteUsers->getBy(userId=>$userid);
+ if ($user) {
+ # give the user a suggestion
+ my $workuser = $userid;
+ $workuser =~ s/\d+$//;
+ my $suffix = 1;
+ for my $suffix (1..100) {
+ unless (SiteUsers->getBy(userId=>"$workuser$suffix")) {
+ $cgi->param(userid=>"$workuser$suffix");
+ last;
+ }
}
-
- return $user;
+ $errors{userid} = $msgs->(regexists=>
+ "Sorry, username $userid already exists",
+ $userid);
}
+ $user{userId} = $userid;
+ $user{password} = $pass;
}
-}
-sub tag_ifSubscribedTo {
- my ($user, $args) = @_;
+ unless ($errors{email}) {
+ my $checkemail = _generic_email($email);
+ require 'BSE/EmailBlacklist.pm';
+ my $blackentry = BSE::EmailBlacklist->getEntry($checkemail);
+ if ($blackentry) {
+ $errors{email} = $msgs->(regblackemail =>
+ "Email $email is blacklisted: $blackentry->{why}",
+ $email, $blackentry->{why});
+ }
+ }
- require BSE::TB::Subscriptions;
- my $sub = BSE::TB::Subscriptions->getBy(text_id=>$args)
- or return 0;
+ my @mod_cols = grep !$donttouch{$_}, @cols;
+ for my $col (@mod_cols) {
+ my $value = $cgi->param($col);
+ if ($cfg->entryBool('site users', "require_$col")) {
+ unless (defined $value && $value ne '') {
+ my $disp = $cfg->entry('site users', "display_$col", "\u$col");
- $user->subscribed_to($sub);
-}
+ $errors{$col} = $msgs->(regrequired => "$disp is a required field",
+ $col, $disp);
+ }
+ }
+ if (defined $value) {
+ $user{$col} = $value;
+ }
+ }
+ my $aff_name = $cgi->param('affiliate_name');
+ $aff_name = _validate_affiliate_name($cfg, $aff_name, \%errors, $msgs);
+ defined $aff_name or $aff_name = '';
-sub _partial_logon {
- my ($self, $req) = @_;
+ if (keys %errors) {
+ return $self->req_show_register($req, undef, \%errors);
+ }
- my $session = $req->session;
- if ($session->{partial_logon}
- && !$req->cfg->entryBool('custom', 'user_auth')) {
- my $user = SiteUsers->getByPkey($session->{partial_logon})
- or return;
- $user->{disabled}
- and return;
- return $user;
+ $user{email} = $email;
+ $user{affiliate_name} = $aff_name;
+ if ($nopassword) {
+ use BSE::Util::Secure qw/make_secret/;
+ $user{password} = make_secret($cfg);
}
- return;
-}
+
+ my $user;
+ eval {
+ $user = SiteUsers->make(%user);
+ };
+ if ($user) {
+ my $custom = custom_class($cfg);
+ $custom->can('siteuser_add')
+ and $custom->siteuser_add($user, 'user', $cfg);
+
+ $req->audit
+ (
+ actor => $user,
+ object => $user,
+ component => "member:register:created",
+ msg => "New user created",
+ level => "info",
+ );
+
+ $self->_send_user_cookie($user);
+ unless ($nopassword) {
+ $session->{userid} = $user->id;
+ my $custom = custom_class($cfg);
+ if ($custom->can('siteuser_login')) {
+ $custom->siteuser_login($session->{_session_id}, $session->{userid}, $cfg);
+ }
+ }
+
+ if ($cfg->entry('site users', 'notify_register', 0)) {
+ $self->_notify_registration($req, $user);
+ }
+
+ my $subs = $self->_save_subs($user, $session, $cfg, $cgi);
+ if ($nopassword) {
+ return $self->send_conf_request($req, $user);
+ }
+ elsif ($subs) {
+ my $page = $self->send_conf_request($req, $user, 1);
+ $page and return $page;
+ }
+ elsif ($cfg->entry('site users', 'notify_register_customer')) {
+ $user->send_registration_notify
+ (
+ remote_addr => $req->ip_address
+ );
+ }
+
+ $custom->siteusers_changed($cfg);
+
+ return $self->_got_user_refresh($req);
+ }
+ else {
+ return $self->req_show_register($req, $msgs->(regdberr=> "Database error $@"));
+ }
+}
+
+sub _get_user {
+ my ($self, $req, $name, $result) = @_;
+
+ defined $result or confess "Missing result parameter";
+
+ my $cfg = $req->cfg;
+ my $cgi = $req->cgi;
+ my $session = $req->session;
+ my $nopassword = $cfg->entryBool('site users', 'nopassword', 0);
+ if ($nopassword) {
+ my $password;
+ $password = $cgi->param($name) if $name;
+ $password ||= $cgi->param('p');
+ my $uid = $cgi->param('u');
+ defined $uid && $uid =~ /^\d+$/ && defined $password
+ or do { refresh_to($ENV{SCRIPT}."?nopassword=1"); return };
+
+ my $user = SiteUsers->getByPkey($uid)
+ or do { refresh_to($ENV{SCRIPT}."?nopassword=1"); return };
+
+ $user->{password} eq $password
+ or do { refresh_to($ENV{SCRIPT}."?nopassword=1"); return };
+
+ return $user;
+ }
+ else {
+ if ($cfg->entryBool('custom', 'user_auth')) {
+ my $custom = custom_class($cfg);
+
+ return $custom->siteuser_auth($session, $cgi, $cfg);
+ }
+ else {
+ my $user = $req->siteuser;
+ unless ($user) {
+ $$result = $self->req_show_logon($req);
+ return;
+ }
+ if ($user->{disabled}) {
+ $$result = $self->req_show_logon($req, "Account disabled");
+ return;
+ }
+
+ return $user;
+ }
+ }
+}
+
+sub tag_ifSubscribedTo {
+ my ($user, $args) = @_;
+
+ require BSE::TB::Subscriptions;
+ my $sub = BSE::TB::Subscriptions->getBy(text_id=>$args)
+ or return 0;
+
+ $user->subscribed_to($sub);
+}
+
+sub _partial_logon {
+ my ($self, $req) = @_;
+
+ my $session = $req->session;
+ if ($session->{partial_logon}
+ && !$req->cfg->entryBool('custom', 'user_auth')) {
+ my $user = SiteUsers->getByPkey($session->{partial_logon})
+ or return;
+ $user->{disabled}
+ and return;
+ return $user;
+ }
+ return;
+}
+
+=item show_opts
+
+Display the user options page.
+
+This page is also displayed if the user logs on and not all required
+fields are populated.
+
+Tags: L</Standard user page tags> and:
+
+=over
+
+=item *
+
+C<< last I<field> >> - the previous form submitted value for I<field>
+or that field from the user record.
+
+=item *
+
+C<message> - an error messages from the previous form submission.
+
+=item *
+
+C<< iterator ... subscriptions >>, C<< subscription I<field> >> -
+iterate over configured newsletter subscriptions.
+
+=item *
+
+C<< ifSubscribed >> - test if the user selected a subscription on
+their previous form submission, or if the user is subscribed to this
+newsletter subscription.
+
+=item *
+
+C<ifUserSubs> - test if the user is subscribed to anything.
+
+=item *
+
+C<< error_img I<field> >> - display an error indicator for I<field>.
+
+=item *
+
+C<<partial_logon>> - test if the user is only partly logged on.
+
+=item *
+
+C<< iterator ... filecats >>, C<< filecat I<field> >> - iterate over
+the configured file categories.
+
+=back
+
+Template: F<user/options>
+
+=cut
sub req_show_opts {
my ($self, $req, $message, $errors) = @_;
}
}
+=item saveopts
+
+Save options prompted for by L</show_opts>
+
+=cut
+
sub req_saveopts {
my ($self, $req) = @_;
}
if (!$nopassword && $newpass) {
$user->changepw($newpass, $user);
- }
-
- $user->{affiliate_name} = $aff_name if defined $aff_name;
-
- for my $col (@cols) {
- my $value = $cgi->param($col);
- if (defined $value) {
- $user->{$col} = $value;
- }
- }
-
- $user->{textOnlyMail} = 0
- if $cgi->param('saveTextOnlyMail') && !defined $cgi->param('textOnlyMail');
- $user->save;
-
- # subscriptions
- my $subs;
- if ($cgi->param('saveSubscriptions')) {
- $subs = $self->_save_subs($user, $session, $cfg, $cgi);
- }
-
- $custom->can('siteuser_edit')
- and $custom->siteuser_edit($user, 'user', $cfg);
-
- if ($nopassword) {
- return $self->send_conf_request($req, $user)
- if $newemail;
- }
- else {
- $subs = () = $user->subscriptions unless defined $subs;
- return $self->send_conf_request($req, $user)
- if $subs && !$user->{confirmed};
- }
-
- if ($cgi->param('save_file_subs')) {
- my @new_subs = $cgi->param("file_subscriptions");
- $user->set_subscribed_file_categories($cfg, @new_subs);
- }
-
- if ($partial_logon) {
- $user->{previousLogon} = $user->{lastLogon};
- $user->{lastLogon} = now_datetime;
- $session->{userid} = $user->id;
- delete $session->{partial_logon};
- $user->save;
-
- my $custom = custom_class($cfg);
- if ($custom->can('siteuser_login')) {
- $custom->siteuser_login($session->{_session_id}, $session->{userid}, $cfg);
- }
-
- $self->_send_user_cookie($user);
-
- return $self->_got_user_refresh($req);
- }
-
- my $url = $cgi->param('r');
- unless ($url) {
- $url = $cfg->entryErr('site', 'url') . "$ENV{SCRIPT_NAME}?userpage=1";
- if ($nopassword) {
- $url =~ s/1$/$user->{password}/;
- $url .= "&u=$user->{id}";
- }
- my $t = $cgi->param('t');
- if ($t && $t =~ /^\w+$/) {
- $url .= "&_t=$t";
- }
- }
-
- $custom->siteusers_changed($cfg);
-
- refresh_to($url);
-
- return;
-}
-
-# returns true if the caller needs to send output
-sub _save_subs {
- my ($self, $user, $session, $cfg, $cgi) = @_;
-
- my @subids = $cgi->param('subscription');
- $user->removeSubscriptions;
- if (@subids) {
- my @usersubs;
- my @subs;
- my @cols = BSE::SubscribedUser->columns;
- shift @cols; # don't set id
- my $found = 0;
- for my $subid (@subids) {
- $subid =~ /^\d+$/ or next;
- my $sub = BSE::SubscriptionTypes->getByPkey($subid)
- or next;
- ++$found;
- my %usersub;
- $usersub{subId} = $subid;
- $usersub{userId} = $user->{id};
-
- push(@usersubs, BSE::SubscribedUsers->add(@usersub{@cols}));
- push(@subs, $sub);
- }
- return $found;
- }
- return 0;
-}
-
-sub req_register {
- my ($self, $req) = @_;
-
- my $cfg = $req->cfg;
- my $cgi = $req->cgi;
- my $session = $req->session;
-
- my $msgs = BSE::Message->new(cfg=>$cfg, section=>'user');
-
- my $user_register = $cfg->entryBool('site users', 'user_register', 1);
- my $nopassword = $cfg->entryBool('site users', 'nopassword', 0);
- unless ($user_register) {
- my $msg = $msgs->(regdisabled => "Registration disabled");
- if ($nopassword) {
- return $self->req_show_lost_password($req, $msg);
- }
- else {
- return $self->req_show_logon($req, $msg);
- }
- }
-
- my %user;
- my @cols = SiteUser->columns;
- shift @cols;
-
- my %errors;
- my %fields = SiteUser->valid_fields($cfg);
- my %rules = SiteUser->valid_rules($cfg);
- $req->validate(errors => \%errors,
- fields => \%fields,
- rules => \%rules,
- section => 'site user validation');
-
- my $email = $cgi->param('email');
- if (!defined $email or !length $email) {
- $errors{email} = $msgs->(regnoemail => "Please enter an email address");
- $email = ''; # prevent undefined value warnings later
- }
- elsif ($email !~ /.\@./) {
- $errors{email} = $msgs->(regbademail => "Please enter a valid email address");
- }
- if ($nopassword) {
- my $confemail = $cgi->param('confirmemail');
- if (!defined $confemail or !length $confemail) {
- $errors{confirmemail} = $msgs->(regnoconfemail => "Please enter a confirmation email address");
- }
- elsif ($email ne $confemail) {
- $errors{confirmemail} = $msgs->(regbadconfemail => "Confirmation email must match the email address");
- }
- my $user = SiteUsers->getBy(userId=>$email);
- if ($user) {
- $errors{email} = $msgs->(regemailexists=>
- "Sorry, email $email already exists as a user",
- $email);
- }
- $user{userId} = $email;
- $user{password} = '';
- }
- else {
- my $min_pass_length = $cfg->entry('basic', 'minpassword') || 4;
- my $userid = $cgi->param('userid');
- if (!defined $userid || length $userid == 0) {
- $errors{userid} = $msgs->(reguser=>"Please enter your username");
- }
- my $pass = $cgi->param('password');
- my $pass2 = $cgi->param('confirm_password');
- if (!defined $pass || length $pass == 0) {
- $errors{password} = $msgs->(regpass=>"Please enter your password");
- }
- elsif (length $pass < $min_pass_length) {
- $errors{password} = $msgs->(regpasslen=>"The password must be at least $min_pass_length characters");
- }
- elsif (!defined $pass2 || length $pass2 == 0) {
- $errors{confirm_password} =
- $msgs->(regconfpass=>"Please enter a confirmation password");
- }
- elsif ($pass ne $pass2) {
- $errors{confirm_password} =
- $msgs->(regconfmismatch=>"The confirmation password is different from the password");
- }
- my $user = SiteUsers->getBy(userId=>$userid);
- if ($user) {
- # give the user a suggestion
- my $workuser = $userid;
- $workuser =~ s/\d+$//;
- my $suffix = 1;
- for my $suffix (1..100) {
- unless (SiteUsers->getBy(userId=>"$workuser$suffix")) {
- $cgi->param(userid=>"$workuser$suffix");
- last;
- }
- }
- $errors{userid} = $msgs->(regexists=>
- "Sorry, username $userid already exists",
- $userid);
- }
- $user{userId} = $userid;
- $user{password} = $pass;
- }
-
- unless ($errors{email}) {
- my $checkemail = _generic_email($email);
- require 'BSE/EmailBlacklist.pm';
- my $blackentry = BSE::EmailBlacklist->getEntry($checkemail);
- if ($blackentry) {
- $errors{email} = $msgs->(regblackemail =>
- "Email $email is blacklisted: $blackentry->{why}",
- $email, $blackentry->{why});
- }
- }
-
- my @mod_cols = grep !$donttouch{$_}, @cols;
- for my $col (@mod_cols) {
- my $value = $cgi->param($col);
- if ($cfg->entryBool('site users', "require_$col")) {
- unless (defined $value && $value ne '') {
- my $disp = $cfg->entry('site users', "display_$col", "\u$col");
-
- $errors{$col} = $msgs->(regrequired => "$disp is a required field",
- $col, $disp);
- }
- }
+ }
+
+ $user->{affiliate_name} = $aff_name if defined $aff_name;
+
+ for my $col (@cols) {
+ my $value = $cgi->param($col);
if (defined $value) {
- $user{$col} = $value;
+ $user->{$col} = $value;
}
}
- my $aff_name = $cgi->param('affiliate_name');
- $aff_name = _validate_affiliate_name($cfg, $aff_name, \%errors, $msgs);
- defined $aff_name or $aff_name = '';
- if (keys %errors) {
- return $self->req_show_register($req, undef, \%errors);
+ $user->{textOnlyMail} = 0
+ if $cgi->param('saveTextOnlyMail') && !defined $cgi->param('textOnlyMail');
+ $user->save;
+
+ # subscriptions
+ my $subs;
+ if ($cgi->param('saveSubscriptions')) {
+ $subs = $self->_save_subs($user, $session, $cfg, $cgi);
}
- $user{email} = $email;
- $user{affiliate_name} = $aff_name;
+ $custom->can('siteuser_edit')
+ and $custom->siteuser_edit($user, 'user', $cfg);
+
if ($nopassword) {
- use BSE::Util::Secure qw/make_secret/;
- $user{password} = make_secret($cfg);
+ return $self->send_conf_request($req, $user)
+ if $newemail;
+ }
+ else {
+ $subs = () = $user->subscriptions unless defined $subs;
+ return $self->send_conf_request($req, $user)
+ if $subs && !$user->{confirmed};
}
- my $user;
- eval {
- $user = SiteUsers->make(%user);
- };
- if ($user) {
- my $custom = custom_class($cfg);
- $custom->can('siteuser_add')
- and $custom->siteuser_add($user, 'user', $cfg);
+ if ($cgi->param('save_file_subs')) {
+ my @new_subs = $cgi->param("file_subscriptions");
+ $user->set_subscribed_file_categories($cfg, @new_subs);
+ }
- $req->audit
- (
- actor => $user,
- object => $user,
- component => "member:register:created",
- msg => "New user created",
- level => "info",
- );
+ if ($partial_logon) {
+ $user->{previousLogon} = $user->{lastLogon};
+ $user->{lastLogon} = now_datetime;
+ $session->{userid} = $user->id;
+ delete $session->{partial_logon};
+ $user->save;
- $self->_send_user_cookie($user);
- unless ($nopassword) {
- $session->{userid} = $user->id;
- my $custom = custom_class($cfg);
- if ($custom->can('siteuser_login')) {
- $custom->siteuser_login($session->{_session_id}, $session->{userid}, $cfg);
- }
+ my $custom = custom_class($cfg);
+ if ($custom->can('siteuser_login')) {
+ $custom->siteuser_login($session->{_session_id}, $session->{userid}, $cfg);
}
- my $subs = $self->_save_subs($user, $session, $cfg, $cgi);
+ $self->_send_user_cookie($user);
+
+ return $self->_got_user_refresh($req);
+ }
+
+ my $url = $cgi->param('r');
+ unless ($url) {
+ $url = $cfg->entryErr('site', 'url') . "$ENV{SCRIPT_NAME}?userpage=1";
if ($nopassword) {
- return $self->send_conf_request($req, $user);
- }
- elsif ($subs) {
- return if $self->send_conf_request($req, $user, 1);
+ $url =~ s/1$/$user->{password}/;
+ $url .= "&u=$user->{id}";
}
- elsif ($cfg->entry('site users', 'notify_register_customer')) {
- $user->send_registration_notify
- (
- remote_addr => $req->ip_address
- );
+ my $t = $cgi->param('t');
+ if ($t && $t =~ /^\w+$/) {
+ $url .= "&_t=$t";
}
+ }
- $custom->siteusers_changed($cfg);
+ $custom->siteusers_changed($cfg);
- if ($cfg->entry('site users', 'notify_register', 0)) {
- $self->_notify_registration($req, $user);
- }
+ return $req->get_refresh($url);
+}
- return $self->_got_user_refresh($req);
- }
- else {
- return $self->req_show_register($req, $msgs->(regdberr=> "Database error $@"));
- }
+# returns true if the caller needs to send output
+sub _save_subs {
+ my ($self, $user, $session, $cfg, $cgi) = @_;
- return;
+ my @subids = $cgi->param('subscription');
+ $user->removeSubscriptions;
+ if (@subids) {
+ my @usersubs;
+ my @subs;
+ my @cols = BSE::SubscribedUser->columns;
+ shift @cols; # don't set id
+ my $found = 0;
+ for my $subid (@subids) {
+ $subid =~ /^\d+$/ or next;
+ my $sub = BSE::SubscriptionTypes->getByPkey($subid)
+ or next;
+ ++$found;
+ my %usersub;
+ $usersub{subId} = $subid;
+ $usersub{userId} = $user->{id};
+
+ push(@usersubs, BSE::SubscribedUsers->add(@usersub{@cols}));
+ push(@subs, $sub);
+ }
+ return $found;
+ }
+ return 0;
}
sub iter_usersubs {
return $$rorder->files;
}
-sub _common_tags {
- my ($self, $req, $user) = @_;
+=item userpage
- my $cfg = $req->cfg;
+Display general information to the user.
- #my $order_index;
- #my $item_index;
- #my @items;
- my $item;
- my $product;
- #my @files;
- #my $file_index;
- my $file;
- my @orders;
- my $order;
+Tags: L</Standard user page tags> and:
- my $must_be_paid = $cfg->entryBool('downloads', 'must_be_paid', 0);
- my $must_be_filled = $cfg->entryBool('downloads', 'must_be_filled', 0);
+=over
- my $it = BSE::Util::Iterate->new(req => $req);
- my $ito = BSE::Util::Iterate::Objects->new();
- return
- (
- $req->dyn_user_tags(),
- user => [ \&tag_hash, $user ],
- $ito->make
- (
- data => \@orders,
- single => 'order',
- plural => 'orders',
- #index => \$order_index,
- code => [ iter_orders => $self, $user ],
- store => \$order,
- ),
- $it->make
- (
- single => "item",
- plural => "items",
- code => [ iter_order_items => $self, \$order ],
- store => \$item,
- changed => sub {
- my ($item) = @_;
- if ($item) {
- $product = $item->product
- or print STDERR "No product found for item $item->{id}\n";
- }
- else {
- undef $product;
- }
- $req->set_article(product => $product);
- },
- nocache => 1,
- ),
- $it->make
- (
- single => "orderfile",
- plural => "orderfiles",
- code => [ iter_orderfiles => $self, \$order ],
- store => \$file,
- nocache => 1,
- ),
- product => sub {
- $item or return "* Not in item iterator *";
- $product or return "* No current product *";
- return tag_article($product, $cfg, $_[0]);
- },
- $it->make
- (
- single => "prodfile",
- plural => "prodfiles",
- code => [ files => $product ],
- store => \$file,
- nocache => 1,
- ),
- ifFileAvail =>
- sub {
- if ($file) {
- return 1 if !$file->{forSale};
- }
- return 0 if $must_be_paid && !$order->paidFor;
- return 0 if $must_be_filled && !$order->filled;
- return 1;
- },
- options => [ tag_order_item_options => $self, $req, \$item ],
- );
-}
+=item *
+
+C<message> - any error messages.
+
+=item *
+
+C<< iterator ... subscriptions >>, C<< subscription I<field> >> -
+iterater over subscribed services (B<not> newsletter subscriptions)
+
+=item *
+
+C<< iterator ... bookings >>, C<< booking I<field> >> - iterate over
+user seminar bookings.
+
+=back
+
+Template: F<user/userpage>.
+
+=cut
sub req_userpage {
my ($self, $req, $message) = @_;
See _orderdetail_low for tags.
-Template: user/orderdetail
+Template: F<user/orderdetail>
=cut
See _orderdetail_low for tags.
-Template: user/orderdetaila
+Template: F<user/orderdetaila>
=cut
return \%result;
}
+=item download
+
+Download a purchased file.
+
+See also L</download_file> which requires only a file id.
+
+Parameters:
+
+=over
+
+=item *
+
+C<order> - order id where access to the file was purchased
+
+=item *
+
+C<file> - file id of the purchased file.
+
+=back
+
+=cut
+
sub req_download {
my ($self, $req) = @_;
# }
# $result{headers} = \@headers;
- # return \%result;
-}
+ # return \%result;
+}
+
+=item download_file
+
+Download a file.
+
+Parameters:
+
+=over
+
+=item *
+
+C<file> - the id of the file to download. The user must have access
+to download the file.
+
+=back
+
+=cut
sub req_download_file {
my ($self, $req) = @_;
return $self->_common_download($req, $file);
}
+=item file_metadata
+
+Retrieve metadata for a file.
+
+Parameters:
+
+=over
+
+=item *
+
+C<file> - the id of the file to retrieve metadata for.
+
+=item *
+
+C<name> - the name of the metadata.
+
+=back
+
+=cut
+
sub req_file_metadata {
my ($self, $req) = @_;
return \%result;
}
+=item file_cmetadata
+
+Retrieve generated metadata for a file.
+
+=over
+
+=item *
+
+C<file> - the id of the file to retrieve metadata for.
+
+=item *
+
+C<name> - the name of the metadata.
+
+=back
+
+=cut
+
sub req_file_cmetadata {
my ($self, $req) = @_;
return $meta;
}
+=item show_lost_password
+
+Display the lost password form.
+
+Tags: standard dynamic tags and:
+
+=over
+
+=item *
+
+C<message>
+
+=item *
+
+C<< error_img I<field> >>
+
+=back
+
+Template: F<user/lostpassword>
+
+=cut
+
sub req_show_lost_password {
my ($self, $req, $message) = @_;
message => $message,
error_img => [ \&tag_error_img, $cfg, $errors ],
);
- BSE::Template->show_page('user/lostpassword', $cfg, \%acts);
- return;
+ return $req->dyn_response('user/lostpassword', \%acts);
}
+=item lost_password
+
+Process a lost password request.
+
+Parameters:
+
+=over
+
+=item *
+
+C<userid> - the user's logon name.
+
+=back
+
+On success, display:
+
+Tags: standard dynamic tags and:
+
+=over
+
+=item *
+
+C<message>
+
+=item *
+
+C<< user I<field> >> - user information. Very little information from
+this should be displayed.
+
+=item *
+
+C<< emailuser I<field> >> - usually the same as C<user>
+
+=back
+
+Template: F<user/lostemailsent>
+
+=cut
+
sub req_lost_password {
my ($self, $req, $message) = @_;
user => sub { escape_html($user->{$_[0]}) },
emailuser => [ \&tag_hash, $email_user ],
);
- BSE::Template->show_page('user/lostemailsent', $cfg, \%acts);
- return;
+ return $req->dyn_response('user/lostemailsent', \%acts);
}
+=item subinfo
+
+Display information about a newletter subscription.
+
+Tags: standard dynamic tags and:
+
+=over
+
+=item *
+
+C<< subscription I<field> >> - the subscription being displayed.
+
+=back
+
+Template: F<user/subdetail>
+
+=cut
+
sub req_subinfo {
my ($self, $req) = @_;
or return $self->show_opts($req, "No subscription id parameter");
my $sub = BSE::SubscriptionTypes->getByPkey($id)
or return $self->show_opts($req, "Unknown subscription id");
+ $req->set_variable(subscription => $sub);
my %acts;
%acts =
(
$req->dyn_user_tags(),
subscription=>sub { escape_html($sub->{$_[0]}) },
);
- BSE::Template->show_page('user/subdetail', $cfg, \%acts);
- return;
+ return $req->dyn_response('user/subdetail', \%acts);
}
sub req_nopassword {
(
$req->dyn_user_tags(),
);
- BSE::Template->show_page('user/nopassword', $cfg, \%acts);
- return;
+ return $req->dyn_response('user/nopassword', \%acts);
}
sub req_blacklist {
%acts =
(
$req->dyn_user_tags(),
- email => sub { escape_html($email) },
+ email => escape_html($email),
);
require BSE::EmailBlacklist;
+ $req->set_variable(email => $email);
my $black = BSE::EmailBlacklist->getEntry($genemail);
if ($black) {
- BSE::Template->show_page('user/alreadyblacklisted', $cfg, \%acts);
- return;
+ return $req->dyn_response('user/alreadyblacklisted', \%acts);
}
my %black;
my @cols = BSE::EmailBlackEntry->columns;
$black{email} = $genemail;
$black{why} = "Web request from $ENV{REMOTE_ADDR}";
$black = BSE::EmailBlacklist->add(@black{@cols});
- BSE::Template->show_page('user/blacklistdone', $cfg, \%acts);
- return;
+ return $req->dyn_response('user/blacklistdone', \%acts);
}
sub req_confirm {
$req->dyn_user_tags(),
user=>sub { escape_html($user->{$_[0]}) },
);
- BSE::Template->show_page('user/confirmed', $cfg, \%acts);
- return;
+ return $req->dyn_response('user/confirmed', \%acts);
}
sub _generic_email {
my $checkemail = _generic_email($user->{email});
# check the blacklist
- require 'BSE/EmailBlacklist.pm';
+ require BSE::EmailBlacklist;
my %acts;
%acts =
$cfg->entry('basic', 'emailfrom')|| $SHOP_FROM;
unless ($from) {
$acts{mailerror} = sub { escape_html("Configuration Error: The confirmations from address has not been configured") };
- BSE::Template->show_page('user/email_conferror', $cfg, \%acts);
- return 1;
+ return $req->dyn_response('user/email_conferror', \%acts);
}
my $blackentry = BSE::EmailBlacklist->getEntry($checkemail);
if ($blackentry) {
$acts{black} = sub { escape_html($blackentry->{$_[0]}) },
- BSE::Template->show_page('user/blacklisted', $cfg, \%acts);
- return 1;
+ return $req->dyn_response('user/blacklisted', \%acts);
}
unless ($user->{confirmSecret}) {
$acts{ifTooSoon} = sub { $too_soon };
# check how many
if ($too_many) {
- BSE::Template->show_page('user/toomany', $cfg, \%acts);
- return 1;
+ return $req->dyn_response('user/toomany', \%acts);
}
if ($too_soon) {
- BSE::Template->show_page('user/toosoon', $cfg, \%acts);
- return 1;
+ return $req->dyn_response('user/toosoon', \%acts);
}
}
else {
subject=>$subject)) {
# a problem sending the mail
$acts{mailerror} = sub { escape_html($mail->errstr) };
- BSE::Template->show_page('user/email_conferror', $cfg, \%acts);
+ return $req->dyn_response('user/email_conferror', \%acts);
return;
}
++$confirm->{unackedConfMsgs};
$confirm->{lastConfSent} = now_datetime;
$confirm->save;
- return 0 if $suppress_success;
- BSE::Template->show_page($nopassword ? 'user/confsent_nop' : 'user/confsent', $cfg, \%acts);
-
- return 1;
+ return if $suppress_success;
+ return $req->dyn_response($nopassword ? 'user/confsent_nop' : 'user/confsent', \%acts);
}
sub req_unsub {
my $sub;
if ($subid eq 'all') {
$user->removeSubscriptions();
- BSE::Template->show_page('user/unsuball', $cfg, \%acts);
+ return $req->dyn_response('user/unsuball', \%acts);
}
elsif (0+$subid eq $subid
and $sub = BSE::SubscriptionTypes->getByPkey($subid)) {
$acts{subscription} = sub { escape_html($sub->{$_[0]}) };
$user->removeSubscription($subid);
- BSE::Template->show_page('user/unsubone', $cfg, \%acts);
+ return $req->dyn_response('user/unsubone', \%acts);
}
else {
- BSE::Template->show_page('user/cantunsub', $cfg, \%acts);
+ return $req->dyn_response('user/cantunsub', \%acts);
}
-
- return;
}
sub _validate_affiliate_name {
=item req_wishlist
-=target a_wishlist
-
Display a given user's wishlist.
Parameters:
$template .= "_$t";
}
- BSE::Template->show_page($template, $req->cfg, \%acts);
+ return $req->dyn_response($template, \%acts);
return;
}
=item req_downufile
-=target a_downufile
-
Download a user file.
=cut
or return $self->error($req, $msg);
}
+=item lost
+
+Prompt the user to enter a new password as part of account password
+recovery.
+
+Tags: standard dynamic tags and:
+
+=over
+
+=item *
+
+C<lostid> - the password recovery id. This should be supplied as an
+C<id> parameter to C<lost_save>.
+
+=item *
+
+C<< error_img I<field> >> - error indicator for I<field>
+
+=item *
+
+C<< message >> - form submission error messages.
+
+=back
+
+=cut
+
sub req_lost {
my ($self, $req, $errors) = @_;
return $req->response("user/lost_prompt", \%acts);
}
+=item lost_save
+
+Save a new password for a user identified by a lost password recovery
+id.
+
+On success, refresh to the logon page with a success message.
+
+On failure, show the logon page with an error message.
+
+=cut
+
my %lost_fields =
(
password =>
return $req->get_refresh($req->cfg->user_url("user", "show_logon"));
}
+=back
+
+=head1 Standard user page tags
+
+These are the standard dynamic tags, and:
+
+=over
+
+=item *
+
+C<< user I<field> >> - access to the user.
+
+=item *
+
+C<< iterator ... orders >>, C<< order I<field> >> - iterate over user
+orders.
+
+=item *
+
+C<< iterator ... items >>, C<< item I<field> >> - iterate over items
+in the current order.
+
+=item *
+
+C<< iterator ... orderfiles >>, C<< orderfile I<field> >> - iterate
+over the files for the current order.
+
+=item *
+
+C<< product I<field> >> - access to the product for the current order
+item.
+
+=item *
+
+C<< iterator ... prodfiles >>, C<< prodfile I<field> >> - iterate over
+the files for the product for the current order item.
+
+=item *
+
+C<< ifFileAvail >> - test if the current C<orderfile> or C<prodfile>
+is available.
+
+=item *
+
+C<options> - product options selected for the current order line item.
+
+=back
+
+=cut
+
+sub _common_tags {
+ my ($self, $req, $user) = @_;
+
+ my $cfg = $req->cfg;
+
+ #my $order_index;
+ #my $item_index;
+ #my @items;
+ my $item;
+ my $product;
+ #my @files;
+ #my $file_index;
+ my $file;
+ my @orders;
+ my $order;
+
+ my $must_be_paid = $cfg->entryBool('downloads', 'must_be_paid', 0);
+ my $must_be_filled = $cfg->entryBool('downloads', 'must_be_filled', 0);
+ my $it = BSE::Util::Iterate->new(req => $req);
+ my $ito = BSE::Util::Iterate::Objects->new();
+ return
+ (
+ $req->dyn_user_tags(),
+ user => [ \&tag_hash, $user ],
+ $ito->make
+ (
+ data => \@orders,
+ single => 'order',
+ plural => 'orders',
+ #index => \$order_index,
+ code => [ iter_orders => $self, $user ],
+ store => \$order,
+ ),
+ $it->make
+ (
+ single => "item",
+ plural => "items",
+ code => [ iter_order_items => $self, \$order ],
+ store => \$item,
+ changed => sub {
+ my ($item) = @_;
+ if ($item) {
+ $product = $item->product
+ or print STDERR "No product found for item $item->{id}\n";
+ }
+ else {
+ undef $product;
+ }
+ $req->set_article(product => $product);
+ },
+ nocache => 1,
+ ),
+ $it->make
+ (
+ single => "orderfile",
+ plural => "orderfiles",
+ code => [ iter_orderfiles => $self, \$order ],
+ store => \$file,
+ nocache => 1,
+ ),
+ product => sub {
+ $item or return "* Not in item iterator *";
+ $product or return "* No current product *";
+ return tag_article($product, $cfg, $_[0]);
+ },
+ $it->make
+ (
+ single => "prodfile",
+ plural => "prodfiles",
+ code => [ files => $product ],
+ store => \$file,
+ nocache => 1,
+ ),
+ ifFileAvail =>
+ sub {
+ if ($file) {
+ return 1 if !$file->{forSale};
+ }
+ return 0 if $must_be_paid && !$order->paidFor;
+ return 0 if $must_be_filled && !$order->filled;
+ return 1;
+ },
+ options => [ tag_order_item_options => $self, $req, \$item ],
+ );
+}
1;
+
+=head1 AUTHOR
+
+Tony Cook <tony@develop-help.com>
+
+=cut
projects / bse.git / commitdiff