• Files
• Commits
• Log
• Graph
• Stats

package LIMS::Controller::Roles::DataImport;

use Moose::Role;
use Data::Dumper;
use LIMS::Local::Utils;

has $_ => ( is => 'ro', isa => 'HashRef', lazy_build => 1)
	for qw( datafile_field_map datafiles_config );
	
has param_mismatch => (
    is      => 'ro',
    isa     => 'ArrayRef[Str]',
    default => sub { [] },
    lazy    => 1,
	traits  => ['Array'],
	handles => {
        has_param_mismatch => 'count',
		add_param_mismatch => 'push',
		all_mismatches     => 'elements',
	},
);

has datafile_params => (
    is      => 'ro',
    isa     => 'ArrayRef[Str]',
    default => sub { [] },
    lazy    => 1,
	traits  => ['Array'],
	handles => {
		add_datafile_param => 'push',
	},
);

use Data::Dumper;

#-------------------------------------------------------------------------------
sub get_result_data_file {
	my ($self, $request_id) = @_;
	
	my $request = $self->model('Request')->get_request($request_id);

	# get list of all files in requests' images dir:
	my $contents = $self->load_image_files($request); # hashref
	my $files = $contents->{files}; # $self->debug($files); # arrayref
	
    # get list of permitted file type definition (eg PB_HIV, PB_RIT, etc)
    my $cfg = $self->get_yaml_file('datafiles') || return []; # expects arrayref

    my @file_types = map {
        $cfg->{$_}->{file_id};
    } keys %$cfg; # warn Dumper \@file_types;    
    
	my @data_files;

	# should only be 1 data file but capture any and test for in caller:
    for my $file(@$files) { # warn $file;
        next unless grep {
            # requested format eg: 09_00123_PB_HIV.txt
            $file =~ /\d{2}_\d{5}_($_)\.txt\Z/;
        } @file_types;
        push @data_files, $file;
    }

	return \@data_files;
}

#-------------------------------------------------------------------------------
sub get_datafile_contents {
	my ($self, $data_file) = @_; # warn $data_file;

	# capture component of filename before .txt:
	my ($data_file_id) = $data_file =~ /(.*)\.txt/; # warn $file_id;
	
	# capture 1st 2 blocks of digits into $yr & $request_number vars, and last
    # block of chars into $type var: 
	my ($yr, $req_number, $type) = $data_file_id =~ /\A(\d{2})_(\d{5})_\w+_(\w+)\Z/;
    
    # store request_type and data_file_id for later:
    $self->stash(
        request_type => $type,
        data_file_id => $data_file_id,
    );
    
	# create hashref for Role::DataFile::slurp_file_contents():
	my %request = (
		request_number => int($req_number), # get rid of leading zeros
		year => 2000 + $yr, 
	); # $self->debug(\%request);	

	# get file contents from data file (as arrayref of rows):
	my $file_contents = $self->slurp_file_contents(\%request, $data_file);
	# $self->debug($file_contents);
	
	return $file_contents;	
}

#-------------------------------------------------------------------------------
sub parse_data_file {
	my ($self, $file_contents) = @_; # warn Dumper $file_contents;
	
	# capture content after 1st tab:
	my @data = map {
		s/\"|\r|\n//g; # remove quote marks & line-endings (win & unix)
		/^.*\t(.*)$/; # capture content after 1st tab
	} @$file_contents; # $self->debug(\@data);	

	# add to $self->datafile_params:
	$self->add_datafile_param($_) for @data;
}

