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;