• Files
• Commits
• Log
• Graph
• Stats

package Role::Anonymise;

use Moose::Role;
use Data::Dumper;
use Config::Auto;
use FindBin qw($Bin);
use Data::Random qw(:all);

# methods/accessors for anonymise_patient():
has nhs_numbers => ( is => 'rw', isa => 'HashRef', default => sub { {} } );
has all_names => ( is  => 'ro', isa => 'HashRef',  lazy_build => 1 );
has $_    => ( is  => 'ro', isa => 'ArrayRef', lazy_build => 1 )
    foreach qw( last_names first_names male_names female_names );

# replaces some $vals entries - doesn't return anything:
sub anonymise_patient {
	my $self = shift;
	my $vals = shift;

    my @last_names  = @{ $self->last_names };
    my @first_names = @{ $self->first_names };
    my @boys_names  = @{ $self->male_names };
    my @girls_names = @{ $self->female_names };

	my $first_name = '';
	my $gender = $vals->{sex} || '';

	if ($gender eq 'M') {
		$first_name = $boys_names[rand @boys_names];
	}
	elsif ($gender eq 'F') {
		$first_name = $girls_names[rand @girls_names];
	}
	else {
		$first_name = $first_names[rand @first_names];
	}

	# replace these $vals entries:
	$vals->{lname} = lc $last_names[rand @last_names];
	$vals->{fname} = lc $first_name;
    if ( $vals->{dob} ) { # Data::Random::rand_date
        $vals->{dob} = rand_date(min => '1920-1-1', max => '2000-1-1');
    }
    if ( $vals->{nhsno} ) {
        # needs to be unique
        $vals->{nhsno} = $self->_make_nhsno;
    }
}

sub _build_all_names {
    my $self = shift;

    my $names_src = "$Bin/names.pl";
    my $names = Config::Auto::parse($names_src, format => 'perl');
    # print Dumper $names;

    return $names;
}

sub _build_last_names {
    my $self = shift;

    my $names = $self->all_names;
    return $names->{surnames};
}

sub _build_male_names {
    my $self = shift;

    my $names = $self->all_names;
    return $names->{male_names};
}

sub _build_female_names {
    my $self = shift;

    my $names = $self->all_names;
    return $names->{female_names};
}

sub _build_first_names {
    my $self = shift;

    my @boys_names  = @{ $self->male_names };
    my @girls_names = @{ $self->female_names };

    return [ @boys_names, @girls_names ];
}

# need to return unique valid 10-digit nhs_number:
sub _make_nhsno {
    my $self = shift;

	my $ten_digits;

	TRY: while (1) { # $try++;
		$ten_digits = join '', map { int rand 9 } 1 .. 10;

		# try again if invalid:
		$self->_check_nhsno($ten_digits) || next TRY;
        # try again if not unique:
		$self->nhs_numbers->{$ten_digits} ? next TRY : last TRY;
	}

	$self->nhs_numbers->{$ten_digits} += 1;

	return $ten_digits;
}

sub _check_nhsno {
    my $self  = shift;
	my $nhsno = shift; # _dump(Dumper $nhsno);

	$nhsno =~ s/\s+//g;

	return unless length $nhsno == 10; # require 10 consecutive numbers only

	my $product;

	# sum of (each of the first nine digits * weighting factor):
	for (0 .. 8) { # 1st 9 digits of NHS no
		$product += ( substr($nhsno, $_, 1) * (10 - $_) );
	}

	# Divide $product by 11 and establish the remainder. Subtract the remainder from 11 to give
	# the check digit. If the result is 11 then a check digit of 0 is used.
	my $remainder = $product % 11 ? 11 - ($product % 11) : '0';

	# If the result is 10 then the NHS NUMBER is invalid. Check the remainder matches the check
	# digit. If it does not, the NHS NUMBER is invalid.
	return $remainder == substr($nhsno, 9, 1) && $remainder != '10'; # true if NHSNo correct
}

1;