Update of /cvs/scoop/scoop/lib/Scoop/Users
In directory sodium.sabren.com:/tmp/cvs-serv5844/lib/Scoop/Users
Added Files:
NewUser.pm Prefs.pm
Log Message:
New flexible user preferences stuff.
-janra
--- NEW FILE: NewUser.pm ---
package Scoop;
use strict;
my $DEBUG = 0;
=pod
=head1 Users/NewUser.pm
This file contains the user creation function and associated utilities.
=head1 FUNCTIONS
=over 4
=item new_user
Creates new accounts and new advertiser accounts. (Advertiser accounts have
never been used so they may not work.)
=cut
sub new_user {
my $S = shift;
$S->{UI}->{BLOCKS}->{subtitle} = 'New User';
my $tool = $S->{CGI}->param('tool');
my $email = $S->{CGI}->param('email');
my $is_advertiser = 0;
my $no_create = 0;
# this controls whether or not they will see the extra advertising
# account information fields.
$is_advertiser = 1 if ($tool eq 'advertiser' || $S->{CGI}->param('advertiser') == 1 );
$is_advertiser = 0 unless( $S->{UI}->{VARS}->{use_ads} && $S->{UI}->{VARS}->{req_extra_advertiser_info} );
my $new_user_page = '';
my $required_prefs = '';
my $really_new_user = ( $S->{GID} eq 'Anonymous' ? 1 : 0 );
$really_new_user = 1 if ($S->have_perm('make_new_accounts'));
#accounts with this perm set will never see the new advertiser page
# if this is a person visiting this page not logged in, or a non-advertiser trying to
# set up an ad account, they get the page to create an account. Otherwise give them
# an error message tailored to their situation, whether they are a normal user trying
# to create another account or an advertiser trying to create another advertising account
if( $really_new_user ) {
$new_user_page .= $S->{UI}->{BLOCKS}->{new_user_html};
# get required prefs
my $user = $S->user_data($S->{UID});
my @prefs = $S->_required_pref_list($user);
foreach my $pref (@prefs) {
my $current = $S->{PREF_ITEMS}->{$pref};
warn "(new_user) processing $pref (currently $user->{prefs}->{$pref})" if $DEBUG;
my $prefvalue = $S->cgi->param($pref) || $current->{default_value};
$prefvalue = $S->_filter_display($prefvalue);
my $preftemplate = $S->{UI}->{BLOCKS}->{$current->{template}};
my $allowed_html = $S->html_checker->allowed_html_as_string('pref') if $current->{html};
my $keys = { 'control' => $current->{field},
'title' => $current->{title},
'description' => $current->{description},
'allowed_html' => $allowed_html };
$preftemplate = $S->interpolate($preftemplate,$keys);
$preftemplate =~ s/%%value%%/$prefvalue/;
$required_prefs .= $preftemplate;
}
} elsif( !$is_advertiser ) {
$new_user_page .= $S->{UI}->{BLOCKS}->{new_user_has_account};
$no_create = 1;
} elsif( $is_advertiser && $S->{GID} eq $S->{UI}->{VARS}->{advertiser_group} ) {
$new_user_page .= $S->{UI}->{BLOCKS}->{new_advertiser_has_account};
$no_create = 1;
} elsif( $is_advertiser ) {
$new_user_page .= $S->{UI}->{BLOCK}->{new_advertiser_html};
}
my $formkey = $S->make_blowfish_formkey();
my ($uname, $pass1, $error);
# if they click the "Create User" button, create the account
if ($tool eq 'writeuser') {
$uname = $S->{CGI}->param('nickname');
if( $really_new_user ) {
if ($error .= $S->filter_new_username($uname)) {
$uname = '';
}
if ($error .= $S->check_for_user($uname)) {
$uname = '';
}
if ($error .= $S->check_email($email)) {
$email = '';
}
}
if ($is_advertiser) {
$error .= $S->check_address_fields();
}
$error .= '<BR> Invalid IP number, or old formkey. Please try again.' unless ($S->check_blowfish_formkey($S->cgi->param('formkey')));
$error .= $S->check_creation_rate();
$pass1 = $S->_random_pass();
unless ($error) {
my $rv;
if ($really_new_user) {
$rv = $S->create_user_step_1($uname, $pass1, $email);
} elsif ($is_advertiser) {
$rv = $S->store_advertiser_info($S->{UID});
}
if ($rv == 1) {
# Run the new user hook
$S->run_hook('user_new', $uname, $is_advertiser);
my $return_page = $S->{UI}->{BLOCKS}->{newuser_confirm_page};
my $user_email = $email || $S->get_email_from_uid($S->{UID});
$return_page =~ s/%%EMAIL%%/$user_email/g;
$return_page =~ s/%%SITENAME%%/$S->{UI}->{VARS}->{sitename}/g;
$S->{UI}->{BLOCKS}->{CONTENT} .= $return_page;
return;
} else {
$error .= $rv;
}
}
}
$new_user_page =~ s/%%error%%/$error/g;
$new_user_page =~ s/%%uname%%/$uname/g;
$new_user_page =~ s/%%email%%/$email/g;
$new_user_page =~ s/%%formkey%%/$formkey/g;
$new_user_page =~ s/%%required_prefs%%/$required_prefs/g;
$S->{UI}->{BLOCKS}->{CONTENT} = $new_user_page;
return;
}
=item check_creation_rate
A utility to check the number of new accounts created by a particular IP
address in a day.
=cut
sub check_creation_rate {
my $S = shift;
my ($rv, $sth) = $S->db_select({
WHAT => 'uid',
FROM => 'users',
WHERE => qq|creation_ip = "$S->{REMOTE_IP}" AND creation_time >= DATE_SUB(NOW(), INTERVAL 24 HOUR)|
});
my $count = $sth->fetchall_arrayref();
$sth->finish();
if (scalar(@$count) >= $S->{UI}->{VARS}->{max_accounts_per_day} ) {
return '<BR> Sorry, but account creation is restricted to '. $S->{UI}->{VARS}->{max_accounts_per_day} .' new accounts per IP per day. If you are behind a proxy or firewall that serves a large number of clients, others may have already created accounts today. Just wait till tomorrow, and try again.';
}
return '';
}
=item filter_new_username
A utility to make sure usernames are legal. Three of the four tests are for
things that will make people seem to have an identical username as another
user: leading and trailing spaces, multiple spaces in a row, and
characters, all of which collapse into a single space when rendered by a
browser.
=cut
sub filter_new_username {
my $S = shift;
my $name = shift;
if ($name =~ /^\s/ || $name =~ /\s$/) {
return "Username cannot begin or end with a space.";
}
if ($name =~ /\s\s/) {
return "Username cannot contain multiple spaces in a row.";
}
if ($name =~ /[^a-zA-Z0-9\s]/) {
return "Username contains an illegal character.";
}
if ($name =~ / /) {
return "Username cannot contain &nbsp; entity.";
}
return '';
}
=item create_user_step_1
Does the DB insert and sends the new user email; if email fails in a way that
the program can detect, it removes the newly created account information by
calling rollback_account.
=cut
sub create_user_step_1 {
my $S = shift;
my ($nick, $pass, $email) = @_;
my $c_pass = $S->crypt_pass($pass);
my $f_nick = $S->dbh->quote($nick);
my $f_email = $S->dbh->quote($email);
my $default_group = $S->_get_default_group;
my ($rv, $sth) = $S->db_insert({
INTO => 'users',
COLS => 'nickname, origemail, realemail, passwd, perm_group, creation_ip, creation_time, is_new_account',
VALUES => qq|$f_nick, $f_email, $f_email, "$c_pass", "$default_group", "$S->{REMOTE_IP}", NOW(),1|});
$sth->finish;
return "Error creating new user! Database said: ".$DBI::errstr if !$rv;
my $uid = $S->dbh->{'mysql_insertid'};
# insert initial required prefs
my $user = $S->user_data($uid);
my @prefs = $S->_required_pref_list($user);
foreach my $pref (@prefs) {
my $value = $S->cgi->param($pref);
$rv = $S->_save_pref($user,$pref,$value);
warn "(create_user_step_1) rv is $rv" if $DEBUG;
if ( $rv =~ /error/i ) {
$S->rollback_account($uid);
return $rv;
}
}
my $path = $S->{UI}->{VARS}->{site_url} . $S->{UI}->{VARS}->{rootdir};
my $subject = $S->{UI}->{BLOCKS}->{new_user_email_subject};
my $from = $S->{UI}->{VARS}->{new_user_email_from} || $S->{UI}->{VARS}->{local_email};
my $sitename = $S->{UI}->{VARS}->{sitename};
my $showprefs;
if($S->{UI}->{VARS}->{show_prefs_on_first_login}) {
$showprefs = $S->{UI}->{BLOCKS}->{new_user_email_showprefs};
}
my $content = $S->{UI}->{BLOCKS}->{new_user_email};
$content =~ s/%%nick%%/$nick/;
$content =~ s/%%pass%%/$pass/;
$content =~ s/%%url%%/$path/;
$content =~ s/%%showprefs%%/$showprefs/;
$content =~ s/%%from%%/$from/;
$content =~ s/%%sitename%%/$sitename/;
$subject =~ s/%%sitename%%/$sitename/;
$rv = $S->mail($email, $subject, $content, $from);
warn 'Return from $S->mail is '.$rv."\n" if $DEBUG;
unless ($rv == 1) {
$S->rollback_account($uid);
}
return $rv;
}
=item rollback_account
Deletes the user account given to it as a parameter.
=cut
sub rollback_account {
my $S = shift;
my $uid = shift;
my ($rv) = $S->db_delete({
DEBUG => 0,
FROM => 'users',
WHERE => qq|uid = $uid|});
($rv) = $S->db_delete({
DEBUG => $DEBUG,
FROM => 'userprefs',
WHERE => qq|uid = $uid|});
return;
}
=item check_for_user
=item check_email
Checks to see if the username and email address are already in use by another
user.
=cut
sub check_for_user {
my $S = shift;
my $nick = shift;
return '<br />Username is already in use.<br />Please try a different one.'
if $nick eq $S->{UI}->{VARS}->{anon_user_nick};
unless ($nick) {
return '<br />You must choose a user name';
}
my ($rv, $sth) = $S->db_select({
WHAT => 'uid',
FROM => 'users',
WHERE => qq|nickname = "$nick"|});
$sth->finish;
if ($rv eq '0E0' or $rv == 0) {
return '';
} else {
return '<br />Username is already in use.<br />Please try a different one.';
}
}
sub check_email {
my $S = shift;
my $email = shift;
unless ($email) {
return '<BR>You must enter an email address, which must be working to activate your account.<BR><BR>';
}
my ($rv, $sth) = $S->db_select({
WHAT => 'uid',
FROM => 'users',
WHERE => qq|realemail = "$email" OR origemail = "$email"|});
#$sth->finish;
# Return an error if it fails since they can't use that address
if ($rv eq '0E0' ||
$rv == 0 || # if it fails the address is already in use, so return
$sth->fetchrow_hashref->{uid} == $S->{UID} || # unless its theirs
$S->have_perm('edit_user') ) { # or they are an admin
$sth->finish;
} else {
$sth->finish;
return '<BR>' . $email . ' belongs to a registered user already.<BR>All accounts must have a unique email address.<BR><BR>';
}
# Check that the domain is legal.
# Add domains to block in Var 'blocked_domains', separated by commas.
my %blocked_dom = ();
foreach(split /\s*,[\n\r\s]*/, $S->{UI}->{VARS}->{blocked_domains}) {
#warn "Blocked $_\n";
$blocked_dom{$_} = 1;
}
$email =~ /\@(.*)\s*$/;
my $dom = $1;
return '<BR>' . $email . " is from a blocked domain." if ($blocked_dom{$dom});
}
1;
--- NEW FILE: Prefs.pm ---
package Scoop;
use strict;
my $DEBUG = 0;
=pod
=head1 Users/Prefs.pm
This file contains user info and user preference management.
=head1 FUNCTIONS
=over 4
=item user_info
Displays the user info page, creating it from those prefs marked visible and
which the current user has permission to view.
=cut
sub user_info {
my $S = shift;
my $uid = shift;
my $nick = $S->param->{nick};
my $return = $S->{UI}->{BLOCKS}->{user_info_page};
my $trusted_msg = '';
warn "(user_info) user $S->{UID} requesting user info for $uid" if $DEBUG;
#get user info and user prefs
my $user = $S->user_data($uid);
#get trusted/untrusted user message
if ( $S->{TRUSTLEV} == 2 && $S->{UID} == $uid ) {
$trusted_msg = $S->{UI}->{BLOCKS}->{trusted_info_message};
}
#get public prefs
my @preflist = $S->_public_pref_list($user);
my $item_list = '';
foreach my $pref (@preflist) {
warn "(user_info) processing $pref: user has $user->{prefs}->{$pref}" if $DEBUG;
if ($user->{prefs}->{$pref}) {
my $item = $S->{UI}->{BLOCKS}->{$S->{PREF_ITEMS}->{$pref}->{template}};
my $fmt = $S->{PREF_ITEMS}->{$pref}->{display_fmt};
if ( $fmt ) {
$fmt =~ s/%%value%%/$user->{prefs}->{$pref}/g;
$user->{prefs}->{$pref} = $fmt;
}
$item =~ s/%%title%%/$S->{PREF_ITEMS}->{$pref}->{title}/;
$item =~ s/%%control%%/$user->{prefs}->{$pref}/;
$item =~ s/%%description%%//;
$item =~ s/%%allowed_html%%//;
$item_list .= $item;
}
}
$S->{UI}->{BLOCKS}->{subtitle} = "$nick: User Info";
$return =~ s/%%trusted_msg%%/$trusted_msg/;
$return =~ s/%%itemlist%%/$item_list/;
$S->{UI}->{BLOCKS}->{CONTENT} = $return;
}
=item get_user_prefs
Builds the edit form for the user preference page specified.
=cut
sub get_user_prefs {
my $S = shift;
my $page = $S->param->{action};
my $uid = shift;
my $nick = $S->param->{nick};
my $write = $S->cgi->param('write');
my $reset = $S->cgi->param('reset');
my $message = '';
my %params;
my $firstlogin = $S->param->{firstlogin};
my $nextpage = $S->cgi->param('nextpage');
my $nextpage_form = '';
# check for permission...
unless ( $S->{UID} > -1 && ( $S->{UID} == $uid || $S->have_perm('edit_user') ) ) {
return "%%error_font%%Permission Denied.%%error_font_end%%";
}
if ($reset) {
$write = '1';
%params = $S->_reset_user_prefs($page, $uid);
$message .= "$page preferences reset to defaults";
}
$message .= $S->_save_user_prefs($page, $uid, $nick) if ($write);
warn "(get_user_prefs) first login? $firstlogin" if $DEBUG;
if ($firstlogin) {
$message .= $S->{UI}->{BLOCKS}->{firstlogin_message};
$uid = $S->{UID};
$nick = $S->{NICK};
my @pages = split(/,\s*/, $S->var('first_login_page_order'));
$page = $nextpage ? $nextpage : $pages[0];
my $i = 0;
while ( $pages[$i] ne $page ) {
$i++;
}
$i++;
$nextpage_form = qq{
<INPUT type="hidden" name="firstlogin" value="1">
<INPUT type="hidden" name="nextpage" value="$pages[$i]">} if $pages[$i];
}
$page = 'User Info' unless $page;
my $formkey = $S->get_formkey_element();
my $item_list = '';
my $return = $S->{UI}->{BLOCKS}->{user_pref_page};
$return =~ s/%%formkey%%/$formkey $nextpage_form/;
$return =~ s/%%nick%%/$nick/g;
$return =~ s/%%page%%/$page/g;
#get user info and user prefs
my $user = $S->user_data($uid);
%{$user->{prefs}} = (%{$user->{prefs}},%params) if $reset;
if ( $page eq 'Protected' ) {
# Yes, this is a special case - password and real email are
# the only "preferences" stored in the user table now.
my ($adminpreftemplate, $preftemplate);
my $preflist = {'realemail' => $user->{realemail} };
my $adminpreflist = {'origemail' => $user->{origemail},
'nickname' => $user->{nickname},
'uid' => $user->{uid},
'perm_group' => $user->{perm_group},
'mojo' => $user->{mojo},
'creation_ip' => $user->{creation_ip},
'creation_time' => $user->{creation_time} };
if ( $S->have_perm('edit_user') ) {
$adminpreftemplate = $S->{UI}->{BLOCKS}->{user_admin};
$adminpreftemplate =~ s/%%perm_group%%/$user->{perm_group}/;
$adminpreftemplate = $S->interpolate($adminpreftemplate,$adminpreflist);
}
$preftemplate = $S->{UI}->{BLOCKS}->{user_pass};
if ( $firstlogin ) {
my $pass = $S->cgi->param('pass');
$preflist->{passwd} = $S->{UI}->{BLOCKS}->{userpref_oldpass_hidden};
$preflist->{passwd} =~ s/%%pass%%/$pass/;
} else {
$preflist->{passwd} = $S->{UI}->{BLOCKS}->{userpref_oldpass_field};
}
$preftemplate = $S->interpolate($preftemplate,$preflist);
$return =~ s/%%itemlist%%/$adminpreftemplate\n$preftemplate/;
$return =~ s/%%userpref_reset%%//;
} else {
# Now for all the dynamically generated pages
my @preflist = $S->_pref_list($page, $user);
$S->{UI}->{BLOCKS}->{subtitle} = "$page";
foreach my $pref (@preflist) {
my $current = $S->{PREF_ITEMS}->{$pref};
warn "(get_user_prefs) processing $pref (currently $user->{prefs}->{$pref})" if $DEBUG;
my $prefvalue = (defined($user->{prefs}->{$pref})) ? $user->{prefs}->{$pref} : $current->{default_value};
$prefvalue = $S->_filter_display($prefvalue);
my $required = $current->{required} ? $S->{UI}->{BLOCKS}->{required_pref_marker} : '';
my $preftemplate = $S->{UI}->{BLOCKS}->{$current->{template}};
my $allowed_html = $S->html_checker->allowed_html_as_string('pref') if $current->{html};
my $keys = {'control' => $current->{field},
'title' => $current->{title},
'description' => $current->{description},
'allowed_html' => $allowed_html,
'required' => $required };
$preftemplate = $S->interpolate($preftemplate,$keys);
$preftemplate =~ s/%%value%%/$prefvalue/;
$item_list .= $preftemplate;
}
$return =~ s/%%itemlist%%/$item_list/;
}
$return =~ s/%%message%%/$message/;
$S->{UI}->{BLOCKS}->{CONTENT} = $return;
}
=item _save_user_prefs
Saves the user prefs for the page specified. Does not attempt to save all cgi
parameters, only those which should appear on the preference page specified.
Any preference that should be on the page but is not defined is assumed to be
an unchecked checkbox and is treated accordingly.
=cut
sub _save_user_prefs {
my $S = shift;
my $page = shift;
my $uid = shift;
my $nick = shift;
my %params = %{ $S->{CGI}->Vars_cloned() };
my $user = $S->user_data($uid);
my $return = '';
my %save;
unless ( $S->check_formkey() ) {
return $S->{UI}->{BLOCKS}->{formkey_err};
}
if ( $page eq 'Protected' ) {
# Yes, this is a special case - password and real email are
# the only "preferences" stored in the user table now.
my $pass = $params{verify_me};
if ( $S->have_perm('edit_user') || $S->check_password($nick,$pass) ) {
# changing the password?
if ( $params{pass1} ) {
if ( $params{pass1} eq $params{pass2} ) {
$save{passwd} = $S->crypt_pass($params{pass1});
} else {
$return .= "New passwords do not match";
}
}
# changing the nickname?
if ( $S->have_perm('edit_user') && $params{nickname} ne $user->{nickname} ) {
if ( !$S->get_uid_from_nick($params{nickname}) ) {
$save{nickname} = $params{nickname};
} else {
$return .= "$params{nickname} is already in use";
}
}
# changing the group?
if ( $S->have_perm('edit_groups') ) {
if ( $params{perm_group_id} ne $user->{perm_group} ) {
$save{perm_group} = $params{perm_group_id};
}
}
# and real email
my $mail_err = $S->check_email($params{realemail});
if ( !$mail_err ) {
if ( $params{realemail} ne $user->{realemail} ) {
$save{realemail} = $params{realemail};
}
} else {
$return .= "%%error_font%%$mail_err%%error_font_end%%";
}
# now we save anything that's changed
my $set = '';
foreach my $item (keys %save) {
$save{$item} = $S->dbh->quote($save{$item});
$set .= qq{$item = $save{$item}, };
}
$set =~ s/, $//;
my ($rv, $sth) = $S->db_update({
WHAT => 'users',
SET => $set,
WHERE => "uid = $uid"
}) if $set;
# and tell the user what was saved
$return .= $S->{DBH}->errstr unless ($rv);
$return .= "<P>Updated fields: ";
foreach my $key (keys %save) {
$return .= "$key, ";
$S->run_hook('pref_change', $uid, $key, $save{$key});
}
$return =~ s/, $//;
# and update the rdf_channels table if the nickname was changed,
# because it uses nick, not uid
# this will have to get fixed someday
if ( $save{nickname} ) {
my ($rv2, $sth2) = $S->db_update({
WHAT => 'rdf_channels',
SET => "submittor = $save{nickname}",
WHERE => "submittor = $nick"
});
$sth2->finish;
}
} else {
$return .= "Password incorrect";
}
} else {
# all the dynamically generated pages
my @preflist = $S->_pref_list($page,$user);
foreach my $pref (@preflist) {
$return .= $S->_save_pref($user,$pref,$params{$pref});
}
# now force prefs to refresh from the db
delete($S->{USER_DATA_CACHE}->{$uid});
}
return $return;
}
=item _save_pref
Filters and saves a single pref. Takes three arguments, the user hash, the pref
name and the value to set.
=cut
sub _save_pref {
my $S = shift;
my $user = shift;
my $pref = shift;
my $value = shift;
my $pref_item = $S->{PREF_ITEMS}->{$pref};
my $uid = $user->{uid};
# if it's an array of checkboxes with the same name, it shows up as an
# arrayref. Must convert to comma-separated list for storage.
$value = join(',', @{$value}) if ref($value) =~ /ARRAY/;
warn "(_save_user_prefs) filtering item $pref with old value $user->{prefs}->{$pref}; new value $value" if $DEBUG;
# check if it's required
warn "$pref is required? $pref_item->{required}" if $DEBUG;
if ( $pref_item->{required} && !$value ) {
warn "$pref is required and blank - error" if $DEBUG;
return "<P>%%error_font%%$pref_item->{title} is a required field%%error_font_end%%</P>";
}
# make NULL values (eg, unchecked checkboxes) into 'off'
$value = 'off' unless defined($value);
# skip unchanged params
next if $user->{prefs}->{$pref} eq $value;
# check length then regexp
if ( $pref_item->{length} ) {
if ( length($value) > $pref_item->{length} ) {
return "<P>%%error_font%%$pref_item->{title} must be less than $pref_item->{length} characters%%error_font_end%%</P>";
}
}
if ( $pref_item->{regex} && $value ) {
warn "testing $value against regex $pref_item->{regex}" if $DEBUG;
unless ( $value =~ /$pref_item->{regex}/ ) {
return "<P>%%error_font%%$pref_item->{title} ($value) does not validate%%error_font_end%%</P>";
}
}
# filter for html/plaintext
if ( $pref_item->{html} ) {
$value = $S->filter_comment($value, 'prefs');
my $errors = $S->html_checker->errors_as_string;
return "<P>%%error_font%%$pref_item->{title}: $errors%%error_font_end%%</P>" if $errors;
} else {
$value = $S->filter_subject($value);
}
# quote for db and save it
my $q_value = $S->dbh->quote($value);
my $q_key = $S->dbh->quote($pref);
warn "(_save_user_prefs) saving item $pref" if $DEBUG;
my ($rv, $sth);
if ( defined $user->{prefs}->{$pref} ) {
($rv, $sth) = $S->db_update({
DEBUG => $DEBUG,
WHAT => 'userprefs',
SET => "prefvalue = $q_value",
WHERE => "uid = $uid AND prefname = $q_key"
});
$sth->finish;
} else {
($rv, $sth) = $S->db_insert({
DEBUG => $DEBUG,
INTO => 'userprefs',
COLS => 'uid, prefname, prefvalue',
VALUES => "$uid, $q_key, $q_value"
});
$sth->finish;
}
if ($rv) {
$S->run_hook('pref_change', $uid, $pref, $value);
$sth->finish;
return "Saved $pref_item->{title}<BR>";
} else {
warn "(_save_user_prefs) database error: $S->dbh->errstr()" if $DEBUG;
$value = 'ERROR';
$sth->finish;
return "Error saving $pref_item->{title}: " . $S->dbh->errstr() . "<BR>";
}
}
=item _reset_user_prefs
Resets all the user prefs which should appear on the given page to the defaults
specified in the prefs admin tool
=cut
sub _reset_user_prefs {
my $S = shift;
my $page = shift;
my $uid = shift;
my %params;
my @preflist = $S->_pref_list($page,$uid);
foreach my $pref (@preflist) {
$params{$pref} = $S->{PREF_ITEMS}->{$pref}->{default_value};
}
return %params;
}
####
# returns an array of preference names which are marked as "public"
# ordered by the display order field
####
sub _public_pref_list {
my $S = shift;
my $user = shift;
my @preflist;
my ($rv, $sth) = $S->db_select({
WHAT => 'prefname',
FROM => 'pref_items',
WHERE => 'visible = 1 AND enabled = 1',
ORDER_BY => 'display_order'
});
while ( my ($pref) = $sth->fetchrow_array() ) {
next if $S->{PREF_ITEMS}->{$pref}->{perm_view} && !$S->have_perm($S->{PREF_ITEMS}->{$pref}->{perm_view});
next if $S->{PREF_ITEMS}->{$pref}->{var} && !$S->{UI}->{VARS}->{$S->{PREF_ITEMS}->{$pref}->{var}};
next if $S->{PREF_ITEMS}->{$pref}->{req_tu} && !( $user->{trustlev} == 2 || $S->have_perm('super_mojo',$user->{perm_group}) );
push @preflist, $pref;
}
$sth->finish;
return @preflist;
}
####
# returns an array of preference names which are marked as "required"
# ordered by the page they're on, then the display order field
# Not sure why one would use this for anything other than the new user page
# but hey, it could happen. All perm/etc checks still done.
####
sub _required_pref_list {
my $S = shift;
my $user = shift;
my @preflist;
my ($rv, $sth) = $S->db_select({
WHAT => 'prefname',
FROM => 'pref_items',
WHERE => 'required = 1 AND enabled = 1',
ORDER_BY => 'display_order'
});
while ( my ($pref) = $sth->fetchrow_array() ) {
next if $S->{PREF_ITEMS}->{$pref}->{perm_view} && !$S->have_perm($S->{PREF_ITEMS}->{$pref}->{perm_view});
next if $S->{PREF_ITEMS}->{$pref}->{var} && !$S->{UI}->{VARS}->{$S->{PREF_ITEMS}->{$pref}->{var}};
next if $S->{PREF_ITEMS}->{$pref}->{req_tu} && !( $user->{trustlev} == 2 || $S->have_perm('super_mojo',$user->{perm_group}) );
push @preflist, $pref;
}
$sth->finish;
return @preflist;
}
####
# returns an array of preference names for the page it is given
# ordered by the display order field
####
sub _pref_list {
my $S = shift;
my $page = shift;
my $user = shift;
my @preflist;
$page = $S->dbh->quote($page);
my ($rv, $sth) = $S->db_select({
WHAT => 'prefname',
FROM => 'pref_items',
WHERE => "page = $page AND enabled = 1",
ORDER_BY => 'display_order'
});
while (my ($pref) = $sth->fetchrow_array() ) {
next if $S->{PREF_ITEMS}->{$pref}->{perm_edit} && !$S->have_perm($S->{PREF_ITEMS}->{$pref}->{perm_edit});
next if $S->{PREF_ITEMS}->{$pref}->{var} && !$S->{UI}->{VARS}->{$S->{PREF_ITEMS}->{$pref}->{var}};
next if $S->{PREF_ITEMS}->{$pref}->{req_tu} && !( $user->{trustlev} == 2 || $S->have_perm('super_mojo',$user->{perm_group}) );
push @preflist, $pref;
}
$sth->finish;
return @preflist;
}
####
# filters html and entities for display on prefs page
####
sub _filter_display {
my $S = shift;
my $string = shift;
$string =~ s/&/&/g;
$string =~ s/</</g;
$string =~ s/>/>/g;
return $string;
}
1;