package User;
use Moose;
with qw(
Role::User
Role::RebuildTables
);
use namespace::clean -except => 'meta';
use DateTime::Format::MySQL;
use Data::Dumper;
has $_ => ( is => 'ro', isa => 'HashRef', required => 1 )
foreach qw(db sql);
has last_login_map => ( is => 'ro', isa => 'HashRef', lazy_build => 1 );
__PACKAGE__->meta->make_immutable;
use Digest::SHA1 'sha1_base64'; # use Digest::MD5 'md5_hex';
my @tables = qw(users);
sub convert {
my $self = shift;
$self->rebuild_tables(\@tables);
my $dbix3 = $self->db->{dbix3};
my $dbix4 = $self->db->{dbix4};
my $hilis3 = $dbix3->query( q!select * from Users! );
# User.Location -> location_name.id map:
my $user_map = $self->user_map;
my $user_group_map = $self->user_group_map;
my $last_login_map = $self->last_login_map; # warn Dumper $last_login_map;
my $default_hilis3_pwd = Digest::SHA1::sha1_base64('change_me_now');
my $renamed_location = {
LTH => $user_map->{Leeds},
SJUH => $user_map->{Leeds},
LGI => $user_map->{Leeds},
EGU => $user_map->{'EGU, York'},
NYCRIS => $user_map->{'NYCRIS, Leeds'},
'Inverness Raigmore' => $user_map->{Inverness},
# 'LGI histopathology' => $user_map->{'Leeds histopathology'},
# 'LTH histopathology' => $user_map->{'Leeds histopathology'},
# 'LTH paediatrics' => $user_map->{'Leeds paediatrics'},
'LGI histopathology' => $user_map->{Leeds},
'LTH histopathology' => $user_map->{Leeds},
'LTH paediatrics' => $user_map->{Leeds},
};
my $defined_users = $self->defined_users;
USER:
while ( my $vals = $hilis3->hash ) {
my $user_id = $vals->{userid};
my $location = $vals->{location};
my $permissions = $vals->{permissions};
my $email = $vals->{email};
my $password = $vals->{newpwd};
my $first_name = lc $vals->{nickname};
my $last_name = lc $user_id;
# MySQL3 can't do this:
#$dbix3->query( q!select max(Date),Time from Log where
# UserID = ? and Action like 'logged on%'!, $vals->{userid}
# )->into( my ($date,$time) );
my $last_login_dt = $self->last_login_map->{$user_id}
|| DateTime->new(year => 1999, month => 1, day => 1); # default
# make sinclair HMDS:
$location = 'HMDS' if $last_name eq 'sinclair';
if (! $password) {
# don't convert lazy buggers or new users:
if ( crypt('change_me_now', $vals->{password}) eq $vals->{password} ) {
$password = 'default_hilis3_pwd'; # warn $user_id . ' using default pwd';
}
else {
$password = 'not_converted'; # haven't logged in since pwd converter used
}
}
elsif ( $password eq $default_hilis3_pwd ) { # shouldn't happen, but JIC
$password = 'default_hilis3_pwd'; # warn $user_id . ' using default pwd';
}
if ($location eq 'HMDS' and $vals->{active}) {
# $password = Digest::SHA1::sha1_base64('hilis4'); # revert to HILIS3 pwd
# username substitutions:
$first_name =~ s/(im) fan/$1/;
$first_name =~ s/(jane)b/$1/;
$first_name =~ s/(paul)e/$1/;
$first_name =~ s/(steve)/stephen/;
$last_name =~ s/kuzmicki/dickinson/;
$last_name =~ s/bradley/dickinson/;
$last_name =~ s/wheeler/darcy/;
$last_name =~ s/bennett/cullen/;
if ($last_name eq 'detute') {
$last_name = 'tute';
$first_name = 'ruth de';
# $user_id = 'de tute'; # reverted to original
}
$first_name = 'jane' if $last_name eq 'teasdale'; # nickname = JaneT, and also have Janet
}
# other name substitutions:
$last_name =~ s/^alexs$/smith/;
$last_name =~ s/^alif$/ali/;
$last_name =~ s/^barrettj$/barrett/;
$last_name =~ s/^bondb$/bond/;
$last_name =~ s/^clarkej$/clarke/;
$last_name =~ s/^douglas$/blythe/;
$last_name =~ s/^hallc$/hall/;
$last_name =~ s/^howardl$/howard/;
$last_name =~ s/^jainm$/jain/;
$last_name =~ s/^johnsonh$/johnson/;
$last_name =~ s/^jonesj$/jones/;
$last_name =~ s/^kaurj$/kaur/;
$last_name =~ s/^mitchellr$/mitchell/;
$last_name =~ s/^morrisg$/morris/;
$last_name =~ s/^newton[acdr]$/newton/;
$last_name =~ s/^nortona$/norton/;
$last_name =~ s/^oconnorl$/o\'Connor/; # capital C
$last_name =~ s/^oconnor$/o\'Connor/; # capital C
$last_name =~ s/^ramsdenk$/ramsden/;
$last_name =~ s/^richards[jm]$/richards/;
$last_name =~ s/^robinsonk$/robinson/;
$last_name =~ s/^sah$/hill/;
$last_name =~ s/^sbennett$/bennett/;
$last_name =~ s/^shieldsm$/sheilds/;
$last_name =~ s/^smithpe$/smith/;
$last_name =~ s/^smithp$/smith/;
$last_name =~ s/^stewarts$/stewart/;
$last_name =~ s/^turnerg$/turner/;
$last_name =~ s/^woodl$/wood/;
$last_name =~ s/^worrilla$/worrillow/;
$last_name =~ s/^wrightd$/wright/;
$first_name =~ s/^anitas$/anita/;
$first_name =~ s/^annc$/ann/;
$first_name =~ s/^david[abs]$/david/;
$first_name =~ s/^jamesb$/james/;
$first_name =~ s/^john[ag]$/john/;
$first_name =~ s/^kelly[cm]$/kelly/;
$first_name =~ s/^liz[lsw]$/liz/;
$first_name =~ s/^mike[gs]$/mike/;
$first_name =~ s/^sallyb$/sally/;
my $location_id = $user_map->{$location}
|| $renamed_location->{$location}
|| die "no location id for $location";
# make sure they exist:
# $date ||= '1999-01-01'; $time ||= '00:00:00';
# my $last_login = join ' ', $date, $time; # warn $last_login;
my $data = {
username => lc $user_id,
first_name => $first_name,
last_name => $last_name,
password => $password,
designation => $vals->{designation},
user_location_id => $location_id,
email => $email,
group_id => $user_group_map->{$permissions},
last_login => DateTime::Format::MySQL->format_datetime($last_login_dt),
active => $vals->{active} ? 'yes' : 'no',
};
# substitute guest for unknown_user for early registrations:
$data = $defined_users->{unknown_user} if $data->{username} eq 'guest';
# substitute admin for raj:
$data = $defined_users->{raj} if $data->{username} eq 'admin';
$dbix4->insert('users', $data);
}
# set inactive accounts:
$dbix4->dbh->do( q!UPDATE users SET active = 'no' WHERE last_login <
DATE_SUB(CURRENT_DATE(), INTERVAL 6 MONTH) AND active = 'yes'! );
foreach my $user (keys %$defined_users) { # warn $user;
next if grep $user eq $_, qw(raj unknown_user); # done these
$dbix4->insert('users', $defined_users->{$user});
}
$self->convert_to_InnoDB($_) for @tables;
# email_addresses for emailing report ajax lookup function:
$self->do_email_addresses();
}
# History.Action like 'emailed report to %':
sub do_email_addresses {
my $self = shift;
my $tbl = 'email_addresses';
$self->rebuild_tables([$tbl]);
my $dbix3 = $self->db->{dbix3};
my $dbix4 = $self->db->{dbix4};
my $hilis3 = $dbix3->query( q!select Action from History where Action like
'emailed report to %\@nhs.net'! );
my %contacts;
while ( my $action = $hilis3->list ) { # warn Dumper $action;
my ($addr) = $action =~ /emailed report to (.*)/;
$contacts{lc $addr} = $addr; # force key to lc or crashes mysql on duplicate
} # warn Dumper \%contacts;
while ( my ($address, $i) = each %contacts ) { # warn $address; next;
$dbix4->insert( $tbl, { address => $address } );
}
}
sub _build_last_login_map {
my $self = shift;
my $sql = q!select * from Log where Action like 'logged on%'!;
my $dbh = $self->db->{dbix3};
my %users;
my $result = $dbh->query($sql);
ROW:
while ( my $vals = $result->hash ) {
my $userid = $vals->{userid}; # warn $userid;
my $datetime = join ' ', $vals->{date}, $vals->{time};
my $dt = DateTime::Format::MySQL->parse_datetime( $datetime );
next ROW if $users{$userid} && $users{$userid} > $dt;
$users{$userid} = $dt;
}
return \%users;
}
1;
