• Files
• Commits
• Log
• Graph
• Stats

package LIMS::Controller::Admin::User;

use strict;

use base 'LIMS::Controller::Admin';
use LIMS::Local::Utils;

use Moose;
with (
	'LIMS::Controller::Roles::User', # generate_new_password
    'LIMS::Controller::Roles::FormData', # validate_form_params
);

__PACKAGE__->meta->make_immutable(inline_constructor => 0);

__PACKAGE__->authz->authz_runmodes( ':all' => 'do_admin' );

use Data::Dumper;
use Data::Printer;

#-------------------------------------------------------------------------------
sub default : StartRunmode {
    my $self = shift; $self->_debug_path($self->get_current_runmode);
    my $errs = shift; # $self->stash( errs => $errs );

	my $model = $self->model('User');

    my %data = (
        locations => $model->get_user_locations({sort_by => 'location_name'}),
        groups    => $model->get_user_groups({sort_by => 'group_label'}),
    );
    $self->tt_params($_ => $data{$_}) for keys %data; # $self->debug(%data);

    if ( my $id = $self->param('id') || $self->query->param('id') ) {
        # get user details:
        my $user_details = $self->_get_user_details($id);
			# $self->debug([keys %$user_details]);
        # load this users details into %data:
        $self->tt_params($_ => $user_details->{$_}) for keys %{$user_details};
    }

    # get js validation foo_onsubmit & foo_dfv_js vars into template:
    $self->js_validation_profile('user_details');

    return $self->tt_process($errs);
}

#-------------------------------------------------------------------------------
sub get_user : Runmode {
    my $self = shift;

    my $username = $self->query->param('username'); # warn $username;

    my $user = $self->model('User')->get_user_by_username($username);

    # add user.id as param for default():
    $self->param( id => $user->id );
    return $self->forward('default');
}

#-------------------------------------------------------------------------------
# create new user & update existing user from Admin / User administration / User Manager:
sub update_user_details : Runmode {
    my $self = shift; $self->_debug_path($self->get_current_runmode);

	my $user_id = $self->param('id');

	# put id (if submitted) into params() for validate('user_details') profile:
    if ( $user_id ) { # warn $user_id;
        $self->query->param( _record_id => $user_id );
    }

	my $dfv = $self->check_rm('default', $self->validate('user_details') )
	|| return $self->dfv_error_page;

	my $data = $dfv->valid
	|| return $self->forward('default'); # eg if empty param; # $self->debug($data);

	if ($user_id) {
		# provide 'id' if supplied, so record updated, otherwise new one created:
		$data->{id} = $user_id;

		# load existing user (if it's an 'update user' action):
		my $user = $self->model('User')->get_user_profile($user_id)
    	|| return $self->error("Cannot retreive user details for id=$user_id");

		# check if password has been changed - if form pwd not same as retrieved
		# pwd, must have been changed & will need encrypting:
		if ($data->{password} ne $user->password) {
			# encrypt password using SHA1 (or MD5):
			my $sha1 = LIMS::Local::Utils::sha1_digest($data->{password});
			$data->{password} = $sha1; # $self->debug('sha1:'.$sha1);
		}
		# set message:
		$self->stash( user_update_action => 'edit_success' );
	}
	# it's a 'create new user' action, so encrypt password:
	else {
		my $sha1 = LIMS::Local::Utils::sha1_digest($data->{password});
		$data->{password} = $sha1; # $self->debug('sha1:'.$sha1);
		# set message:
		$self->stash( user_update_action => 'create_success' );
	}

    my $rtn = $self->model('User')->update_user($data);

	if ( $rtn ) {
        $self->error($rtn);
	}
	else { # redirect after db edit:
		# set MessageStack msg set above:
		my $action = $self->stash->{user_update_action};
		$self->flash( info => $self->messages('admin')->{user}->{$action} );

        if (! $user_id) { # use new 'username' to get new record id:
            my $username = $data->{username};
            my $user = $self->model('User')->get_user_by_username($username);
            $user_id = $user->id;
        }
        $self->redirect( $self->query->url . '/admin/user/default/'.$user_id );
	}
}

#-------------------------------------------------------------------------------
sub edit_permissions : Runmode {
    my $self = shift; $self->_debug_path($self->get_current_runmode);

    my $id = $self->param('id')
	|| return $self->error( 'no id passed to '.$self->get_current_runmode );

    my $data = $self->_get_user_details($id);

    map $self->tt_params($_ => $data->{$_}), keys %$data;

    return $self->tt_process('admin/user/edit_permissions.tt');
}

