# ==================================================================
# Gossamer Forum - Advanced web community
#
#   Website  : http://gossamer-threads.com/
#   Support  : http://gossamer-threads.com/scripts/support/
#   Revision : $Id: User.pm,v 1.91.2.10 2003/07/04 20:33:56 jagerman Exp $
# 
# Copyright (c) 2003 Gossamer Threads Inc.  All Rights Reserved.
# Redistribution in part or in whole strictly prohibited. Please
# see LICENSE file for full details.
# ==================================================================
#

package GForum::User;

use strict;
use GForum qw/:user :forum $DB $IN $CFG $USER $SESSION $SESSION_TYPE/;
use GForum::Authenticate;
use GT::Date;
use GT::AutoLoader;

$COMPILE{signup} = __LINE__ . <<'END_OF_SUB';
sub signup {
    shift;
    my ($do, $func, @errors) = @_;
    @errors = map { { error => scalar GForum::language($_) } } @errors;
    my $page = $func->{page}->{user_signup};
    my %user_data;
    my $User = $DB->table('User');
    for ($IN->param) {
        next unless exists $User->{schema}->{cols}->{$_} or $_ eq 'signup_amount';
        $user_data{$_} = $IN->param($_);
    }
    $user_data{user_username} ||= '';
    $user_data{user_password} ||= '';
    $user_data{user_email}    ||= '';
    $user_data{signup_amount} = ''
        if not defined $user_data{signup_amount} or $user_data{signup_amount} !~ /^\d+(?:\.\d+)?$/
        or not exists $CFG->{payment}->{signup}->{levels}->{$user_data{signup_amount}};

    require GForum::Payment;
    my $payment = GForum::Payment::get_signup_config();
    my $payment_methods = GForum::Payment::methods();
    return(
        $page => {
            email_validation_required => !$CFG->{require_signup_email_validation},
            admin_validation_required => !$CFG->{require_signup_admin_validation},
            %user_data,
            @errors ? (errors => \@errors) : (),
            %$payment,
            %$payment_methods
        }
    );
}
END_OF_SUB

