package Role::User; use Moose::Role; has $_ => ( is => 'ro', isa => 'HashRef', lazy_build => 1 ) foreach qw( user_map defined_users user_group_map substitute_user username_userid_map signature_userid_map ); has no_username => ( is => 'ro', isa => 'HashRef', default => sub { {} } ); sub _build_user_map { my $self = shift; my $sql = 'select location_name, id from user_locations'; # create User.Location -> location_name.id map: my $user_map = $self->db->{dbix4}->query( $sql )->map; return $user_map; } sub _build_user_group_map { my $self = shift; return { 0 => 4, 1 => 1, 2 => 3, 3 => 2, 4 => 7, 5 => 6, }; } # missing and substitution users: sub _build_defined_users { my $self = shift; my $user_map = $self->user_map; my $user_group_map = $self->user_group_map; my %users = ( raj => { username => 'raj', first_name => 'richard', last_name => 'jones', password => '0DPiKuNIrrVmD8IUCuw1hQxNqZc', designation => 'Administrator', user_location_id => $user_map->{HMDS}, email => 'ra.jones@hmds.org.uk', group_id => $user_group_map->{5}, active => 'yes', }, kardakaris => { username => 'kardakaris', first_name => 'rosa', last_name => 'kardakaris', password => 'not_required', designation => 'Lab staff', user_location_id => $user_map->{HMDS}, # email => 'kardakaris@hmds.org.uk', group_id => 1, active => 'no', }, page => { username => 'page', first_name => 'marilyn', last_name => 'page', password => 'not_required', designation => 'Lab staff', user_location_id => $user_map->{HMDS}, # email => 'page@hmds.org.uk', group_id => 1, active => 'no', }, unknown_user => { username => 'unknown', first_name => 'unknown', last_name => 'user', password => 'not_required', designation => 'Lab staff', user_location_id => $user_map->{Other}, # email => 'unknown@hmds.org.uk', group_id => 4, active => 'no', }, hilis => { # ============ do not change this unless also _build_substitute_user username => 'hmds-lth', # ============= and cfg.settings.server_username =================== first_name => 'hmds', last_name => 'lth', password => 'not_required', designation => 'Lab staff', user_location_id => $user_map->{Other}, # email => 'unknown@hmds.org.uk', group_id => 4, active => 'no', }, ); return \%users; } sub _build_signature_userid_map { my $self = shift; my $dbh = $self->db->{dbix3}; # create Users.Signature -> user.id map: my $map = $dbh->query( q!select Signature, UserID from Users where Signature is not null! )->map; $map->{'S Richmond'} = 'BAGGULEY'; # add Molecular (for screener): $map->{Molecular} = 'EVANS'; return $map; } sub _build_username_userid_map { my $self = shift; my $dbh = $self->db->{dbix4}; # create users.username -> users.id map: my $map = $dbh->query( 'select username, id from users' )->map; return $map; } sub _build_substitute_user { my $self = shift; return { 'S Richmond' => $self->username_userid_map->{bagguley}, Molecular => $self->username_userid_map->{evans}, Admin => $self->username_userid_map->{raj}, # for early hilis requests: admin => $self->username_userid_map->{raj}, fielding => $self->username_userid_map->{douglas}, westgate => $self->username_userid_map->{wilkinson}, mueller => $self->username_userid_map->{whittle}, # re-map back to original - reverted to original # detute => $self->username_userid_map->{'de tute'}, hilis => $self->username_userid_map->{'hmds-lth'}, worrilow => $self->username_userid_map->{worrilla}, de => $self->username_userid_map->{detute}, }; } # accepts Users.UserID, returns users.id: sub _get_user_id { my ($self, $username) = @_; my $user_id; if ($username) { # warn $username; $user_id = $self->username_userid_map->{$username} || $self->substitute_user->{$username}; $self->no_username->{$username} += 1 unless $user_id; $user_id ||= $self->username_userid_map->{unknown}; } else { $user_id = $self->username_userid_map->{unknown}; } return $user_id; } # accepts Users.Signature, returns Users.UserID: sub _get_username { my ($self, $signature) = @_; if ($signature) { my $username = lc $self->signature_userid_map->{$signature}; return $username; } } # accepts hilis3.Users.Signature, returns hilis4.users.id: sub _get_user_id_from_sig { my $self = shift; my $sig = shift; # warn $sig; return $self->username_userid_map->{unknown} if ! $sig; my $username = lc $self->signature_userid_map->{$sig}; # warn $username; my $user_id = $self->username_userid_map->{$username} || $self->substitute_user->{$username}; # warn $user_id; $user_id ||= $self->username_userid_map->{unknown}; return $user_id; } 1;