#-------------------------------------------------------------------------------
# checks datafile params match expected values, sets 'param_mismatch()' on error:
sub check_datafile_integrity {
	my $self = shift;

	# get datafile params: 
	my $data = $self->datafile_params; # warn Dumper $data;
	
    # get request_type (ie currently HIV, RIT or CMP):
    my $request_type = $self->stash->{request_type}; # set in parse_data_file()

	my $request_id = $self->param('id'); # also available in stash->{id};

 	# get patient object:
	my $patient
		= $self->model('Patient')->get_patient_from_request_id($request_id);

	{ # check datafile filename matches its internal filename ref:
        # get array index position for 'filename' field:
		my $array_index = $self->_get_array_index_for_param('filename');
        # get value of 'filename' field:
		my $internal_file_id = $data->[$array_index]; # warn $internal_file_id;
        
        unless ($internal_file_id) {
            $self->add_param_mismatch('missing_filename');
        }
        else {
            # get datafile name (set in parse_data_file()):
            my $data_file_id = $self->stash->{data_file_id}; # warn $data_file_id;
    
            # check internal_file_id matches data_file_id:
            unless ( $internal_file_id eq $data_file_id ) {
                $self->add_param_mismatch('filename_error');
            }
        }
	}
	
	{ # check datafile 'surname' field matches patient last_name:
        # get array index position for 'surname' field:
		my $array_index = $self->_get_array_index_for_param('last_name');
        # get value of 'last_name' field:
		my $val = $data->[$array_index];
        
        unless ($val) {
            $self->add_param_mismatch('missing_name');
        }
        else { # warn $val; warn $patient->last_name;    
            # check datafile surname val matches patient last_name:
            if ( lc $val ne $patient->last_name ) {
                $self->add_param_mismatch('surname_error');
            }
        }
	}
	
	{ # check datafile 'dob' field matches patient dob:
        # get array index position for 'dob' field:
		my $array_index = $self->_get_array_index_for_param('dob'); # warn $array_index;
        
        # get value of 'dob' field:
		my $val = $data->[$array_index];
        
        unless ($val) {
            $self->add_param_mismatch('missing_dob'); 
        }
        else { # warn $val; warn $patient->dob;
            # get day, month & year vals from 'dob' field:
            my ($d,$m,$y) = $val =~ /(\d{2})(\d{2})(\d{4})/; # eg 01121974
            my $dob;
            eval { # will fail if day, month or year invalid or out-of-range:                    
                $dob = DateTime->new(year => $y, month => $m, day => $d);               
            };
            if ($@) {
                $self->add_param_mismatch('invalid_date');
            }
            elsif ( $dob ne $patient->dob ) {
                $self->add_param_mismatch('dob_error');
            }
        }
	}
	
	if ( $self->has_param_mismatch ) {
		my @error_names = $self->all_mismatches;
		return \@error_names;
	}	
}

#-------------------------------------------------------------------------------
sub get_datafile_results {
    my $self = shift;
    
	# get datafile params: 
	my $data = $self->datafile_params; # warn Dumper $data;
    
    # get array indexes for first and last result:
	my $array_index_start = $self->_get_array_index_for_param('result_first');
	my $array_index_end   = $self->_get_array_index_for_param('result_last');
    
    my @results = map {
        $data->[$_];
    } ($array_index_start .. $array_index_end); # warn $results;
    
    return \@results;
}

#-------------------------------------------------------------------------------
sub get_date_acquired {
    my $self = shift;

	# get datafile params: 
	my $data = $self->datafile_params;
    
    # get array index for 'date_acquired' field:
    my $array_index = $self->_get_array_index_for_param('date_acquired');
    
    # get 'date_acquired' val:
    my $val = $data->[$array_index]; # warn $val; # eg 21-Jul-2009 10:59:09
    
    # check format or parsedate() will probably throw fatal error:
    $val =~ /\d{2}-\w{3}-\d{4} \d{2}:\d{2}:\d{2}/ || return 0;
    
    # create DateTime object using Time::ParseDate::parsedate():
    my $dt = LIMS::Local::Utils::to_datetime_using_parsedate($val); # warn $dt;
    
    return $dt;
}

#-------------------------------------------------------------------------------
sub check_lab_test_requested {
    my $self = shift;
    my $args = shift; # warn Dumper $args;

    my $ok = $self->model('Result')->check_request_lab_test($args);
    return $ok; # returns true if lab-test *has* been requested
}