#-------------------------------------------------------------------------------
sub reset_user_permissions : Runmode {
    my $self = shift; $self->_debug_path($self->get_current_runmode);

    my $id = $self->param('id')
	|| return $self->error( 'no id passed to '.$self->get_current_runmode );

    my $user = $self->model('User')->get_user_profile($id);

    $self->tt_params( user => $user );

    # need confirmation before resetting permissions:
    return $self->tt_process('admin/user/reset_permissions.tt')
        unless $self->query->param('confirm_reset');

    my $rtn = $self->model('User')->delete_user_permissions($id);

    return $rtn ?
        $self->error($rtn) : # redirect after db edit:
            $self->redirect( $self->query->url . '/admin/user/default/'.$id );
}

#-------------------------------------------------------------------------------
sub update_user_permissions : Runmode {
    my $self = shift; $self->_debug_path($self->get_current_runmode);

    my $user_id = $self->param('id')
	|| return $self->error('no id passed to '.$self->get_current_runmode);

    my @function_ids = $self->query->param('function_id'); # $self->debug(\@function_ids);

    my %args = (
        function_ids => \@function_ids,
        user_id      => $user_id,
    );

    my $rtn = $self->model('User')->update_user_permissions(\%args);

    return $rtn  ?
        $self->error($rtn) :
            $self->redirect( $self->query->url . '/admin/user/default/'.$user_id );
}

#-------------------------------------------------------------------------------
sub delete_user : Runmode {
    my $self = shift; $self->_debug_path($self->get_current_runmode);

    my $user_id = $self->param('id')
	|| return $self->error('no id passed to '.$self->get_current_runmode);

    my $user = $self->model('User')->get_user_profile($user_id);

    $self->tt_params( user => $user );

    # need confirmation before deleting user:
    return $self->tt_process('admin/user/delete_user.tt')
        unless $self->query->param('confirm_reset');

    my $rtn = $self->model('User')->delete_user($user_id);

    return $rtn ?
        $self->error($rtn) : # redirect after db edit:
            $self->redirect( $self->query->url . '/admin/user' );
}

#-------------------------------------------------------------------------------
# create new user from copy/pasted user application email:
sub new_user : Runmode {
    my $self = shift; $self->_debug_path($self->get_current_runmode);

	my $vars = $self->query->Vars(); # warn Dumper $vars;
    return $self->tt_process() unless %$vars; # ie 1st call to method

    # extract user details from textfield:
	my $src_data = $self->_parse_message($vars->{src_data}); # warn Dumper $src_data;
    my $data = $self->_validate_new_user($src_data); # warn Dumper $data;
    # create username (unless param validation failure):
    unless ( $self->stash->{new_user_validation_failure} ) {
        $self->_create_unique_username($data);
    }
	if ($vars->{post}) {
        # generate new plain text password:
        my $password = $self->generate_new_password();
        # encrypt password using SHA1 (or MD5) for model:
        my $sha1_pwd = LIMS::Local::Utils::sha1_digest($password);

        # store as plain_txt_pwd for .tt and email:
        $data->{plain_txt_pwd} = $password;
        # store sha1-encrypted password for model/db:
        $data->{password} = $sha1_pwd; # $self->debug($sha1_pwd);

        # check we have user group id or return to form:
		unless ( $vars->{group_id} ) {
			my $message = $self->_get_msg_body($data);
			$data->{message} = $message; # warn Dumper $src_data;
			return $self->_preview_new_user($data); # return to 'preview' page
		}
        $data->{group_id} = $vars->{group_id};

        # set user active (param set to 1 in _validate_new_user() ):
        $data->{active} = 'yes';

		{ # set last_login timestamp to 1 month before auto-expiry:
			my $today = LIMS::Local::Utils::today();
			$data->{last_login} = $today->clone->subtract( months => 5 );
            # add epoch time as token to msg for 1st login link:
            $data->{epoch} = $data->{last_login}->epoch;
		}
        { # execute update_user method & get last_insert_id:
            my $rtn = $self->model('User')->update_user($data);
            return $self->error($rtn) if $rtn;

            $data->{uid} = # add new user ID to msg for 1st login link:
				$self->lims_db->dbh->last_insert_id(undef, undef, 'users', 'id');
        }
        { # send new registration details to new user:
			my $message = $self->_get_msg_body($data);
			$data->{message} = $message; # warn Dumper $data;
            my $rtn = $self->_email_registration_details($data);
            return $self->error($rtn->string) if $rtn->type ne 'success';
        }
        { # set success flash message:
            my $msg = $self->messages('admin')->{user}->{create_success};
            $self->flash( info => $msg );
            # set flag for tt to avoid loading warning msgs:
            $self->tt_params( new_user_create_success => 1 );
        }
	}

    return $self->tt_process();
}

