• 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;
    
    my $xs = XML::Simple->new();
    
    my %xs_opts = %{ $self->xs_options }; # warn Dumper $opts; # needs hash
    
    my $ref = $self->_format($data);
    my $input = { add => $ref }; # enclose data in outer <add> attr
   	my $xml_out = $xs->XMLout( $input, %xs_opts ); # warn Dumper $xml_out;
    
=begin # uncomment to see data structure for example xml:    
    my $data = q!
    <add>
        <case caseid="H12345678">
            <firstname>Herbert</firstname> 
            <lastname>Meier</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>!;

    my $foo = XMLin($data, ForceArray => 1, KeyAttr => []); warn Dumper $foo;
=cut    
    
    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}->{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 $lab_number = join '/',
        $request->{request_number}, $request->{year} - 2000;
    
    my %h = (
        requestid    => $request->{id},
        caseid       => $lab_number,
        firstname    => $patient->{first_name},
        lastname     => $patient->{last_name},
    );
    
    for my $ref (@$lab_test) { # warn Dumper $ref;
        # create slide id from request.id & test.id (can't use request_lab_test_status.id
        # if originally requested panel):
        my $slide_id = join '/', $request->{id}, $ref->{test_id};

        push @{ $h{slides}{slide} }, {
            caseid     => $lab_number,
            slideid    => $slide_id,
            protocol   => $ref->{test_name},
            slidetype  => 2, # IHC
		};
    } # warn Dumper \%h;
    return \%h; 
}

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;