#-------------------------------------------------------------------------------
sub get_analysis_user {
    my $self = shift;

	# get datafile params: 
	my $data = $self->datafile_params;

    # get array index for 'acquired_by' field:
    my $array_index = $self->_get_array_index_for_param('acquired_by');

    # get 'acquired_by' username:
    my $username = $data->[$array_index]; # warn $username; 
    
    return $username;
}

#-------------------------------------------------------------------------------
sub get_analysis_user_id {
    my ($self, $username) = @_; # warn Dumper $username;

    # get map of ( username => id ) for all users:
    my $users_map = $self->_get_users_map; # warn Dumper $users_map;
    
    # get user_id from users_map:
    my $user_id = $users_map->{lc $username};
    
    return $user_id;
}

#-------------------------------------------------------------------------------
sub get_lab_test_data {
    my $self = shift;

    # get request_type (eg HIV or RIT):
    my $request_type = $self->stash->{request_type}; # set in parse_data_file()
	
	# get datafile settings as hashref (or return if no settings):
	my $datafile_cfg = $self->datafiles_config || return 0;

	# get lab_test data from datafile cfg:
	my $lab_test = $datafile_cfg->{$request_type}->{lab_test};
	
	# return empty unless sign-off required:
	return $lab_test->{sign_off} ? $lab_test : 0;	
}

#-------------------------------------------------------------------------------
sub get_report_params {
    my $self = shift;
    
	# get datafile params: 
	my $data = $self->datafile_params;

    # get request_type (eg HIV or RIT):
    my $request_type = $self->stash->{request_type}; # set in parse_data_file()
    
	# get datafile settings as hashref:
	my $datafile_cfg = $self->datafiles_config;

	my $cfg_data = $datafile_cfg->{$request_type}->{report};
	
	my %params;
	
	# get data from datafile fields, or from datafile config:
	my @fields = qw(comment clinical_details specimen_quality status diagnosis);
	foreach my $field(@fields) {
		# get array index for field:
		my $array_index = $self->_get_array_index_for_param($field);
		
		# if array index, get data from datafile, else from config file:
		my $param = $array_index 
			? $data->[$array_index] # load param from datafile     
			: $cfg_data->{$field};  # load param from config file
			
		$params{$field} = $param;
	}

    return \%params;
}

#-------------------------------------------------------------------------------
sub get_lab_section {
    my $self = shift;
    
    # get request_type (eg HIV or RIT):
    my $request_type = $self->stash->{request_type}; # set in parse_data_file()
	
	# get datafile settings as hashref:
	my $datafile_cfg = $self->datafiles_config;

	# get result_section from datafile cfg:
	my $lab_section = $datafile_cfg->{$request_type}->{result_section};

	# return lab_section:
    return $lab_section;
}

#-------------------------------------------------------------------------------
sub _get_array_index_for_param {
    my ($self, $param) = @_;
    
    # get request_type (ie currently HIV, RIT, CMP):
    my $request_type = $self->stash->{request_type}; # set in parse_data_file()

    # get map of ( field name => array position ) for datafiles:
	my $field_map = $self->datafile_field_map; # warn Dumper $field_map;		

    # return array index for field:
    return $field_map->{$request_type}->{$param};
}

#-------------------------------------------------------------------------------
sub _get_users_map {
    my $self = shift;
    
    my $users = $self->model('Base')->get_objects('User');
    
    my %map = map { $_->username => $_->id } @$users;
    
    return \%map;
}

#-------------------------------------------------------------------------------
sub _build_datafile_field_map {
	my $self = shift;

	# get settings as hashref:
	my $settings = $self->datafiles_config;

	my %map = ();	
	while ( my($type, $data) = each %$settings ) {
		my $i = 0; # reset counter
		my $fields = $data->{fields};
		map { $map{$type}{$_} = $i++ } @$fields; 
	} # $self->debug(\%map);

	return \%map;
}

#-------------------------------------------------------------------------------
sub _build_datafiles_config {
	my $self = shift;
	
	my $yaml = $self->get_yaml_file('datafiles') || return 0;
	return $yaml;
}

1;