Update of /cvs/scoop/scoop/lib/Scoop/Admin
In directory sodium.sabren.com:/tmp/cvs-serv5844/lib/Scoop/Admin
Modified Files:
AdminStories.pm EditUser.pm Users.pm
Added Files:
Prefs.pm
Log Message:
New flexible user preferences stuff.
-janra
--- NEW FILE: Prefs.pm ---
package Scoop;
use strict;
my $DEBUG = 0;
sub edit_prefs {
my $S = shift;
my $form = $S->{UI}->{BLOCKS}->{edit_prefs};
my $get = $S->cgi->param('get');
my $save = $S->cgi->param('save');
my $delete = $S->cgi->param('delete');
my $params;
my $keys;
my $update_msg;
# first register saves (and deletes)
if ($save && $save eq 'Save') {
warn "(edit_prefs) saving something" if $DEBUG;
if ($delete) {
$update_msg = $S->_delete_pref_item();
$get = 'Get'; # making sure the form is cleared
} else {
$update_msg = $S->_save_pref_item();
}
}
# ok, now we can show whatever's supposed to be in the form now
if ($get && $get eq 'Get') {
# get from the db
my $get_pref = $S->cgi->param('pref');
warn "(edit_prefs) getting $get_pref from the db" if $DEBUG;
$get_pref = $S->dbh->quote($get_pref);
my ($rv, $sth) = $S->db_select({
DEBUG => $DEBUG,
WHAT => '*',
FROM => 'pref_items',
WHERE => "prefname = $get_pref"
});
$params = $sth->fetchrow_hashref();
$sth->finish;
} else {
# get from the cgi params because we either saved or attempted to save.
$params = $S->cgi->Vars_cloned;
warn "(edit_prefs) getting $params->{prefname} from cgi params" if $DEBUG;
}
# now prepare the easy ones first
$keys->{pref_name} = $params->{prefname};
$keys->{pref_title} = $params->{title};
$keys->{pref_desc} = $params->{description};
$keys->{pref_default} = $params->{default_value};
$keys->{pref_page} = $params->{page};
$keys->{pref_order} = $params->{display_order};
$keys->{pref_field} = $params->{field};
$keys->{pref_length} = $params->{length};
$keys->{pref_regex} = $params->{regex};
$keys->{pref_fmt} = $params->{display_fmt};
# now we filter them because they all have to stay put inside their form elements
$keys = $S->_pref_display_filter($keys, $get);
# checkboxes
$keys->{pref_html} = $params->{html} ? ' CHECKED' : '';
$keys->{pref_tu} = $params->{req_tu} ? ' CHECKED' : '';
$keys->{pref_visible} = $params->{visible} ? ' CHECKED' : '';
$keys->{pref_enabled} = $params->{enabled} ? ' CHECKED' : '';
$keys->{pref_required} = $params->{required} ? ' CHECKED' : '';
# and finally the selectboxes
$keys->{pref_selectbox} = $S->_pref_name_select();
$keys->{pref_template} = $S->_pref_template_select($params->{template});
$keys->{pref_var} = $S->_pref_var_select($params->{var});
$keys->{pref_perm_view} = $S->_pref_perm_view_select($params->{perm_view});
$keys->{pref_perm_edit} = $S->_pref_perm_edit_select($params->{perm_edit});
# also a couple of user preferences!
$keys->{cols} = $S->pref('textarea_cols');
$keys->{rows} = $S->pref('textarea_rows');
# and a status report.
$keys->{update_msg} = $update_msg;
$form = $S->interpolate($form, $keys);
return $form;
}
sub _save_pref_item {
my $S = shift;
my $msg = '';
my $pref = $S->cgi->param('pref');
warn "(_save_pref_item) trying to save $pref" if $DEBUG;
my $params;
foreach my $item (qw(prefname title description visible html perm_view perm_edit var req_tu default_value length regex page field display_order template display_fmt enabled required)) {
$params->{$item} = $S->cgi->param($item);
}
if ( $pref eq $params->{prefname} ) {
# editing an exiting pref?
$params = $S->_pref_save_filter($params);
my $set;
foreach my $field (keys %{$params}) {
$set .= "$field=$params->{$field}, ";
}
$set =~ s/, $//;
my $q_pref = $S->dbh->quote($pref);
my ($rv, $sth) = $S->db_update({
DEBUG => $DEBUG,
WHAT => 'pref_items',
SET => $set,
WHERE => "prefname = $q_pref"
});
$msg = $rv ? "$pref updated" : "error: database said " . $S->dbh->errstr();
$sth->finish;
$S->cache->remove('pref_items');
$S->cache->stamp('pref_items');
$S->_set_pref_items();
} elsif ( !$pref ) {
# creating a new pref?
$params = $S->_pref_save_filter($params);
my ($cols, $vals);
foreach my $field (keys %{$params}) {
$cols .= "$field, ";
$vals .= "$params->{$field}, ";
}
$cols =~ s/, $//;
$vals =~ s/, $//;
my ($rv, $sth) = $S->db_insert({
DEBUG => $DEBUG,
INTO => 'pref_items',
COLS => $cols,
VALUES => $vals
});
$msg = $rv ? "$params->{prefname} added" : "error: database said " . $S->dbh->errstr();
$sth->finish;
$S->cache->remove('pref_items');
$S->cache->stamp('pref_items');
$S->_set_pref_items();
} else {
# something's wrong...
$msg .= 'Pref name in field and selectbox must match, or selectbox must be set to "Add New".';
}
return $msg;
}
sub _delete_pref_item {
my $S = shift;
my $msg = '';
my $pref = $S->cgi->param('pref');
warn "(_delete_pref_item) trying to delete $pref" if $DEBUG;
return "You must select a pref to delete" unless $pref;
$pref = $S->dbh->quote($pref);
my ($rv, $sth) = $S->db_delete({
DEBUG => $DEBUG,
FROM => 'pref_items',
WHERE => "prefname = $pref"
});
$msg = $rv ? "$pref deleted" : "error: database said " . $S->dbh->errstr();
$sth->finish;
$S->cache->remove('pref_items');
$S->cache->stamp('pref_items');
$S->_set_pref_items();
return $msg;
}
sub _pref_name_select {
my $S = shift;
my $current = ($S->cgi->param('get') && $S->cgi->param('get') eq 'Get') ? $S->cgi->param('pref') : $S->cgi->param('pref') || $S->cgi->param('prefname');
warn "(_pref_name_select) currently selected: $current" if $DEBUG;
my $prefnames;
my $select = qq{
<SELECT name="pref" size="1">
<OPTION value="">Add New</OPTION>};
my ($rv, $sth) = $S->db_select({
DEBUG => $DEBUG,
WHAT => 'prefname',
FROM => 'pref_items',
ORDER_BY => 'prefname asc'
});
$prefnames = $sth->fetchall_arrayref();
$sth->finish();
foreach my $pref (@{$prefnames}) {
my $selected = ( $current eq $pref->[0] ) ? ' SELECTED' : '';
$select .= qq{
<OPTION value="$pref->[0]"$selected>$pref->[0]</OPTION>};
}
$select .= qq{
</SELECT>};
return $select;
}
sub _pref_template_select {
my $S = shift;
my $current = shift;
warn "(_pref_template_select) currently selected: $current" if $DEBUG;
my $select = qq{
<SELECT name="template" size="1">};
foreach my $block (sort keys %{$S->{UI}->{BLOCKS}}) {
next unless $block =~ /_pref$/;
my $selected = ( $current eq $block ) ? ' SELECTED' : '';
$select .= qq{
<OPTION value="$block"$selected>$block</OPTION>};
}
$select .= qq{
</SELECT>};
return $select;
}
sub _pref_var_select {
my $S = shift;
my $current = shift;
warn "(_pref_var_select) currently selected: $current" if $DEBUG;
my $selected = $current ? ' SELECTED' : '';
my $select = qq{
<SELECT name="var" size="1">
<OPTION value=""$selected>None</OPTION>};
foreach my $var (sort keys %{$S->{UI}->{VARS}}) {
$selected = ( $current eq $var ) ? ' SELECTED' : '';
$select .= qq{
<OPTION value="$var"$selected>$var</OPTION>};
}
$select .= qq{
</SELECT>};
return $select;
}
sub _pref_perm_view_select {
my $S = shift;
my $current = shift;
warn "(_pref_perm_view_select) currently selected: $current" if $DEBUG;
my $selected = $current ? ' SELECTED' : '';
my $select = qq{
<SELECT name="perm_view" size="1">
<OPTION value=""$selected>None</OPTION>};
foreach my $perm (sort split(/,\s*/, $S->{UI}->{VARS}->{perms})) {
$selected = ( $current eq $perm ) ? ' SELECTED' : '';
$select .= qq{
<OPTION value="$perm"$selected>$perm</OPTION>};
}
$select .= qq{
</SELECT>};
return $select;
}
sub _pref_perm_edit_select {
my $S = shift;
my $current = shift;
warn "(_pref_perm_edit_select) currently selected: $current" if $DEBUG;
my $selected = $current ? ' SELECTED' : '';
my $select = qq{
<SELECT name="perm_edit" size="1">
<OPTION value=""$selected>None</OPTION>};
foreach my $perm (sort split(/,\s*/, $S->{UI}->{VARS}->{perms})) {
$selected = ( $current eq $perm ) ? ' SELECTED' : '';
$select .= qq{
<OPTION value="$perm"$selected>$perm</OPTION>};
}
$select .= qq{
</SELECT>};
return $select;
}
sub _pref_display_filter {
my $S = shift;
my $values = shift;
my $get = shift;
foreach my $key (keys %{$values}) {
$values->{$key} =~ s/&/&/g;
$values->{$key} =~ s/>/>/g;
$values->{$key} =~ s/</</g;
$values->{$key} =~ s/"/"/g;
if ($get && $get eq 'Get') {
# overzealous quoting unless it's coming from the db...
$values->{$key} =~ s/\|/\\|/g;
$values->{$key} =~ s/\%\%/\|/g;
}
}
return $values;
}
sub _pref_save_filter {
my $S = shift;
my $values = shift;
foreach my $key (keys %{$values}) {
$values->{$key} =~ s/\|/%%/g;
$values->{$key} =~ s/\\%%/\|/g;
$values->{$key} = $S->dbh->quote("$values->{$key}");
}
return $values;
}
1;
Index: Users.pm
===================================================================
RCS file: /cvs/scoop/scoop/lib/Scoop/Admin/Users.pm,v
retrieving revision 1.58
retrieving revision 1.59
diff -C2 -d -r1.58 -r1.59
*** Users.pm 30 Jul 2004 08:12:56 -0000 1.58
--- Users.pm 4 Aug 2004 21:49:48 -0000 1.59
***************
*** 191,195 ****
$next_prev .= qq|
! <TD WIDTH="50%" align="right">%%norm_font%%|;
$next_prev .= ($check) ? qq|
--- 191,195 ----
$next_prev .= qq|
! <TR> <TD WIDTH="50%" align="right">%%norm_font%%|;
$next_prev .= ($check) ? qq|
***************
*** 208,213 ****
my $rating_undo_link = $S->rating_undo_link($uid);
!
! return qq|
<TR>
<TD COLSPAN=2 BGCOLOR="%%title_bgcolor%%">%%title_font%%<B>Comment Ratings by $nick</B>%%title_font_end%%</TD>
--- 208,214 ----
my $rating_undo_link = $S->rating_undo_link($uid);
! $S->{UI}->{BLOCKS}->{subtitle} = "User Ratings";
! $S->{UI}->{BLOCKS}->{CONTENT} = qq|
! <TABLE width="95%">
<TR>
<TD COLSPAN=2 BGCOLOR="%%title_bgcolor%%">%%title_font%%<B>Comment Ratings by $nick</B>%%title_font_end%%</TD>
***************
*** 218,380 ****
<TD COLSPAN=2>%%norm_font%%$ratings%%norm_font_end%%</TD>
</TR>
! $next_prev|;
!
! }
!
! =item new_user()
!
! This function controls everything having to do with creating a user.
! It generates the form to insert an email and choose a nickname (and submits
! that to itself). If you can't tell by now, anything having to do with
! op=newuser :)
!
! =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 $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};
!
! } 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}->{BLOCKS}->{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 .= $S->check_ip();
!
! $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;
!
!
! $S->{UI}->{BLOCKS}->{CONTENT} = $new_user_page;
!
! return;
! }
- sub check_ip {
- my $S = shift;
- my $formkey = $S->cgi->param('formkey');
-
- return '<BR> Invalid IP number, or old formkey. Please try again.' unless
- ($S->check_blowfish_formkey($formkey));
-
- return '';
}
! sub check_creation_rate {
! my $S = shift;
!
! my $q_ip = $S->dbh->quote($S->{REMOTE_IP});
! my ($rv, $sth) = $S->db_select({
! WHAT => 'uid',
! FROM => 'users',
! WHERE => qq|creation_ip = $q_ip AND creation_time >= | . $S->db_date_sub("NOW()", '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 '';
! }
!
sub check_address_fields {
--- 219,229 ----
<TD COLSPAN=2>%%norm_font%%$ratings%%norm_font_end%%</TD>
</TR>
! $next_prev
! </TABLE>|;
}
! # Advertiser account stuff
sub check_address_fields {
***************
*** 399,492 ****
- 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 '';
- }
-
- 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 $q_pass = $S->dbh->quote($c_pass);
- my $q_group = $S->dbh->quote($default_group);
- my $q_ip = $S->dbh->quote($S->{REMOTE_IP});
- 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, $q_pass, $q_group, $q_ip, NOW(),1|});
- $sth->finish;
-
- return "Error creating new user! Database said: ".$DBI::errstr if !$rv;
-
- my $uid = $S->dbh->{'mysql_insertid'};
-
- 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;
- }
-
-
- sub rollback_account {
- my $S = shift;
- my $uid = shift;
-
- my ($rv) = $S->db_delete({
- DEBUG => 0,
- FROM => 'users',
- WHERE => qq|uid = $uid|});
-
- return;
- }
-
-
# this creates an entry for them in the advertiser table
sub store_advertiser_info {
--- 248,251 ----
***************
*** 602,671 ****
}
- sub check_for_user {
- my $S = shift;
- my $nick = shift;
- my $q_nick = $S->dbh->quote($nick);
-
- 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 = $q_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;
- my $q_email = $S->dbh->quote($email);
-
- 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 = $q_email OR origemail = $q_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;
--- 361,364 ----
Index: AdminStories.pm
===================================================================
RCS file: /cvs/scoop/scoop/lib/Scoop/Admin/AdminStories.pm,v
retrieving revision 1.141
retrieving revision 1.142
diff -C2 -d -r1.141 -r1.142
*** AdminStories.pm 30 Jul 2004 08:12:56 -0000 1.141
--- AdminStories.pm 4 Aug 2004 21:49:48 -0000 1.142
***************
*** 847,854 ****
# We only want to set the default spellcheck the first time they submit
# We don't want to override the setting.
! $params->{spellcheck} = $S->spellcheck_default() unless ($S->{CGI}->param('formkey'));
! my $check = ($params->{spellcheck}) ? ' CHECKED' : '';
$content .= qq|
! <INPUT TYPE="checkbox" NAME="spellcheck" VALUE="1"$check>
%%norm_font%% Spellcheck text (will force "Preview")%%norm_font_end%%<BR>|;
}
--- 847,855 ----
# We only want to set the default spellcheck the first time they submit
# We don't want to override the setting.
!
! $params->{spellcheck} = $S->pref('spellcheck_default') unless ($S->{CGI}->param('formkey'));
! my $check = ($params->{spellcheck} eq 'on') ? ' CHECKED' : '';
$content .= qq|
! <INPUT TYPE="checkbox" NAME="spellcheck" VALUE="on"$check>
%%norm_font%% Spellcheck text (will force "Preview")%%norm_font_end%%<BR>|;
}
***************
*** 901,906 ****
}
! my $textarea_cols = $S->{prefs}->{textarea_cols} || $S->{UI}->{VARS}->{default_textarea_cols};
! my $textarea_rows = $S->{prefs}->{textarea_rows} || $S->{UI}->{VARS}->{default_textarea_rows};
$content .= qq|
--- 902,907 ----
}
! my $textarea_cols = $S->pref('textarea_cols');
! my $textarea_rows = $S->pref('textarea_rows');
$content .= qq|
Index: EditUser.pm
===================================================================
RCS file: /cvs/scoop/scoop/lib/Scoop/Admin/EditUser.pm,v
retrieving revision 1.134
retrieving revision 1.135
diff -C2 -d -r1.134 -r1.135
*** EditUser.pm 30 Jul 2004 08:12:56 -0000 1.134
--- EditUser.pm 4 Aug 2004 21:49:48 -0000 1.135
***************
*** 12,80 ****
=head1 Functions
- =over 4
-
- =item *
- edit_user
-
- This is essentially a switch to pass control to the function needed for
- displaying the user information, user prefs, or playing with their
- ratings.
- (sidenote) I think the ratings stuff should be in this file, I might move
- it over here later...
-
=cut
- sub edit_user {
- my $S = shift;
-
- my $tool = $S->{CGI}->param('tool');
- my $uid = $S->{CGI}->param('uid');
- my $nick = $S->{CGI}->param('nick');
-
- if ($nick && !$uid) {
- $uid = $S->get_uid_from_nick($nick);
- # Don't assume the nick is the uid. This just causes trouble.
- #$uid = $nick if (!$uid && $nick =~ /\d+/);
- # we might not need to know the nick, but we need to see if the user
- # exists. finding the nick from the uid accomplishes this
- } elsif (!$nick && $uid) {
- $nick = $S->get_nick_from_uid($uid);
- } elsif (!$nick && !$uid) {
- $uid = $S->{UID};
- $nick = $S->{NICK};
- }
-
- unless ($uid && $nick) {
- $S->{UI}->{BLOCKS}->{CONTENT} .= 'I can\'t seem to find that user.';
- $S->{UI}->{VARS}->{subtitle} = 'Error';
- return;
- }
-
- $S->{UI}->{BLOCKS}->{CONTENT} = qq|
- <TABLE CELLPADDING=0 CELLSPACING=0 BORDER=0 width="100%">|;
-
- if ($tool eq 'prefs') {
- $S->{UI}->{BLOCKS}->{CONTENT} .= $S->_get_user_prefs($uid);
- $S->{UI}->{BLOCKS}->{subtitle} = 'Edit User Info';
- } elsif ($tool eq 'ratings') {
- my $action = $S->{CGI}->param('action');
- if ($action eq 'undo') {
- $S->undo_user_ratings($uid);
- }
- $S->{UI}->{BLOCKS}->{CONTENT} .= $S->_get_user_ratings($uid);
- $S->{UI}->{BLOCKS}->{subtitle} = 'User Ratings';
- } elsif ($tool eq 'files') {
- $S->{UI}->{BLOCKS}->{CONTENT} .= $S->_get_user_files($uid);
- $S->{UI}->{BLOCKS}->{subtitle} = 'User Files';
- } else {
- $S->{UI}->{BLOCKS}->{CONTENT} .= $S->_get_user_info($uid);
- $S->{UI}->{BLOCKS}->{subtitle} = 'User Info';
- }
-
- $S->{UI}->{BLOCKS}->{CONTENT} .= qq|
- </TABLE>|;
-
- return;
- }
sub _get_user_files {
--- 12,17 ----
***************
*** 154,159 ****
}
}
!
! return $page;
}
--- 91,96 ----
}
}
! $S->{UI}->{BLOCKS}->{subtitle} = 'User Files';
! $S->{UI}->{BLOCKS}->{CONTENT} = "<table width=\"100%\">\n$page\n</table>";
}
***************
*** 225,315 ****
}
- sub _get_user_info {
- my $S = shift;
- my $uid = shift;
- my $nick = $S->get_nick_from_uid($uid);
-
- # Get user info
- my $user = $S->user_data($uid);
-
- my $user_data;
-
- if ($user->{homepage}) {
- $user_data .= qq|
- <B>Homepage:</B> <A HREF="$user->{homepage}">$user->{homepage}</A><BR>|;
- }
- if ($user->{fakeemail}) {
- $user_data .= qq|
- <B>Email:</B> <A HREF="mailto:$user->{fakeemail}">$user->{fakeemail}</A><BR>|;
- }
- if ($user->{bio}) {
- $user_data .= qq|
- <B>Bio:</B><BR>$user->{bio}<BR>|;
- }
- if ($user->{publickey}) {
- $user_data .= qq|
- <B>Public Key:</B><FONT FACE="courier" SIZE=3><PRE>$user->{publickey}</PRE></FONT>|;
- }
-
- my $user_tools;
- if ($S->have_perm('edit_user')) {
- $user_tools = qq|%%norm_font%%${nick}'s uid is <b>$uid</b> [<A HREF="%%rootdir%%/user/uid:$uid/prefs">Edit User</A>]%%end_norm_font%%|;
- }
-
- my $trusted;
- if ($S->{UI}->{VARS}->{use_mojo} &&
- ($S->{UID} == $uid) &&
- ($S->{TRUSTLEV} == 2 || $S->have_perm('super_mojo'))) {
- $trusted = "<B>$S->{UI}->{BLOCKS}->{trusted_info_message}</B><P>";
- }
-
- # Get recent Comments
- my $urlnick = $S->urlify($nick);
-
- my $comments = qq|<A HREF="%%rootdir%%/user/$urlnick/comments">View comments posted by $nick</A>|;
- my $diary = qq|<A HREF="%%rootdir%%/user/$urlnick/diary">View |.$nick.qq|'s diary</A>|;
- my $stories = qq|<A HREF="%%rootdir%%/user/$urlnick/stories">View stories posted by $nick</A>|;
- my $ratings = qq|<A HREF="%%rootdir%%/user/$urlnick/ratings">View comment ratings by $nick</A>|;
- my $ads = qq|<A HREF="%%rootdir%%/user/$urlnick/ads">View advertisements submitted by $nick</A>|;
- my $files = qq|<A HREF="%%rootdir%%/user/$urlnick/files">View |.$nick.qq|'s files</A>|;
-
- my $ads_link = '';
- if ( $S->{UI}->{VARS}->{use_ads} == 1 ) {
- $ads_link = qq|%%dot%% %%norm_font%% $ads %%norm_font_end%%<br />|;
- }
-
- my $diary_link = '';
- if ( $S->{UI}->{VARS}->{use_diaries} ) {
- $diary_link = qq{ %%dot%% %%norm_font%% $diary %%norm_font_end%%<BR> };
- }
-
- my $files_link = '';
- if ( $S->{UI}->{VARS}->{allow_uploads} ) {
- $files_link = qq{ %%dot%% %%norm_font%% $files %%norm_font_end%%<BR> };
- }
-
- my $page = qq|
- <TR>
- <TD BGCOLOR="%%title_bgcolor%%">%%title_font%%<B>User info for $user->{nickname}</B>%%title_font_end%%</TD>
- </TR>
- <TR><TD>$user_tools </TD></TR>
- <TR>
- <TD>%%norm_font%%
- $trusted
- $user_data
- %%norm_font_end%%</TD>
- </TR>
- <TR><TD> </TD></TR>
- <TR><TD>
- %%dot%% %%norm_font%%$comments%%norm_font_end%%<BR>
- $diary_link
- %%dot%% %%norm_font%%$stories%%norm_font_end%%<BR>
- %%dot%% %%norm_font%%$ratings%%norm_font_end%%<BR>
- $ads_link
- $files_link
- </TD></TR>|;
-
- return $page;
- } #'
sub _num_replies {
--- 162,165 ----
***************
*** 330,907 ****
- sub _get_user_prefs {
- my $S = shift;
- my $uid = shift || $S->{UID};
-
- if ($uid && $uid != $S->{UID} && !$S->have_perm( 'edit_user' )) {
- my $deny = qq|
- <TR><TD>%%title_font%%<B>Permission Denied.</B>%%title_font_end%%</TD></TR>|;
- return $deny;
- }
-
- if ($S->{UID} == -1) {
- my $deny = qq|
- <TR><TD>%%title_font%%<B>Permission Denied.</B>%%title_font_end%%</TD></TR>|;
- return $deny;
- }
-
- my $write = $S->{CGI}->param('write');
- my $err = ' ';
-
- if ($write) {
- $err = $S->_save_user_data($uid);
- }
-
- my $user = $S->user_data($uid);
- return "%%norm_font%%Sorry, I can't seem to find that user%%norm_font_end%%"
- unless $user;
- my $form = $S->_user_prefs_form($uid, $user);
-
- my $page = qq|
- <TR>
- <TD BGCOLOR="%%title_bgcolor%%">%%title_font%%<B>Edit User Info for $user->{nickname}</B>%%title_font_end%%</TD>
- </TR>
- <TR><TD ALIGN="center">%%title_font%%
- <P><FONT COLOR="#FF0000">$err</FONT><P>%%title_font_end%%</TD></TR>
- $form|;
-
- return $page;
- }
-
- sub _user_prefs_form {
- my $S = shift;
- my $uid = shift;
- my $user_in = shift;
-
- my $params = $S->{CGI}->Vars_cloned();
-
- my %user = %{$user_in};
- # escape a few fields for display
- foreach my $f (qw(admin_notes bio sig publickey)) {
- $user{$f} =~ s/&/&/g;
- $user{$f} =~ s/</</g;
- $user{$f} =~ s/>/>/g;
- }
- my $user = \%user;
-
- my $nickname;
- my $group;
- my $admin_notes;
- my $orig_email;
- my $creation_ip;
- my $creation_time;
- my $subscriber_add;
- my $admin_div;
- my $formkey_element = $S->get_formkey_element();
- if ($S->have_perm('edit_user')) {
- my $form_nick = $params->{nickname} || $user->{nickname};
- $nickname = qq|
- <P><B>Nickname:</B> <input name="nickname" type="text" value="$form_nick" /></P>
- |;
-
- $group = qq|
- <P><B>User group:</B> |;
- my $cur_group = $params->{perm_group_id} || $user->{perm_group};
- if ($S->have_perm('edit_groups')) {
- $group .= $S->_get_group_selector($cur_group);
- } else {
- $group .= $cur_group;
- }
- $group .= '</P>';
-
- $orig_email = qq|
- <P><B>Original Email:</B> $user->{origemail}</P>
- |;
-
- $creation_ip = qq|
- <P><B>Original IP:</B> $user->{creation_ip}</P>
- |;
-
- $creation_time = qq|
- <P><B>Created At:</B> $user->{creation_time}</P>
- |;
-
- if( $S->{UI}->{VARS}->{allow_admin_notes} ) {
- my $form_notes = $params->{admin_notes} || $user->{admin_notes};
- $admin_notes = qq|
- <B>Admin Notes:</B><BR> |;
- $admin_notes .= qq|<TEXTAREA COLS="50" ROWS="5" NAME="admin_notes" WRAP="soft">$form_notes</TEXTAREA><P>
- |;
- }
-
- ############## REDO WITH NEW SUS
- #if ($S->{UI}->{VARS}->{'use_subscriptions'}) {
- # $subscriber_add = qq|
- # <B>Adjust Subscription:</B> Add <INPUT TYPE="text" SIZE=3 NAME="subscribe_add"> months<P>|;
- #
- # $subscriber_add .= qq|<b>Last Updated:</b> $user->{prefs}->{subscribe_last_update}<br>Right now, it is |.gmtime(time).qq| GMT.|
- # if ($user->{prefs}->{subscriber});
- #}
- ##############
-
-
- $admin_div = '<hr width="100%">';
- }
-
- my $digest_setting;
- if($S->{UI}->{VARS}->{enable_story_digests}) {
- my $digest_select = $S->_digest_select($user);
- $digest_setting= qq|
- <P><B>Receive Email Story Digest:</B> $digest_select<BR>
- (Choose a value for how often to recieve the email digest)<BR>
- </P>|;
- }
-
- my ($subscription_info);
-
- $subscription_info = $S->sub_user_info($uid);
-
- my $allowedhtml = $S->html_checker->allowed_html_as_string('prefs');
- my $welcomemessage;
- my $oldpass;
- my $firstlogin = $S->{CGI}->param('firstlogin');
- if ($S->{UI}->{VARS}->{show_prefs_on_first_login} && $firstlogin) {
- my $sitename = $S->{UI}->{VARS}->{sitename};
- $oldpass = $S->{CGI}->param('pass');
- $welcomemessage=qq|
- <p><b>Welcome to $sitename!</b> As this is your first login, you may want to change some of the
- settings below, including your default password. None of these changes are required,
- however. Enjoy your stay.</p>
-
- <p>If you don't want to make changes, you can <a href="%%rootdir%%/">go to the front page</a>.</p>|
-
-
- }
-
- # If the user logs in for the first time, we store the old password
- # in a hidden field, otherwise we require him to enter it to change
- # protected preferences. As an added bonus, we hide the password for
- # admins who don't need it.
- my $accountpassword;
- if(!$oldpass && !$S->have_perm('edit_user')) {
- $accountpassword=qq|
- <B><font color="#ff0000">Protected settings</font></B><BR>
- <B>Password:</B><BR>
- You must enter your account password to change protected settings.<br>
- <INPUT TYPE="password" SIZE="30" NAME="verify_me"><P>|;
- } else {
- $accountpassword=qq|
- <INPUT TYPE="hidden" NAME="verify_me" VALUE="$oldpass">|;
- }
-
- # set default values to what the user entered (if we're re-displaying the
- # form because of error), or to what's in the DB
- my %defaults;
- foreach my $field (qw(fakeemail homepage bio sig publickey realemail)) {
- $defaults{$field} = defined($params->{$field}) ?
- $params->{$field} : $user->{$field};
- }
-
- # if this is their first login, we want to keep showing the message even if
- # there is an error
- my $form_firstlogin = '<input type="hidden" name="firstlogin" value="1">'
- if $firstlogin;
-
- my $form = qq|
- <TR>
- <TD>%%norm_font%%<FORM NAME="userdata" ACTION="%%rootdir%%/" METHOD="post">
- $formkey_element
- $form_firstlogin
- <INPUT TYPE="hidden" NAME="op" VALUE="user">
- <INPUT TYPE="hidden" NAME="tool" VALUE="prefs">
- <INPUT TYPE="hidden" NAME="uid" VALUE="$uid">
- <INPUT TYPE="hidden" NAME="oldemail" VALUE="$user->{realemail}">
- $welcomemessage
- $nickname
- $group
- $orig_email
- $creation_time
- $creation_ip
- $admin_notes
- $admin_div
- $subscription_info
- <B>Displayed Email:</B> <BR>
- This is the address that will be displayed in comments and in your user info.
- It will not be used to email forgotten passwords. You may want to add some kind
- of spam protection so that harvesters cannot parse it.<BR>
- <INPUT TYPE="text" SIZE="50" NAME="fakeemail" VALUE="$defaults{fakeemail}"><P>
- <B>Homepage:</B><BR>
- If you have a homepage, enter the address here and it will be added to your
- comments and user info. The full path is required: remember the "http://"!<BR>
- <INPUT TYPE="text" SIZE="50" NAME="homepage" VALUE="$defaults{homepage}"><P>
- The following three fields allow HTML entry.<BR> $allowedhtml
- <P>
- <B>Bio:</B><BR>
- Enter any kind of biographical information you want other users to see about yourself
- here.
- <BR>
- <TEXTAREA COLS=50 ROWS=5 WRAP="soft" NAME="bio">$defaults{bio}</TEXTAREA><P>
- <B>Signature:</B><BR>
- This will get attached to your comments. Sigs are typically used for quotations or links.<BR>
- <TEXTAREA COLS=50 ROWS=5 WRAP="soft" NAME="sig">$defaults{sig}</TEXTAREA><P>
- <B>Public Key:</B><BR>
- If you have a PGP/GPG public key (used for encrypting and signing email), paste it in here.<BR>
- <TEXTAREA COLS=50 ROWS=5 NAME="publickey">$defaults{publickey}</TEXTAREA><P>
- $digest_setting
- <P>
- $accountpassword
- <B>Real Email:</B><BR>
- This is the address that will be used to email forgotten passwords. It will not be shown. Please do not
- insert any kind of spam protection here, or you will not be able to get a new password!<BR>
- <INPUT TYPE="text" SIZE="50" NAME="realemail" VALUE="$defaults{realemail}"><P>
- <B>New Password:</B><BR>
- Leave both fields blank for no change. This is asked twice to detect typos.<BR>
- <table border="0" cellpadding="0" cellspacing="0">
- <TR><TD>%%norm_font%%New Password:</font></TD><TD>%%norm_font%%<INPUT TYPE="password" SIZE="30" NAME="pass1"></font></TD></TR>
- <TR><TD>%%norm_font%%New Password Again:</font></TD><TD>%%norm_font%%<INPUT TYPE="password" SIZE="30" NAME="pass2"></font></TD></TR>
- </table>
- <P>
- <INPUT TYPE="submit" NAME="write" VALUE="Save Preferences">
- </FORM>%%norm_font_end%%
- </TD>
- </TR>|;
-
- return $form;
- }
- #"
-
-
- sub _digest_select {
- my $S = shift;
- my $user = shift;
-
- my @choices = ("Never", "Daily", "Weekly", "Monthly");
- my $curr = $S->cgi->param('digest') || $user->{prefs}->{digest} || "Never";
-
- my $select = qq|
- <SELECT NAME="digest" SIZE=1>|;
- my $selected = '';
- foreach my $choice (@choices) {
- if ($choice eq $curr) {
- $selected = ' SELECTED';
- } else {
- $selected = '';
- }
- $select .= qq|
- <OPTION VALUE="$choice"$selected>$choice|;
- }
- $select .= qq|
- </SELECT>|;
-
- return $select;
- }
-
-
- sub _save_user_data {
- my $S = shift;
- my $uid = shift || $S->{UID};
- my $user = shift;
- my $safe = shift;
-
- $user = $S->user_data($uid);
-
- my %params = %{ $S->{CGI}->Vars_cloned() };
-
- if ($uid && $uid != $S->{UID} && !$S->have_perm('edit_user') && !$safe) {
- my $deny = qq|Permission Denied.|;
- return $deny;
- }
-
- unless($S->check_formkey()) {
-
- my $message=qq|
- Invalid form key. You probably tried to save your
- settings more than once. Do not hit "BACK"! If you
- are certain that your settings have not been saved,
- try to save them from this screen.
- |;
- return $message;
- }
-
- # check that the old password is correct.
- # get the username for input to check_password()
- my $user_name = $S->get_nick_from_uid($uid);
- if( $params{verify_me} && ($S->check_password( $user_name, $params{verify_me}) == 0) && !$safe) {
- # then the password they typed in is wrong. Return an error
- return "Your old password is incorrect";
- }
-
- if ( $params{pass1} ne $params{pass2}) {
- return "Passwords do not match!";
- } #elsif ( $params{pass1} ) {
- # the passwords match, and pass1 is not empty
- # make sure they entered an old password
- # if they didn't return with an error
- # if( ! $params{oldpass} ) {
- # return "You must enter your old password to change passwords."
- # }
- #}
-
- #crypt the password
- my $c_pass;
- if ($params{pass1}) {
- $c_pass = $S->crypt_pass($params{pass1});
- }
-
- my $update_nickname = 0;
- if ($S->have_perm('edit_user') && ($user_name ne $params{nickname})) {
- if ($S->get_uid_from_nick($params{nickname})) {
- return "The nickname $params{nickname} is already in use.";
- }
- $update_nickname = 1;
- }
-
- if ($params{realemail} ne $params{oldemail}) {
- if (my $dup_email_err = $S->check_email($params{realemail})) {
- return $dup_email_err;
- }
- }
-
- #filter stuff...
- $params{homepage} = $S->filter_subject($params{homepage});
- $params{fakeemail} = $S->filter_subject($params{fakeemail});
- $params{realemail} = $S->filter_subject($params{realemail});
-
- foreach my $i (qw(bio sig publickey)) {
- $params{$i} = $S->filter_comment($params{$i}, 'prefs');
- my $errors = $S->html_checker->errors_as_string;
- return $errors if $errors;
- }
-
- # We need to save this in unquoted form so we can check later
- # if the user has changed it.
- my $newmail=$params{realemail};
- my $max_sig_length = $S->{UI}->{VARS}->{max_sig_length};
- $max_sig_length = 160 unless ($max_sig_length);
- if (length($params{sig}) > $max_sig_length) {
- return "Your sig is too long. Maximum length is $max_sig_length characters";
- }
-
- $params{homepage} = $S->{DBH}->quote($params{homepage});
- $params{fakeemail} = $S->{DBH}->quote($params{fakeemail});
- $params{realemail} = $S->{DBH}->quote($params{realemail});
- $params{bio} = $S->{DBH}->quote($params{bio});
- $params{sig} = $S->{DBH}->quote($params{sig});
- $params{perm_group_id} = $S->{DBH}->quote($params{perm_group_id});
- $params{publickey} = $S->{DBH}->quote($params{publickey});
- $params{admin_notes} = $S->{DBH}->quote($params{admin_notes});
- $params{nickname} = $S->{DBH}->quote($params{nickname});
-
- my $set;
-
- if ($params{realemail}) {
- $set = qq|realemail = $params{realemail}, |;
- }
- if ($params{fakeemail}) {
- $set .= qq|fakeemail = $params{fakeemail}, |;
- }
- if ($params{homepage}) {
- $set .= qq|homepage = $params{homepage}, |;
- }
- if ($params{bio}) {
- $set .= qq|bio = $params{bio}, |;
- }
- if ($params{publickey}) {
- $set .= qq|publickey = $params{publickey}, |;
- }
- if ($params{sig}) {
- $set .= qq|sig = $params{sig}, |;
- }
- if ($c_pass) {
- my $q_pass = $S->dbh->quote($c_pass);
- $set .= qq|passwd = $q_pass, |;
- }
- if ($params{perm_group_id} && $S->have_perm('edit_groups')) {
- $set .= qq|perm_group = $params{perm_group_id}, |;
- }
- if ($params{admin_notes} && $S->have_perm('edit_user')) {
- $set .= qq|admin_notes = $params{admin_notes}, |;
- }
- if ($update_nickname) {
- $set .= qq|nickname = $params{nickname}, |;
- }
-
- $set =~ s/, $//;
-
- # Check to see if they will try to change protected settings.
- # If they do, make sure they entered a correct password.
- unless( ($params{verify_me} && ($S->check_password( $user_name, $params{verify_me}) > 0)) ||
- $S->have_perm('edit_user') ) {
-
-
- my $oldmail=$user->{realemail};
- if ( ($newmail ne $oldmail) || $params{pass1} || $params{pass2} ) {
- return "You must enter your password to change protected account settings";
- }
- }
-
-
- my ($rv, $sth);
- my ($oldsig, $newsig);
-
- if ($params{sig}) {
- #warn "Getting old sig\n";
- ($rv, $sth) = $S->db_select({
- DEBUG => 0,
- WHAT => 'sig',
- FROM => 'users',
- WHERE => qq|uid = $uid|});
- $oldsig = $sth->fetchrow;
- $sth->finish;
- }
-
- ($rv, $sth) = $S->db_update({
- DEBUG => 0,
- WHAT => 'users',
- SET => $set,
- WHERE => qq|uid = $uid|});
-
- unless ($rv) {
- my $err = $S->{DBH}->errstr;
- return $err;
- }
- $sth->finish;
-
- if ($params{sig}) {
- #warn "Checking new sig\n";
- ($rv, $sth) = $S->db_select({
- DEBUG => 0,
- WHAT => 'sig',
- FROM => 'users',
- WHERE => qq|uid = $uid|});
- $newsig = $sth->fetchrow;
- $sth->finish;
- $newsig = $S->{DBH}->quote($newsig);
- $oldsig = $S->{DBH}->quote($oldsig);
- #warn "Saved sig : $newsig\n";
- #warn "Submitted sig : $params{sig}\n";
- if ($newsig ne $params{sig}) {
- ($rv, $sth) = $S->db_update({
- DEBUG => 0,
- WHAT => 'users',
- SET => qq|sig = $oldsig|,
- WHERE => qq|uid = $uid|});
- $params{sig} = $oldsig;
- $S->{CGI}->{params}{sig} = $oldsig;
- $sth->finish if ($rv);
- }
- }
-
- # if the user's nickname is changed, then we also need to update some other
- # tables to reflect the new nickname
- if ($update_nickname) {
- my $old_nick = $S->{DBH}->quote($user_name);
-
- # update the rdf_channels table
- ($rv, $sth) = $S->db_update({
- WHAT => 'rdf_channels',
- SET => "submittor = $params{nickname}",
- WHERE => "submittor = $old_nick"
- });
- $sth->finish;
- }
-
- if ($params{subscribe_add} && $S->have_perm('edit_user')) {
- warn "Subscription expires $user->{prefs}->{subscription_expire}\n";
-
- my $new_expire = $S->add_to_subscription($user, $params{subscribe_add});
- my $updated = "$S->{NICK}, ".gmtime(time)." GMT";
-
- ($rv, $sth) = $S->db_delete({
- FROM => 'userprefs',
- WHERE => "uid = $uid AND (prefname = 'subscriber' OR prefname = 'subscription_expire' OR prefname = 'subscribe_last_update')"
- });
-
- ($rv,$sth)=$S->db_insert({
- INTO => 'userprefs',
- COLS => qq|uid,prefname,prefvalue|,
- VALUES => qq|$uid,'subscription_expire',"$new_expire"|
- });
-
- unless($rv) {
- my $err=$S->{DBH}->errstr;
- return $err;
- }
- $sth->finish;
-
- ($rv,$sth)=$S->db_insert({
- INTO => 'userprefs',
- COLS => qq|uid,prefname,prefvalue|,
- VALUES => qq|$uid,'subscriber',1|
- });
-
- unless($rv) {
- my $err=$S->{DBH}->errstr;
- return $err;
- }
- $sth->finish;
-
- ($rv,$sth)=$S->db_insert({
- INTO => 'userprefs',
- COLS => qq|uid,prefname,prefvalue|,
- VALUES => qq|$uid,'subscribe_last_update',"$updated"|
- });
-
- unless($rv) {
- my $err=$S->{DBH}->errstr;
- return $err;
- }
- $sth->finish;
- }
-
-
- ($rv,$sth)=$S->db_delete( {
- FROM => 'userprefs',
- WHERE => qq|uid=$uid and prefname='showad'|
- });
-
- if ($params{'showad'} eq 'Yes') {
- ($rv,$sth)=$S->db_insert({
- INTO => 'userprefs',
- COLS => qq|uid,prefname,prefvalue|,
- VALUES => qq|$uid,'showad','Yes'|
- });
- unless ($rv) {
- my $err=$S->{DBH}->errstr;
- return $err;
- }
- }
-
- # Added by Srijith 06/02/2001
- ($rv,$sth)=$S->db_delete( {
- FROM => 'userprefs',
- WHERE => qq|uid=$uid and prefname ='digest'|
- });
-
- unless ($rv) {
- my $err=$S->{DBH}->errstr;
- return $err;
- }
- unless($params{digest} eq 'Never' || $params{digest} eq '' ) {
-
- ($rv,$sth)=$S->db_insert({
- INTO => 'userprefs',
- COLS => qq|uid,prefname,prefvalue|,
- VALUES => qq|$uid,'digest','$params{digest}'|
- });
-
- unless($rv) {
- my $err=$S->{DBH}->errstr;
- return $err;
- }
- $sth->finish;
- }
- # Addition Over
-
- $S->_refresh_group_perms();
- #Load new values from 'userprefs' table
- $S->_set_prefs();
-
- # Drop user from cache for updating
- delete $S->{USER_DATA_CACHE}->{$uid};
-
- return "User Updated";
- }
-
sub add_to_subscription {
my $S = shift;
--- 180,183 ----
***************
*** 1008,1012 ****
}
} else {
! return $S->{prefs}->{$key};
}
--- 284,288 ----
}
} else {
! return defined($S->{prefs}->{$key}) ? $S->{prefs}->{$key} : $S->{PREF_ITEMS}->{$key}->{default_value};
}