package LIMS::Controller::DataImport; use base 'LIMS::Base'; use Moose; with 'LIMS::Controller::Roles::DataFile'; has temp_files_sub_dir => ( is => 'rw', isa => 'Str' ); __PACKAGE__->meta->make_immutable(inline_constructor => 0); use IO::All; use Data::Dumper; use File::Basename; use LIMS::Local::Utils; use Regexp::Common 'RE_num_ALL'; # all 'num' methods use LIMS::Local::ExcelHandler; use constant MAX_FILE_SIZE => 50_000 * 1_024; # Limit upload to 50MB use constant TMP_DIR => 'src/data/tmp_files'; # relative path below app root #------------------------------------------------------------------------------- sub default : StartRunmode { my $self = shift; # shouldn't be called here - redirect to / $self->redirect( $self->query->url ); } #------------------------------------------------------------------------------- sub bcr_abl : Runmode { # run /wdir/Q922_data.zip test file my $self = shift; # if 1st call to method, or no file uploaded: $self->query->param('source') || return $self->tt_process(); # warn $self->query->param('source'); # process zip file upload & get IO::All object for contents of upload/extract # dir (sets flash msg & returns empty on failure): my $io = $self->_process_upload('bcr_abl') || return $self->tt_process(); # spreadsheet field defs: my %f = ( WELL => 0, # plate well id, eg A1-12, B1-12, etc LAB_REF => 1, # lab_no & surname TARGET => 2, # ABL / BCR ABL CT => 6, # cycle threshold QUANTITY => 9, # ); my $xl = LIMS::Local::ExcelHandler->new(); # $self->debug($xl); my %data; CONTENT : foreach my $content ($io->all) { # skip non-XL files: next CONTENT unless $content->filename =~ /\.xls\Z/; # warn $content->filename; my $file = $content->name; # name() = path/to/file my $data = $xl->parse_xl_file($file); # warn Dumper $data; # AoA # open my $fh, '>data.txt'; print $fh Dumper $data; # skip file unless it's a BCR-ABL file: # next CONTENT unless $data->[0]->[0] eq ''; ROW: for my $row (@$data) { # parse each row: # require labno & name in LAB_REF: my $sample_ref = $row->[ $f{LAB_REF} ] || next ROW; # warn $sample_ref; my ($labno, $surname) = $sample_ref =~ /(H\d+\/\d{2}) (.*)/; next ROW unless $labno && $surname; # warn Dumper [ $labno, $surname ]; $surname = LIMS::Local::Utils::trim($surname); # trim pre & post spaces # add surname entry (& check matches from previous rows): if ( my $existing = $data{$labno}{surname} ) { $data{$labno}{error}++ unless $surname eq $existing; } else { $data{$labno}{sample_name} = lc $surname; } # get some data vals: my $quantity = $row->[ $f{QUANTITY} ]; # warn $quantity; my $target = $row->[ $f{TARGET} ]; my $ct = $row->[ $f{CT} ]; # force quantity value to 0 if CT not numerical (int or decimal): $quantity = 0 unless $ct =~ RE_num_real(); # warn $quantity; # sum quantity values for targets (ABL & BCR-ABL) for each sample: $data{$labno}{copy_number}{$target} += $quantity; } } { # get request & patient data for all samples in %data: while ( my ($labno, $data) = each %data ) { my ($request_number, $year) = LIMS::Local::Utils::split_labno($labno); my @args = ( request_number => $request_number, year => $year ); my $request = $self->model('Request')->get_patient_and_request_data(\@args); $data->{request_data} = $request->as_tree; # warn Dumper $request->as_tree; } } # clean up: $self->_clean_up($io); return $self->tt_process('dataimport/bcr_abl_data.tt', { data => \%data }); } #--------------------------- private methods ----------------------------------- sub _process_upload { my ($self, $sub_dir) = @_; my $src_file = $self->query->upload('source'); # CGI method my $filename = fileparse($src_file); # warn $filename; # expect one of following suffixes: my ($suffix) = $filename =~ /(zip|xls)\Z/; unless ($suffix) { # zip or xls file $self->flash( error => $self->messages('file_upload')->{unsuitable_filetype} ); return 0; } # set sub-directory for upload file processing - all files deleted afterwards: $self->temp_files_sub_dir($sub_dir); my $files_dir = $self->_get_temp_files_dir; # params for process_file_upload() & LIMS::Local::Utils::unzip_file(): my %args = ( target_dir => $files_dir, src_file => $src_file, # filename in scalar context, else fh filename => $filename, ); # write uploaded content to disk: $self->process_file_upload(\%args) || return $self->error( 'process_file_upload() did not return successfully' ); if ( $suffix eq 'zip' ) { # unzip if required: # method returns contents of zip file: my $zip_contents = LIMS::Local::Utils::unzip_file(\%args); # stuff zip_contents into stash: $self->stash->{zip_contents} = $zip_contents; } # return IO::All object of target files dir: if ( my $io = io($files_dir) ) { return $io; } else { $self->flash( error => 'could not read contents of upload directory' ); return 0; } } # where to extract zip file: sub _get_temp_files_dir { my $self = shift; my $path_to_temp_files = join '/', $self->cfg('path_to_app_root'), TMP_DIR , $self->temp_files_sub_dir; return $path_to_temp_files; } # delete all from unzip dir: sub _clean_up { my ($self, $io) = @_; foreach ($io->all) { # warn $_->name; # if $_->is_file; $_->unlink if $_->is_file; } } 1;