#-------------------------------------------------------------------------------
sub list_all : Runmode {
    my $self = shift; $self->_debug_path($self->get_current_runmode);

    my $total = $self->model('Base')->get_objects_count('User'); # warn $total;

    my %args = ();
    $args{sort_by} = $self->query->param('sort_by');

    if ( $total > $self->cfg('settings')->{entries_per_page} ) {
        # invoke pager for template and add limit & offset params to \%args:
        $self->pager({ query => \%args, total => $total });
    }
	my $users = $self->model('User')->get_all_users(\%args);
    return $self->tt_process({ users => $users });
}

#-------------------------------------------------------------------------------
sub _get_msg_body {
	my $self = shift;
	my $data = shift;

	my $message_body = do { # turn off POST_CHOMP to control formatting in .tt:
        local $self->cfg('tt_config')->{TEMPLATE_OPTIONS}->{POST_CHOMP} = undef;
        $self->tt_params( user_details => $data );
		$self->tt_process('admin/user/new_user_msg.tt');
	}; # warn Dumper $message_body;
	return ${$message_body}; # return deref'ed string
}

#-------------------------------------------------------------------------------
sub _validate_new_user {
    my $self = shift; $self->_debug_path();
    my $data = shift; # warn Dumper $data;

    # get user groups:
    my $groups
        = $self->model('User')->get_user_groups({sort_by => 'group_label'});
    # check role/designation:
    my $has_role = $self->model('User')->check_user_roles($data->{designation});

	$self->tt_params(
        user_groups => $groups,
        has_role    => $has_role,
    );

    # validate data:
    my $profile = $self->validate('new_user'); # warn Dumper $profile;

    # add dummy vals if not exists (eg for preview) for validation profile:
    $data->{$_} ||= 1 for qw(password group_id active); # overwritten during 'post'

    my $dfv = $self->validate_form_params($profile, $data); # warn Dumper $dfv;
    if ($dfv->has_invalid || $dfv->has_missing) {
        $self->stash( new_user_validation_failure => 1 ); # for caller
        $self->tt_params( errs => $dfv->msgs, input_params => $data );
    }
    my $valid = $dfv->valid; # warn Dumper $valid;
    $self->tt_params( user_details => $valid );

    return $valid;
}

#-------------------------------------------------------------------------------
sub _email_registration_details {
    my $self = shift; $self->_debug_path();
    my $data = shift;

    my $subject = sprintf 'HILIS registration details (%s, %s)',
        uc $data->{last_name}, ucfirst lc $data->{first_name};

    my $cfg = $self->cfg('settings');

    my %mail_data = (
        recipient => $data->{email},
        subject   => $subject,
        message   => $data->{message},
        config    => $cfg,
    ); # $self->debug(\%mail_data);

    my $rtn = $self->model('Email')->send_message(\%mail_data); # Return::Value object

    # confirmation to admins:
    for my $recipient ( qw/service_email admin_contact/ ) {
        $mail_data{recipient} = $cfg->{$recipient};
        $self->model('Email')->send_message(\%mail_data);
    }

    return $rtn;
}

#-------------------------------------------------------------------------------
# returns hashref of selected_user (users details), permissions_type
# (custom/default), user_permissions (list)
sub _get_user_details {
    my $self    = shift; $self->_debug_path();
    my $user_id = shift;

    my %data;

    my $this_user = $data{selected_user}
		= $self->model('User')->get_user_profile($user_id); # hashref

    # load custom user permissions (if any):
    my $this_user_permissions
		= $self->model('User')->get_user_permissions($user_id); # arrayref

    # flag for template (if permissions set here - it's custom):
    $data{permissions_type} = @$this_user_permissions ? 'custom' : 'default';

    # if no user_permissions, load default settings for this users' group:
    if (! @$this_user_permissions) {
        $this_user_permissions
			= $self->model('User')->get_user_group_functions($this_user->group_id);
    }

    { # get user_permissions, with active => 1 if function.id also in user_group_functions table:
        my $ref = $self->get_user_functions($this_user_permissions);
        my @data = sort { $a->{detail} cmp $b->{detail} } @$ref; # warn Dumper \@data;
        $data{user_permissions} = \@data;
    }
    # user registration (GMC/HCPC number):
    if ( my $o = $self->model('User')->get_user_registration($user_id) ) {
        $data{user_registration_number} = $o->registration_number;
    }
    { # can't delete if user ever logged in (FK constraint)
        $data{login_count} = $self->model('User')->get_login_count($user_id);
    } # warn Dumper \%data;
    return \%data;
}

