discourse-legacysite-perl/site/slowtwitch.com/cgi-bin/articles/admin/Links/Table/Users.pm

# ==================================================================
# Gossamer Links - enhanced directory management system
#
#   Website  : http://gossamer-threads.com/
#   Support  : http://gossamer-threads.com/scripts/support/
#   CVS Info : 087,071,086,086,085      
#   Revision : $Id: Users.pm,v 1.5 2005/05/12 20:51:24 brewt Exp $
#
# Copyright (c) 2001 Gossamer Threads Inc.  All Rights Reserved.
# Redistribution in part or in whole strictly prohibited. Please
# see LICENSE file for full details.
# ==================================================================

package Links::Table::Users;
# ==================================================================
use strict;
use GT::SQL;
use GT::SQL::Table;
use Links qw/$CFG $PLG/;
use vars qw/@ISA $ERRORS $ERROR_MESSAGE $AUTH/;

@ISA = qw/GT::SQL::Table/;
$ERROR_MESSAGE = 'GT::SQL';

$ERRORS = {
    AUTHERROR     => "Authentication Error: %s",
    INVALIDFORMAT => "Invalid format for username: %s"
};

sub init {
# -------------------------------------------------------------------
# Load the authentication module.
#
    require Links::Authenticate;
    Links::Authenticate::auth('init', {});
    return 1;
}


sub add {
# -------------------------------------------------------------------
    my ($self, @args) = @_;
    return $PLG->dispatch('add_user', sub { return $self->_plg_add(@_); }, @args );
}

sub _plg_add {
# -------------------------------------------------------------------
    init();
    my $self = shift;
    my $p = ref $_[0] eq 'HASH' ? shift : {@_};

    if (! Links::Authenticate::auth('valid_format', { Username => $p->{Username} })) {
        $ERRORS->{INVALIDFORMAT} = Links::language('USER_INVALIDUSERNAME');
        return $self->error('INVALIDFORMAT', 'WARN', $p->{Username});
    }

    my $h = Links::Authenticate::auth('add_user', { Username => $p->{Username}, Password => $p->{Password} });
    unless ($h) {
        $ERRORS->{AUTHERROR} = Links::language('USER_AUTHERROR');
        return $self->error('AUTHERROR', 'WARN', $Links::Authenticate::error);
    }

    $p->{Username} = $h->{Username};
    $p->{Password} = $h->{Password};

    return $self->SUPER::add($p);
}

sub delete {
# -------------------------------------------------------------------
    my ($self, @args) = @_;
    return $PLG->dispatch('delete_user', sub { return $self->_plg_delete(@_); }, @args );
}

sub _plg_delete {
# -------------------------------------------------------------------
    init();
    my ($self, $cond) = @_;
    if (! ref $cond) {
        $cond = { Username => $cond };
    }
    my $count   = 0;
    my $link_db = $Links::DB->table('Links');
    my $sth     = $self->select('Username', $cond);
    while (my ($user) = $sth->fetchrow_array) {
        my @links = $link_db->select('ID', { LinkOwner => $user })->fetchall_list;
        for my $link_id (@links) {
            $link_db->delete($link_id);
        }
        if (Links::Authenticate::auth('del_user', { Username => $user })) {
            my $ret = $self->SUPER::delete($user);
            $count++ if $ret;
        }
    }
    return $count;
}

sub modify {
# -------------------------------------------------------------------
    my ($self, @args) = @_;
    return $PLG->dispatch('modify_user', sub { return $self->_plg_modify(@_); }, @args );
}

sub _plg_modify {
# -------------------------------------------------------------------
    init();
    my $self  = shift;
    my $input = $self->common_param(@_) or return $self->error('BADARGS', 'FATAL', '$obj->insert(HASH or HASH_REF or CGI) only.');
    my $id    = $input->{Username} or return $self->error("BADARGS", "FATAL", "No primary key passed to modify!");
    my $sth   = $self->select('Username', 'Password', { Username => $id });
    my $rec   = $sth->fetchrow_hashref;
    if ($rec) {
        if ($input->{Password} ne $rec->{Password}) {
            Links::Authenticate::auth('change_pass', { Username => $rec->{Username}, Password => $rec->{Password}, New_Password => $input->{Password} })
                or return $self->error('AUTHERROR', 'WARN', $Links::Authenticate::error);
        }
    }

# Connect to the database if we are not already connected
    $self->connect;

# Copy the data and remove anything that doesn't make sense here.
    my $c   = $self->{schema}->{cols};
    my $set = {};
    for (keys %$c) {
        $set->{$_} = $input->{$_} if exists $input->{$_};
    }

# Remove primary keys from update clause.
    my $where;
    if ($input->{orig_username}) {
        $where->{Username} = $input->{orig_username};
    }
    else {
        foreach my $key (@{$self->{schema}->{pk}}) {
            $where->{$key} = delete $set->{$key} if exists $set->{$key};
        }
    }
    return $self->error("NOPKTOMOD", "WARN") unless keys %$where == @{$self->{schema}->{pk}};

# Remove timestamps - no sense updating.
    $self->_check_timestamp($where, $set) or return;
    foreach my $col (keys %$c) {
        delete $set->{$col} if $c->{$col}->{type} eq 'TIMESTAMP';
    }

# Execute the update
    $self->update($set, $where) or return;
    return 1;
}

sub random_pass {
# -------------------------------------------------------------------
# Returns a random password.
#
    my $self = shift;
    my $pass = '';
    for (1 .. 8) { $pass .= chr(65 + int rand 57); }
    return $pass;
}

1;