• Files
• Commits
• Log
• Graph
• Stats

package LIMS::Controller::Roles::ULISA;

use Moose::Role;
use Data::Dumper;
use IO::All;

use XML::Simple qw(:strict); # need to specify ForceArray & KeyAttr if using :strict here
use LIMS::Local::ScriptHelpers; # ftp_file

has script_helpers => ( is => 'ro', isa => 'LIMS::Local::ScriptHelpers',
    lazy_build => 1 );
has xs_options => ( is => 'ro', isa => 'HashRef', lazy_build => 1 );

sub send_ulisa {
    my ($self, $data) = @_; # warn Dumper $data;
    
    # $self->_example_data(); # uncomment to dump data structure for example xml
    
    my $xs = XML::Simple->new();    
    
    # options for XMLout (needs hash):
    my %xs_opts = %{ $self->xs_options }; # warn Dumper $opts;
    
    # munge $data into hashref format expected by XMLout:
    my $ref = $self->_format($data);

    my $input = { add => $ref }; # enclose xml in outer <add> block
   	my $xml_out = $xs->XMLout( $input, %xs_opts ); # warn Dumper $xml_out;
    
    my %h = ( data => $ref, xml => $xml_out );
    my $rtn = $self->_ftp_file(\%h);
}

sub _ftp_file {
    my ($self, $args) = @_; # href (data href & xml str)

    my $request_id = $args->{data}->{case}->{requestid};
    my $content    = $args->{xml}; # warn $content;

    my $tools = $self->script_helpers(); # warn Dumper $tools;
    my $cfg   = $self->cfg('settings');  # warn Dumper $cfg;
    
    my $filename = sprintf '%s.xml', $request_id;
    my $src_path = '/tmp/' . $filename;

    $content > io($src_path);
    
    my %params = (
        local_filename  => $src_path,
        remote_filename => $filename,
        server_addr     => $cfg->{dako_link_addr},
        username        => $cfg->{dako_link_user},
        password        => $cfg->{dako_link_pwd},
    ); # warn Dumper \%params;

    # ftp file (returns str on failure, undef on success):
    my $rtn = $tools->ftp_file(\%params);

    if ($rtn) { # warn Dumper $rtn;
       return $rtn;
    }
    else {
        io($src_path)->unlink;
        return 0;
    }
}     

sub _format { # returns hashref:
    my $self = shift;
    my $data = shift;

    my $request  = $data->{request};
    my $patient  = $data->{patient};
    my $lab_test = $data->{lab_test};
    
    my $now = LIMS::Local::Utils::time_now->epoch; # warn $now;

    my @slides;
    for my $ref (@$lab_test) { # warn Dumper $ref;
        # create unique slide ID from request.id, test.id & epoch (max 32 chars):
        my $slide_id = sprintf 'R%sT%sE%s',
            $request->{id}, $ref->{test_id}, $now;

        push @slides, {
            slideid    => $slide_id,
            protocol   => $ref->{test_name},
            slidetype  => 2, # IHC
		};
    }

    my $lab_number = join '/',
        $request->{request_number}, $request->{year} - 2000;
    
    my %h; # hash data structure for input to XMLout
    {
        $h{case} = {
            requestid => $request->{id},
            firstname => $patient->{first_name},
            lastname  => $patient->{last_name},
            caseid    => $lab_number,
        };
        # add slides data:
        $h{slides}{caseid} = $lab_number; # slides section needs caseid
        $h{slides}{slide}  = \@slides;
    }; # warn Dumper \%h;
    return \%h; 
}

sub _example_data {
    my $self = shift;
    
    my $xs = XML::Simple->new();
    my %opts = %{ $self->xs_options }; # warn Dumper $opts;
    
    my $data; $data .= $_ for <DATA>; # warn $data;

    my $foo = XMLin($data, ForceArray => 1, KeyAttr => []); warn Dumper $foo;
    my $bar = $xs->XMLout( $foo, %opts );  warn Dumper $bar;
}

sub _build_xs_options {
    my %opts = (
        XMLDecl         => q!<?xml version="1.0" encoding="UTF-8"?>!,
        RootName        => 'ulisa',
        NoAttr          => 1,
        SuppressEmpty   => 0, # ? only works for xml_in
        KeyAttr         => [],
    );
    return \%opts;
}

sub _build_script_helpers { LIMS::Local::ScriptHelpers->new }

1;

__DATA__
<add>
    <case caseid="H12345678">
        <firstname>Norbert</firstname> 
        <lastname>Colon</lastname> 
    </case>
    <slides caseid="H12345678">
        <slide>
            <slideid>87</slideid>
            <slidetype>2</slidetype>
            <protocol>CD20</protocol>
        </slide>
        <slide>
            <slideid>88</slideid>
            <slidetype>2</slidetype>
            <protocol>ki-67</protocol>
        </slide>
    </slides>
</add>