• Files
• Commits
• Log
• Graph
• Stats

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->[2]->[1] =~ /Q922/; # Experiment File field
        
        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 = lc LIMS::Local::Utils::trim($surname); # trim pre & post spaces
            
            # add surname entry (& check matches from previous rows):
            if ( my $existing = $data{$labno}{sample_name} ) { 
                $data{$labno}{error}++ unless $surname eq $existing;
                # warn Dumper [$surname , $existing];
            }
            else {
                $data{$labno}{sample_name} = $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} += int $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;