RSS Git Download  Clone
Raw Blame History
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 $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 = lc $user_id . '@somewhere.com';
		my $password = $vals->{password};
		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';
		
		# make HMDS users pwd 'hilis4' for testing:
		if ($location eq 'HMDS' and $vals->{active}) {
			$password = Digest::SHA1::sha1_base64('hilis4');

			# username substitutions:
			$first_name =~ s/(im) fan/$1/;
			$first_name =~ s/(jane)b/$1/;
			$first_name =~ s/(paul)e/$1/;
			$first_name =~ s/(david)s/$1/;
			$first_name =~ s/(liz)w/$1/;
			$first_name =~ s/(steve)/stephen/;
			
			$last_name  =~ s/kuzmicki/dickinson/;
			$last_name  =~ s/bradley/dickinson/;
			$last_name  =~ s/wheeler/darcy/;
			$last_name  =~ s/oconnor/o\'connor/;

			if ($last_name eq 'detute') {
				$last_name  = 'tute';
				$first_name = 'ruth de';
				$user_id    = 'de tute';			
			} 
			$first_name = 'jane' if $last_name eq 'teasdale'; # nickname = JaneT, and also have Janet
		}

        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});
	}
	
	# 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;