$COMPILE{login} = __LINE__ . <<'END_OF_SUB';
sub login {
    shift; # Discard the package
    my ($do, $func) = splice @_, 0, 2;
    my $tags = ref $_[0] eq 'HASH' ? shift : {};
    my $url;
    if ($ENV{HTTPS} and $ENV{HTTPS} eq 'on') {
        $url = $CFG->{cgi_root_url_https};
        if ($url !~ /\S/) {
            $url = $CFG->{cgi_root_url};
            $url =~ s|^(?:\w+://)?|https://|;
        }
    }
    else {
        $url = $CFG->{cgi_root_url};
    }
    $url .= "/" . $IN->url();

    $url =~ s/(?:[;&]?(?:login_(?:username|password|attempt)|url|session|guest|username)=[^&;]*|\b(?:login_(?:username|password|attempt)|url|session|guest|username)=[^&]*)//g;
    $url =~ s/\bdo=log(?:in|out)\b//g;
    $url =~ s/\?/?login_attempt=1&/ or $url .= "?login_attempt=1";

    $tags->{url} = $url;
    $tags->{user_username} = $IN->param('username') || $IN->param('login_username');

    delete @GForum::HIDDEN{qw/login_username login_password session/};
    return(
        $CFG->{functions}->{login}->{page}->{login},
        $tags
    );
}
END_OF_SUB

$COMPILE{logout} = __LINE__ . <<'END_OF_SUB';
sub logout {
    shift; # Discard the package
    my ($do, $func) = @_;
    $SESSION or return GForum::do_func('login');

    my $header = '';
    my $remember = $IN->cookie($CFG->{cookie_prefix} . 'remember');
    if ($SESSION_TYPE eq 'remember' or $SESSION_TYPE eq 'cookie') {
        if ($SESSION_TYPE eq 'remember') {
            my $r = $IN->cookie(-name => $CFG->{cookie_prefix} . 'remember', -value => 0, -path => $CFG->{cookie_path}, -expires => "-1y")->cookie_header() . "\n";
            if ($CFG->{cookie_domain}) {
                $r .= $IN->cookie(-name => $CFG->{cookie_prefix} . 'remember', -value => 0, -path => $CFG->{cookie_path}, -expires => "-1y", -domain => $CFG->{cookie_domain})->cookie_header() . "\n";
            }            
            $header .= $r;
            $DB->table('Remember')->delete($remember);
        }
        my $s = $IN->cookie(-name => $CFG->{cookie_prefix} . 'session', -value => 0, -path => $CFG->{cookie_path}, -expires => "-1y")->cookie_header() . "\n";
        if ($CFG->{cookie_domain}) {
           $s .= $IN->cookie(-name => $CFG->{cookie_prefix} . 'session', -value => 0, -path => $CFG->{cookie_path}, -expires => "-1y", -domain => $CFG->{cookie_domain})->cookie_header() . "\n";
        }
        $header .= $s;
    }

    if ($SESSION) {
        $DB->table('Session')->delete($SESSION->{info}->{session_id});
    }
    print $header if $header; # Expire cookies
    $USER = $SESSION = undef;
    GForum::do_func('login');
}
END_OF_SUB

$COMPILE{icons} = __LINE__ . <<'END_OF_SUB';
sub icons {
    my $ret = [];
    push @$ret, {} if shift;
    require GT::Image::Size;
    if ($USER and $USER->{user_icon} and $USER->{user_icon} =~ m|^users/|) {
        my $dim = icon_dimensions($USER->{user_icon});
        push @$ret, { icon_name => scalar GForum::language('USER_ICON_CURRENT'), icon_filename => $USER->{user_icon}, icon_width => $dim->{icon_width}, icon_height => $dim->{icon_height} };
    }
    for (keys %{$CFG->{user_icons}}) {
        my $dim = icon_dimensions($CFG->{user_icons}->{$_});
        push @$ret, { icon_name => $_, icon_filename => $CFG->{user_icons}->{$_}, icon_width => $dim->{icon_width}, icon_height => $dim->{icon_height} };
    }
    push @$ret, {} if shift;
    return { icons => $ret }
}
END_OF_SUB

$COMPILE{icon_dimensions} = __LINE__ . <<'END_OF_SUB';
sub icon_dimensions {
    my $filename = shift;
    $filename = "$CFG->{image_path}/$filename";
    require GT::Image::Size;
    my ($w, $h) = GT::Image::Size::imgsize($filename);
    $w ||= 0;
    $h ||= 0;
    my $ratio;
    if ($w > $CFG->{user_icon_max_width}) {
        $ratio = $CFG->{user_icon_max_width} / $w;
    }
    if ($h > $CFG->{user_icon_max_height}) {
        my $r = $CFG->{user_icon_max_height} / $h;
        $ratio = $r if not defined $ratio or $r < $ratio;
    }
    if ($ratio) {
        $h *= $ratio;
        $w *= $ratio;
    }

    return { icon_width => $w, icon_height => $h };
}
END_OF_SUB

$COMPILE{icon_add} = __LINE__ . <<'END_OF_SUB';
sub icon_add {
    my ($icon_name, $icon_filename) = @_;
    if (exists $CFG->{user_icons}->{$icon_name}) {
        return { add_success => 0, reason => "An icon with that name already exists" }
    }
    $CFG->{user_icons}->{$icon_name} = $icon_filename;
    $CFG->save();
    return { add_success => 1 }
}
END_OF_SUB

$COMPILE{icon_delete} = __LINE__ . <<'END_OF_SUB';
sub icon_delete {
    my $icon_name = shift;
    if (not exists $CFG->{user_icons}->{$icon_name}) {
        return { delete_sucess => 0, reason => "No such icon" }
    }
    delete $CFG->{user_icons}->{$icon_name};
    $CFG->save();
    return { delete_success => 1 }
}
END_OF_SUB

# Saves changes to a profile. Reads input from $IN->param
$COMPILE{profile} = __LINE__ . <<'END_OF_SUB';
sub profile {
    shift;
    my ($do, $func) = @_;
    my $page = $func->{page};
    $USER or return do_func('login');
    my $User = $DB->table('User');
    my @errors;
    my $update;
    my %skip;
    for ($IN->param) {
        next if $skip{$_};
        next unless exists $User->{schema}->{cols}->{$_} or substr($_, -7) eq '_upload' and exists $User->{schema}->{cols}->{substr($_, 0, -7)};
        my @value = $IN->param($_);
        my $value = $value[0];
        if ($_ eq 'user_id') {
            next;
        }
        elsif ($_ eq 'user_password') {
            if (@value > 1) { # The templates can have two password fields (to verify the password) or just a single field
                if (not length $value[0] and not length $value[1]) {
                    next; # No password entered
                }
                elsif ($value[0] ne $value[1]) {
                    push @errors, GForum::language('PROFILE_PASSWORDS_DONT_MATCH');
                    next;
                }
            }
            elsif (not length $value) {
                next; # A single password field, with no password entered
            }
            unless (GForum::Authenticate::auth('change_pass', $value)) {
                push @errors, $GForum::Authenticate::Auth_Error;
                next;
            }
        }
        elsif ($_ eq 'user_username') {
            if (lc $USER->{user_username} eq lc $value) {
                next;
            }
            elsif (not GForum::Authenticate::auth('change_username', $value)) {
                push @errors, $GForum::Authenticate::Auth_Error;
                next;
            }
        }
        elsif (/^(user_icon\w*)_upload$/ and not $IN->param($1) and exists $User->{schema}->{cols}->{$1} and $CFG->{"user_icon_allow_upload"}) {
            next unless fileno($value);
            binmode($value);
            my $column = $1;
            my $max_size = $CFG->{"user_icon_max_size"};
            if (-s $value > $max_size) {
                require GForum::Attachment;
                push @errors, GForum::language(USER_ICON_TOO_LARGE => GForum::Attachment::friendly_size($max_size));
                next;
            }
            my ($ext) = $value =~ m{\.([^\\/.]+)$};
            next unless $ext;
            $ext = lc $ext;
            my $allowed;
            for (@{$CFG->{"user_icon_image_types"}}) {
                if ($ext eq lc) {
                    $allowed = 1;
                    last;
                }
            }

            if (!$allowed) {
                push @errors, GForum::language(USER_ICON_BAD_TYPE => uc($ext), uc join ", ", @{$CFG->{"user_icon_image_types"}});
                next;
            }

            my $written;
# If the user icon extension is changing (eg. was GIF, now JPG), delete the old icon
            if ($USER->{$column} and $USER->{$column} =~ m|^users/$USER->{user_id}-$column\.(?!\Q$ext\E)|) {
                unlink "$CFG->{image_path}/$USER->{$column}";
            }
            my $icon_filename = "$CFG->{image_path}/users/$USER->{user_id}-$column.$ext";
            my $icon = \do { local *ICON; *ICON };
            if (open $icon, ">$icon_filename") {
                $written = 1;
                binmode $icon;
                while (my $read = read($value, my $buffer, 4096)) {
                    unless (print $icon $buffer) {
                        unlink $icon_filename;
                        $written = 0;
                        last;
                    }
                }
                if ($written) {
                    $update->{$column} = "users/$USER->{user_id}-$column.$ext";
                    $skip{$column}++; # The upload overrides the user_icon parameter
                    chmod(0666, $icon_filename);
                }
            }
            if (!$written) {
                push @errors, GForum::language(USER_ICON_SYSTEM_ERROR => "$!");
            }
            next;
        }
        elsif (/^user_icon\w*$/) {
            $value = undef if $value =~ m{^(?:[a-zA-Z]:)?[/\\]} or $value =~ /\.\./;
        }
        next if substr($_, -7) eq '_upload' and exists $User->{schema}->{cols}->{substr($_, 0, -7)};
        my $regex = join "|", map quotemeta, @{$CFG->{user_private_fields}}, qw/user_enabled user_registered user_status user_val_code user_admin_validated user_title user_payment_expiry user_payment_donations/;
        next if /^$regex$/; # Skips fields such as "user_status", which definitely should not be changed

        if (my $regex = $User->{schema}->{cols}->{$_}->{regex}) {
            $value =~ /$regex/ or push(@errors, GForum::language(PROFILE_INVALID_DATA => $User->{schema}->{cols}->{$_}->{form_display} || $_)), next;
        }
        $value = undef if $_ eq 'user_homepage' and $value =~ m|^\s*http://\s*$|;
        $value = undef if not $User->{schema}->{cols}->{$_}->{not_null} and not $value;
        $update->{$_} = $value;
    }
    $User->update($update, { user_id => $USER->{user_id} }) or push @errors, $GT::SQL::error;
    $USER = $User->get($USER->{user_id});
    if (@errors) {
        $GForum::Template::VARS{errors} = [map +{ error => $_ }, @errors];
        return GForum::do_func($IN->param('on_error'));
    }
    $GForum::Template::VARS{changes_saved} = 1;
    GForum::do_func($IN->param('on_success'));
}
END_OF_SUB

$COMPILE{profile_email_page} = __LINE__ . <<'END_OF_SUB';
sub profile_email_page {
    shift;
    my ($do, $func) = @_;
    my $page = $func->{page};

    my %subscribed = map { $_ => 1 } $DB->table('ForumSubscriber')->select(forum_id_fk => { user_id_fk => $USER->{user_id} })->fetchall_list;

    require GForum::Forum;
    my $everything = GForum::Forum::tpl_list('all_user')->{tpl_list};
    for (@$everything) {
        $_->{forum_subscribed} = 1 if $_->{forum_id} and $subscribed{$_->{forum_id}};
    }

    return(
        $page->{forum_list} => {
            everything => $everything,
            %$USER
        }
    );
}
END_OF_SUB

# This looks for subscriptions selected and handles subscriptions.
$COMPILE{profile_email} = __LINE__ . <<'END_OF_SUB';
sub profile_email {
    shift;
    my ($do, $func) = @_;
    my @subscriptions = $IN->param('subscribe');
    ref $subscriptions[0] and @subscriptions = @{$subscriptions[0]};
    my %subscribed = map { ($_->[0] => 1) } @{$DB->table('ForumSubscriber')->select(forum_id_fk => { user_id_fk => $USER->{user_id} })->fetchall_arrayref};
    my %subscribe = map { ($_ => 1) } @subscriptions;
    my @forums = map $_->[0], @{$DB->table('Forum')->select('forum_id')->fetchall_arrayref};
    require GForum::Authenticate;
    for my $forum_id (@forums) {
        if (GForum::Authenticate::auth('forum_permission', $forum_id) >= FORUM_PERM_READ and $subscribe{$forum_id}) {
            unless ($subscribed{$forum_id}) {
                $DB->table('ForumSubscriber')->insert({ forum_id_fk => $forum_id, user_id_fk => $USER->{user_id}, subsc_time => time, subsc_last => undef });
            }
        }
        elsif ($subscribed{$forum_id}) {
            $DB->table('ForumSubscriber')->delete({ forum_id_fk => $forum_id, user_id_fk => $USER->{user_id} });
        }
    }
    $GForum::Template::VARS{changes_saved} = 1;
    GForum::do_func($IN->param('next_do'));
}
END_OF_SUB

$COMPILE{profile_threads_page} = __LINE__ . <<'END_OF_SUB';
sub profile_threads_page {
    shift;
    my ($do, $func) = @_;
    my $page = $func->{page};

    my $rel = $DB->table('ThreadWatch' => 'Post' => 'Forum' => 'Category');
    my $sth = $rel->select({ $rel->{connect}->{PREFIX} . "ThreadWatch.user_id_fk" => $USER->{user_id} });

    my @threads;
    while (my $thread = $sth->fetchrow_hashref) {
        push @threads, $thread;
    }
    my %users;
    $sth = $DB->table('User')->select({ user_id => [map { $_->{user_id_fk} || () } @threads]});
    while (my $user = $sth->fetchrow_hashref) {
        $users{$user->{user_id}} = $user;
    }
    require GForum::Forum;
    require GForum::Post;
    for my $t (@threads) {
        if ($t->{user_id_fk} and exists $users{$t->{user_id_fk}}) {
            @$t{keys %{$users{$t->{user_id_fk}}}} = values %{$users{$t->{user_id_fk}}};
        }
    }
    GForum::Forum::normalize(\@threads);
    GForum::Post::normalize(\@threads);

    my $forum_order = GForum::Forum::tpl_list('all_user')->{tpl_list}; # Uhg, all this just to get the proper forum order.
    my %order;
    my $i;
    for (@$forum_order) {
        next unless $_->{forum_id};
        $order{$_->{forum_id}} = $i++;
    }
    @threads = sort { $order{$a->{forum_id}} <=> $order{$b->{forum_id}} } @threads;

    return($page->{thread_list} => { threads => \@threads, watched_threads => scalar @threads });
}
END_OF_SUB

# This handles unsubscribing from threads (when you stop watching a thread).
$COMPILE{profile_threads} = __LINE__ . <<'END_OF_SUB';
sub profile_threads {
    shift;
    my ($do, $func) = @_;
    my @stop_watching = $IN->param('stop_watching');
    ref $stop_watching[0] and @stop_watching = @{$stop_watching[0]};

    $DB->table('ThreadWatch')->delete({ user_id_fk => $USER->{user_id}, thread_id_fk => \@stop_watching })
        if @stop_watching;

    $GForum::Template::VARS{changes_saved} = 1;
    GForum::do_func($IN->param('next_do'));
}
END_OF_SUB

$COMPILE{signup_submit} = __LINE__ . <<'END_OF_SUB';
sub signup_submit {
    shift;
    my ($do, $func) = @_;
    my $page = $func->{page};
    my $input = $IN->get_hash;
    if (length $input->{user_username}
        and GForum::Authenticate::auth('valid_username', $input->{user_username})
        and (ref $input->{user_password}
            ? (length $input->{user_password}->[0] and $input->{user_password}->[0] eq $input->{user_password}->[1])
            : (length $input->{user_password})
        )
        and $input->{user_email} and $input->{user_email} =~ /.@(?:[a-zA-Z0-9][a-zA-Z0-9-]*\.)+[a-zA-Z0-9][a-zA-Z0-9-]*$/
        and (!$CFG->{payment}->{signup}->{enabled}
            or $CFG->{require_signup_email_validation}
            or defined $input->{signup_amount}
                and $input->{signup_amount} =~ /^\d+(?:\.\d+)?$/
                and exists $CFG->{payment}->{signup}->{levels}->{$input->{signup_amount}})
    ) {
        my $ut = $DB->table('User');

        my $regex = join "|", map quotemeta, @{$CFG->{user_private_fields}}, qw/user_username user_password user_temp_pass user_password user_enabled user_registered user_status user_val_code user_admin_validated user_title user_payment_expiry user_payment_donations/;
        my @keys = grep +(exists $ut->{schema}->{cols}->{$_} and not /^$regex$/), keys %$input;
        $ut->count(user_username => $input->{user_username})
            and return GForum::do_func(user_signup => GForum::language(USERNAME_EXISTS => $input->{user_username}));

        if (!$CFG->{signup_allow_duplicate_email}) {
            my $username = $ut->select(user_username => { user_email => $input->{user_email} })->fetchrow;
            if (defined $username) {
                return GForum::do_func(user_signup => GForum::language(SIGNUP_EMAIL_EXISTS => $input->{user_email}, $username));
            }
        }

        if ($CFG->{banned_email} and @{$CFG->{banned_email}}) {
            my %ch = ('\*' => '.*', '\?' => '.', '\+' => '.+');
            my $regex = join '|', map { (my $e = quotemeta) =~ s/(\\[*+?])/$ch{$1}/g; $e } @{$CFG->{banned_email}};
            if ($input->{user_email} =~ /^(?:$regex)$/) {
                return GForum::do_func(user_signup => GForum::language(SIGNUP_EMAIL_BANNED => $input->{user_email}));
            }
        }

        my $status = ($CFG->{require_signup_email_validation} or $CFG->{require_signup_admin_validation}) ? NOT_VALIDATED : REGISTERED;
        my $val_code = join '', ('a'..'z', 'A'..'Z', 0..9)[map rand(62), 1 .. $ut->{schema}->{cols}->{user_val_code}->{size}];
        if (!$CFG->{require_signup_email_validation}) {
            $val_code = '';
        }
        my $user_id = ($ut->insert({
            user_username          => $input->{user_username},
            user_password          => (ref($input->{user_password}) ? ($input->{user_password}->[0]) : ($input->{user_password})),
            user_email             => $input->{user_email},
            user_enabled           => 1,
            user_payment_expiry    => ($CFG->{payment}->{signup}->{enabled} ? -1 : 0),
            user_payment_donations => 0,
            user_registered        => time,
            user_status            => $status,
            user_val_code          => $val_code,
            user_admin_validated   => ($CFG->{require_signup_admin_validation} ? 0 : 1),
            map {( $_ => $input->{$_} )} @keys
        }) or die $GT::SQL::error)->insert_id;

        my $user = $ut->get($user_id);

        $val_code = "${user_id}GT$val_code";

        if ($CFG->{require_signup_email_validation}) {
            if (my $error = send_validation_email({ %$user, validate_code => $val_code })) {
                $ut->delete($user_id);
                return GForum::do_func(user_signup => GForum::language(SIGNUP_EMAIL_VALIDATION_FAILED => $error));
            }
        }

# The account will not become activated until an appropriate payment is made.
# However, payments are not accepted until the e-mail validation has succeeded.
        if ($CFG->{payment}->{signup}->{enabled} and not $CFG->{require_signup_email_validation}) {
            return GForum::do_func('payment_initial');
        }

        return($page->{success} => $user);
    }
    else {
        my @errors;
        if ($GForum::Authenticate::Auth_Error) {
            push @errors, $GForum::Authenticate::Auth_Error;
            $IN->delete('user_username');
        }
        if (not length $input->{user_username}) {
            push @errors, 'SIGNUP_NO_USERNAME';
        }
        if (ref $input->{user_password}) { # The templates can have two password fields (to verify the password)
            if (not length $input->{user_password}->[0] and not length $input->{user_password}->[1]) {
                push @errors, 'SIGNUP_NO_PASSWORD';
            }
            elsif ($input->{user_password}->[0] ne $input->{user_password}->[1]) {
                push @errors, 'SIGNUP_PASSWORDS_DONT_MATCH';
                $IN->delete('user_password');
            }
        }
        elsif (not length $input->{user_password}) { # Or just one password field
            push @errors, 'SIGNUP_NO_PASSWORD';
        }
        unless ($input->{user_password}) {
            push @errors, 'SIGNUP_NO_PASSWORD';
            $IN->delete('user_password');
        }
        unless ($input->{user_email} and $input->{user_email} =~ /\S@(?:[a-zA-Z0-9][a-zA-Z0-9-]*\.)+[a-zA-Z0-9][a-zA-Z0-9-]*$/) {
            push @errors, 'SIGNUP_NO_EMAIL';
            $IN->delete('user_email');
        }
        if ($CFG->{payment}->{signup}->{enabled} and not $CFG->{require_signup_email_validation}) {
            unless (defined $input->{signup_amount}) {
                push @errors, 'SIGNUP_NO_PAYMENT';
                $IN->delete('signup_amount');
            }
            elsif ($input->{signup_amount} !~ /^\d+(?:\.\d+)?$/
                or not exists $CFG->{payment}->{signup}->{levels}->{$input->{signup_amount}}) {
                push @errors, 'SIGNUP_INVALID_PAYMENT';
            }
        }
        return GForum::do_func(user_signup => @errors);
    }
}
END_OF_SUB

$COMPILE{lost_password} = __LINE__ . <<'END_OF_SUB';
sub lost_password {
    shift;
    my ($do, $func) = @_;
    my $page = $func->{page};
    my $username = $IN->param('user_username');
    my $user;
    if ($username) {
        my $User = $DB->table('User');
        if ($user = $User->select({ user_username => $username })->fetchrow_hashref) {
            my $temp_pass = random_password();
            $User->update({ user_temp_pass => $temp_pass }, { user_id => $user->{user_id} });
            if (my $error = send_temp_pass_email($user, $temp_pass)) {
                die $error;
            }
        }
        else {
            return($page->{invalid_username} => { error => GForum::language('USER_INVALID_USERNAME', $username) });
        }
    }
    else {
        return($page->{enter_username});
    }
    return($page->{success}, $user);
}
END_OF_SUB

$COMPILE{resend_validation} = __LINE__ . <<'END_OF_SUB';
sub resend_validation {
    shift;
    my ($do, $func) = @_;
    my $page = $func->{page};
    my $username = $IN->param('user_username');
    my $user;
    if ($username) {
        if ($user = $DB->table('User')->select({ user_username => $username })->fetchrow_hashref) {
            normalize($user);
            my $val_code = $user->{user_val_code};
            if (!$val_code) {
                return($page->{already_validated} => { %$user, error => GForum::language('VALIDATE_ALREADY_VALIDATED') });
            }
            $val_code = "$user->{user_id}GT$val_code";
            if (my $error = send_validation_email({ %$user, validate_code => $val_code })) {
                die $error;
            }
        }
        else {
            return($page->{invalid_username} => { error => GForum::language('USER_INVALID_USERNAME', $username) });
        }
    }
    else {
        return($page->{enter_username});
    }
    return($page->{success} => $user);
}
END_OF_SUB

# Generates a random password. Takes two optional arguments.
# With one argument, the argument is the length of the password.
# With two arguments, the first argument is the minimum length of the password and the
# second is the maximum length (a random length will be selected).
# The default behaviour is to return a password of length 5 to 8.
# The password will be made up alphanumeric characters of either case, however capital
# O (the letter) and 0 (zero) are omitted due to possible confusion. Lower-case o's
# will still be present. (a-z, A-N, P-Z, 1-9)
$COMPILE{random_password} = __LINE__ . <<'END_OF_SUB';
sub random_password {
    my ($min_length, $max_length);
    if (@_ == 1) {
        $min_length = $max_length = shift;
        if ($min_length < 1) {
            $min_length = 5;
            $max_length = 8;
        }
    }
    elsif (@_) {
        ($min_length, $max_length) = @_;
        if ($min_length < 1 or $max_length < 1) { # No clue what you were trying to do here...
            $min_length = 5;
            $max_length = 8;
        }
        elsif ($max_length < $min_length) { # Assume the arguments are bass ackwards
            ($max_length, $min_length) = ($min_length, $max_length);
        }
    }
    else {
        $min_length = 5;
        $max_length = 8;
    }
    my $length = $min_length + int rand($max_length - $min_length + 1);
    # Make a random password, but leave out confusing characters: 0 and upper case O, 1 and lower case l
    join '', map +('a'..'k', 'm'..'z', 'A'..'N', 'P'..'Z', 2..9, '(', ')', '_', '-', ',', '.')[rand 64], 1 .. $length;
}
END_OF_SUB

# Returns an error message on error, 0 on success.
$COMPILE{_send_email} = __LINE__ . <<'END_OF_SUB';
sub _send_email {
    my ($template, $vars) = @_;
    require GT::Mail::Editor;
    require GT::Mail;
    my $email = GT::Mail::Editor->new(dir => "$CFG->{admin_root_path}/templates", template => ($vars->{user_template} || $CFG->{default_template_set}));
    my $template_set = $GForum::TEMPLATE_SET;
    if (!$template_set or $template_set eq 'admin') {
        $template_set = $vars->{user_template} || $CFG->{default_template_set};
    }
    local $GForum::TEMPLATE_SET = $template_set;
    $email->load($template);
    my $headers = $email->headers;
    my %head;
    while (my ($k, $v) = each %$headers) {
        my $val = $v; # Copy it
        $val = GForum::Template->parse("string", $vars, { string => $val });
        $head{$k} = $val;
    }
    $head{To}   ||= $vars->{user_email};
    $head{From} ||= $CFG->{admin_email};
    my $body = $email->body;
    $body = GForum::Template->parse("string", $vars, { string => $body });
    $CFG->{smtp_server} or $CFG->{mail_path} or die 'No mail path or SMTP server set!';
    my $mailer = GT::Mail->new(
        %head,
        msg  => $body,
        ($CFG->{smtp_server} ? (smtp => $CFG->{smtp_server}) : (sendmail => $CFG->{mail_path}))
    );
    local $@;
    my $sent = eval { $mailer->send };
    if (!$sent or $@) {
        return "Unable to send mail: " . ($@ || $mailer->error);
    }
    0;
}
END_OF_SUB

$COMPILE{send_temp_pass_email} = __LINE__ . <<'END_OF_SUB';
sub send_temp_pass_email {
    my ($user, $temp_pass) = @_;
    $user->{user_temp_pass} = $temp_pass;
    _send_email("temp_pass.eml", $user);
}
END_OF_SUB

$COMPILE{send_validation_email} = __LINE__ . <<'END_OF_SUB';
sub send_validation_email {
    my $user = shift;
    _send_email("validation.eml", $user);
}
END_OF_SUB

$COMPILE{send_admin_validation_email} = __LINE__ . <<'END_OF_SUB';
sub send_admin_validation_email {
    my $user = shift;
    _send_email("admin_validation.eml", $user);
}
END_OF_SUB

$COMPILE{admin_validate} = __LINE__ . <<'END_OF_SUB';
sub admin_validate {
    my $ut = $DB->table('User');
    $ut->select_options('ORDER BY user_username ASC');
    my $users = $ut->select({ user_admin_validated => 0 })->fetchall_hashref;

    normalize($users) if @$users;

    my $cond = GT::SQL::Condition->new(user_admin_validated => '=' => 1, user_val_code => '!=' => '');
    my $awaiting_email_users = $ut->select($cond)->fetchall_hashref;

    normalize($awaiting_email_users) if @$awaiting_email_users;

    return {
        users => $users,
        num_users => scalar @$users,
        awaiting_email_users => $awaiting_email_users,
        num_awaiting_email_users => scalar @$awaiting_email_users
    };
}
END_OF_SUB

$COMPILE{admin_validate_submit} = __LINE__ . <<'END_OF_SUB';
sub admin_validate_submit {
    my $ut = $DB->table('User');
    my $cond = GT::SQL::Condition->new(user_admin_validated => '=' => 0, user_val_code => '!=' => '');
    $cond->bool('OR');
    my $sth = $ut->select($cond);
    my $del_count = 0;
    my $val_count = 0;
    while (my $user = $sth->fetchrow_hashref) {
        my $action = $IN->param("$user->{user_id}") || 'nothing';
        next if $action eq 'nothing';
        my $user_id = $user->{user_id};
        if (lc($action) eq 'validate') {
            $val_count++;
            my $update = { user_admin_validated => 1 };
            $update->{user_status} = REGISTERED if not $user->{user_val_code};
            $ut->update($update, { user_id => $user_id });
            # Only send validation emails if they have already done their email validation.
            if (not $user->{user_val_code}) {
                normalize($user);
                send_admin_validation_email($user);
            }
        }
        elsif (lc($action) eq 'validate_email') {
            $val_count++;
            $ut->update({ user_val_code => '', user_status => REGISTERED }, { user_id => $user_id });
        }
        elsif (lc($action) eq 'delete') {
            $del_count++;
            $ut->delete({ user_id => $user_id });
        }
    }
    return {
        delete_count => " $del_count",
        validate_count => " $val_count"
    };
}
END_OF_SUB

$COMPILE{validate} = __LINE__ . <<'END_OF_SUB';
sub validate {
    shift;
    my ($do, $func) = @_;
    my $page = $func->{page};
    my $ut = $DB->table('User');
    my $validate_code = $IN->param('validate')
        or return($page->{no_code}, { error => GForum::language('VALIDATE_NO_CODE') });
    $validate_code =~ s/^(\d+)GT//
        or return($page->{bad_code}, { error => GForum::language('VALIDATE_BAD_CODE') });
    my $user_id = $1;
    my $user = $ut->get($user_id)
        or return($page->{bad_code}, { error => GForum::language('VALIDATE_BAD_CODE') });
    if (not $user->{user_val_code}) {
        if ($CFG->{payment}->{signup}->{enabled} and $user->{user_payment_expiry} and $user->{user_payment_expiry} < time) {
            $IN->param(user_id => $user_id);
            return GForum::do_func('payment_initial');
        }
        return($page->{already_validated}, { error => GForum::language('VALIDATE_ALREADY_VALIDATED') });
    }

    if ($validate_code eq $user->{user_val_code}) {
        my $update = { user_val_code => '' };
        if (not $CFG->{require_signup_admin_validation} or $user->{user_admin_validated}) {
            $update->{user_status} = REGISTERED;
        }
        $ut->update($update, { user_id => $user_id });
        @$user{keys %$update} = values %$update; # Update the hash
        if ($CFG->{payment}->{signup}->{enabled} and $user->{user_payment_expiry} and $user->{user_payment_expiry} < time) {
            $IN->param(user_id => $user_id);
            return GForum::do_func('payment_initial');
        }
        else {
            return($page->{success}, $user);
        }
    }
    else {
        return($page->{bad_code}, { error => GForum::language('VALIDATE_BAD_CODE') });
    }
}
END_OF_SUB

$COMPILE{view} = __LINE__ . <<'END_OF_SUB';
sub view {
    shift; # Discard package name
    my ($do, $func) = @_;
    my $page = $func->{page};
    my $user_id = $IN->param('user')
        or
    my $username = $IN->param('username');
    my $user;
    if ($user_id) {
        $user = $DB->table('User')->get($user_id)
            or return($page->{no_such_user}, { error => GForum::language('USER_DOES_NOT_EXIST') });
    }
    else {
        $user = $DB->table('User')->select({ user_username => $username })->fetchrow_hashref
            or return($page->{no_such_user}, { error => GForum::language('USERNAME_DOES_NOT_EXIST' => $username) });
    }
    normalize($user);

    return(
        $page->{user_view},
        {
            %$user
        }
    );
}
END_OF_SUB

# Doubles in purpose as either member directory or user search
$COMPILE{list} = __LINE__ . <<'END_OF_SUB';
sub list {
    shift; # Discard package name
    my ($do, $func) = @_;
    my $page = $func->{page};
    my $User = $DB->table('User');

    my $mh = $IN->param('mh');
    $mh = ($USER->{user_default_mh_user} || $CFG->{default_mh_user} || 50) if not $mh or $mh =~ /\D/;
    my $pg = $IN->param('page');
    $pg = 1 if not $pg or $pg =~ /\D/;
    my $sb = $IN->param('sb');
    my $so = uc($IN->param('so') || '');
    $so = 'ASC' if not $so or $so ne 'ASC' and $so ne 'DESC';
    my ($sth, $sth2, $start_with, $search_col, $search_val, $hits);
    my %allowed = map { ($_ => 1) } @{$CFG->{user_search_allowed}};
    if ($do eq 'user_search') {
        $search_col = $IN->param('search_column');
        $search_col = 'user_username' if not $search_col or not exists $User->{schema}->{cols}->{$search_col} or not $allowed{$search_col};
        $search_val = $IN->param('search_field');
        if (!$search_val) {
            $IN->param(sb => 'user_username');
            return GForum::do_func('user_list');
        }
        $sb = $search_col if not $sb or not exists $User->{schema}->{cols}->{$sb} or not $allowed{$sb};
        $sth = $User->query_sth(
            $search_col => $search_val,
            sb => $sb,
            so => $so,
            mh => $mh,
            nh => $pg
        );
        $hits = $User->hits;
    }
    else {
        $sb = 'user_username' if not $sb or not exists $User->{schema}->{cols}->{$sb} or not $allowed{$sb};
        my $limit = $mh == -1 ? 0 : $mh;
        my $base = ($pg - 1) * $mh;
        $start_with = $IN->param('first') if $sb eq 'user_username';

        my $order_by = "$sb $so";
        my @users;

        my $cond;
        if (defined $start_with and length $start_with) {
            if ($start_with eq 'NUM') {
                $cond = GT::SQL::Condition->new(user_username => '>=' => '0', user_username => '<' => ':');
            }
            elsif ($start_with eq 'OTHER') {
                $cond = GT::SQL::Condition->new('OR');
                $cond->add(user_username => '<' => '0');
                $cond->add(GT::SQL::Condition->new(user_username => '>=' => ':', user_username => '<' => 'a'));
                $cond->add(user_username => '>=' => '[');
            }
            else {
                $cond = GT::SQL::Condition->new(user_username => LIKE => "$start_with%");
            }
        }
        elsif ($sb eq 'user_last_seen' and !$USER || $USER->{user_status} < ADMINISTRATOR) {
            $cond = GT::SQL::Condition->new(user_invisible => '=' => 0);
        }
        $User->select_options("ORDER BY $order_by");
        $User->select_options("LIMIT $base, $limit") if $limit;
        $sth = $User->select($cond || ());

        $hits = $User->hits;
        if ($sb eq 'user_last_seen' and !$USER || $USER->{user_status} < ADMINISTRATOR and (!$limit or $hits < $limit)) {
            if ($hits > 0) {
                $base = 0;
                $limit = $limit - $hits;
            }
            else {
                $base -= $User->count($cond);
            }
            $User->select_options("ORDER BY user_username");
            $User->select_options("LIMIT $base, $limit") if $limit;
            $sth2 = $User->select($cond->not);
            $hits += $User->hits;
        }
    }

    $DB->table('Online')->delete(GT::SQL::Condition->new(online_time => '<' => (time - $CFG->{online_timeout} * 60)));
    my $online_users = $DB->table('Online')->count({ guest_id_fk => 0, online_invisible => 0 });

    my %online = map { ($_ => 1) } $DB->table('Online')->select(user_id_fk => { guest_id_fk => 0, online_invisible => 0 })->fetchall_list;

    my @users;

    while (my $user = $sth->fetchrow_hashref) {
        $user->{user_online} = 1 if $online{$user->{user_id}};
        push @users, $user;
    }
    if ($sth2) {
        while (my $user = $sth2->fetchrow_hashref) {
            $user->{user_online} = 1 if $online{$user->{user_id}};
            push @users, $user;
        }
    }

    normalize(\@users);

    my %vars = (
        users => \@users,
        num_users => $User->count(),
        users_online => $online_users,
        num_page_items => $hits,
        online_timeout => $CFG->{online_timeout},
        sb => $sb,
        first => $start_with,
        so => $so,
        mh => $mh,
        this_page => $pg
    );

    if ($do eq 'user_list' and $sb eq 'user_username') {
        my $has = _first_letter();
        for (keys %$has) {
            $vars{$_} = 1;
        }
    }
    elsif ($do eq 'user_search') {
        $vars{search_column} = $search_col;
        $vars{search_field}  = $search_val;
    }

    return($page->{user_list} => \%vars);
}
END_OF_SUB

# Returns a hash ref of ("has_$val" => 1) pairs. $val is the lower-case letter (for a-z), "num" (for 0-9), or "other" (anything else)
$COMPILE{_first_letter} = __LINE__ . <<'END_OF_SUB';
sub _first_letter {
    my $sth = $DB->table('User')->select('DISTINCT SUBSTRING(user_username, 1, 1)');
    my $ret = {};
    while (my $letter = $sth->fetchrow_arrayref) {
        $letter = $letter->[0];
        if ($letter =~ /\d/) {
            $ret->{has_num} = 1;
        }
        elsif ($letter =~ /[\W_]/) {
            $ret->{has_other} = 1;
        }
        else {
            $ret->{"has_\L$letter"} = 1;
        }
    }
    $ret;
}
END_OF_SUB

# Returns a hash ref with undefined values for all user fields.
# Optionally takes a hash ref of fields to set to something other than undef.
sub blank_user {
    my $set = shift || {};
    my $ret = {};
    for (keys %{$DB->table('User')->{schema}->{cols}}) {
        $ret->{$_} = exists $set->{$_} ? $set->{$_} : undef;
    }
    $ret;
}

sub normalize {
    my $users = shift;
    GT::Plugins->dispatch($CFG->{admin_root_path} . '/Plugins/GForum', "user_normalize", sub { return _plg_normalize(@_) }, $users);
}

# Takes a array ref of hash refs, or just a single hash ref.
sub _plg_normalize {
    my $users = ref $_[0] eq 'ARRAY' ? shift : [shift];
    for my $user (@$users) {
        $user->{user_registered_date} = GForum::date($user->{user_registered});
        $user->{user_days_registered} = (time - $user->{user_registered}) / (24 * 60 * 60);
        $user->{user_days_registered} = 1 if $user->{user_days_registered} < 1;
        if ($user->{user_last_logon}) {
            $user->{user_last_logon_date} = GForum::date($user->{user_last_logon});
        }
        else {
            $user->{user_last_logon_date} = GForum::language('USER_NEVER_LOGGED_IN');
        }
        if ($user->{user_last_seen}) {
            $user->{user_last_seen_date} = GForum::date($user->{user_last_seen});
        }
        else {
            $user->{user_last_seen_date} = GForum::language('USER_NEVER_LOGGED_IN');
        }
        if ($user->{user_payment_expiry}) {
            $user->{user_payment_expiry_date} = GForum::date($user->{user_payment_expiry});
        }
        $user->{user_status_string} = GForum::language(
            $user->{user_status} == 3 ? 'USERSTATUS_ADMINISTRATOR' :
            $user->{user_status} == 2 ? 'USERSTATUS_REGISTERED' :
            $user->{user_status} == 1 ? 'USERSTATUS_NOT_VALIDATED' :
                                        'USERSTATUS_ANONYMOUS'
        );
        $user->{user_title} ||= generate_user_title($user->{user_posts});
        $user->{user_title} = \"$user->{user_title}"; # HTML can be used in user titles

        $user->{user_localtime} = time + 60 * 60 * ($user->{user_time_offset} || 0);
        $user->{user_localtime} -= 60 * 60 * $USER->{user_time_offset} if $USER and $USER->{user_time_offset};
        $user->{user_localdate} = GForum::date($user->{user_localtime});

        $user->{user_homepage} = "http://$user->{user_homepage}" if $user->{user_homepage} and $user->{user_homepage} !~ /^\w+:/;
    }
    $users;
}

sub generate_user_title {
    my $num_posts = shift;
    my $title = '';
    for (sort { $a <=> $b } keys %{$CFG->{user_post_title}}) {
        $_ <= $num_posts and $title = $CFG->{user_post_title}->{$_}, next;
        last;
    }
    $title;
}

1;