#-------------------------------------------------------------------------------
sub _parse_message {
	my ($self, $msg) = @_; $self->_debug_path(); # p $msg;

    return 0 if ! $msg; # warn Dumper $msg; # in case submitted empty except spaces

    my $trim = sub { LIMS::Local::Utils::trim(@_) };

	my ($first_name)  = &$trim( $msg =~ /First Name: (.*)/ ); # p $first_name;
	my ($last_name)   = &$trim( $msg =~ /Last Name: (.*)/  ); # p $last_name;
	my ($email)       = &$trim( $msg =~ /E-mail: (.*)/     ); # p $email;
	my ($location)    = &$trim( $msg =~ /Source: (.*)/     ); # p $location;
	my ($designation) = &$trim( $msg =~ /Position: (.*)/   ); # p $designation;
	my ($service)     = &$trim( $msg =~ /Service: (.*)/    ); # p $service;

	my $details = {
        full_name   => ( join ' ', $first_name, $last_name ), # for DFV useage
		first_name  => $first_name,
		last_name   => $last_name,
		email       => $email,
		location    => $location, # use settings if absent (for legacy applications):
        service     => $service || $self->cfg('settings')->{_centre},
		designation => $designation,
	}; # p $details;

   # add user_location_id if user location exist:
    unless ($details->{user_location_id}) { # unless already set in 'preview':
        if ( my $location = $details->{location} ) {
            my $o = $self->model('User')->get_location_by_name($location);
            if ($o) { $details->{user_location_id} = $o->id }
        }
    }
	return $details;
}

sub _create_unique_username {
    my ($self, $data) = @_;

    my $first_name = lc $data->{first_name}; # p $first_name;
	my $username   = lc $data->{last_name};  # p $username;
	# allowing apostrophies in surname now, but need to remove for username:
	$username =~ s/\'//; # p $username;

	my @registered_users = (); # container for existing usernames

	# loop through each first_name character, appending to last_name
	# until we have a unique user_id, or exhausted all chars:
	CHAR:
    for my $next_character ( split //, lc $first_name ) { # p $next_character;
		# if username exists, append successive letters from first_name & try again
		if ( my $o = $self->model('User')->get_user_by_username($username) ) {
			$username .= $next_character; # p $username;
			push @registered_users, $o;
			next CHAR;
		}
		# else username is unique so exit loop:
		last CHAR;
	}
    # check username doesn't already exist (will only happen if surname + first
    # name already exist as a username eg new user has abbreviated first name):
    if ( my $o = $self->model('User')->get_user_by_username($username) ) {
     	push @registered_users, $o;
        $username .= 2; # make it alphanumeric and auto-increment until we get a unique username:
        $username++ while $self->model('User')->get_user_by_username($username);
    }
	$self->tt_params( registered_users => \@registered_users );
	$data->{username} = $username; # p $data;
}

=begin # needs a bit more work - eg tt can't access c.cfg or app_url, requires
cpan modules MIME::Base64 & Authen::SASL for smtp authentication
#-------------------------------------------------------------------------------
sub _email_registration_details {
    my $self = shift; $self->_debug_path();
    my $data = shift;

	use Email::Template;

	my $path_to_app_root = $self->cfg('path_to_app_root');

    my $subject = sprintf 'HILIS registration details (%s, %s)',
        uc $data->{last_name}, ucfirst lc $data->{first_name};

	my @smtp = ('smtp', 'smtp.hmds.org.uk', AuthUser => 'ra.jones@hmds.org.uk',
		AuthPass => 'tetramor' );

	my %args = (
		From    => $self->cfg('settings')->{email_from} || 'hmds.lth@nhs.net',
		To      => $data->{email},
		Subject => $subject,

		tt_new  => { INCLUDE_PATH => $path_to_app_root.'/templates' },
		tt_vars => { user_details => $data },
		convert => { rightmargin => 80, no_rowspacing => 1 },
		mime_lite_send => \@smtp,
	);

	Email::Template->send( 'admin/user/new_user_msg.htm', \%args )
	or warn "could not send the email";
}
=cut

1;