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;