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 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 ; # 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!!, RootName => 'ulisa', NoAttr => 1, SuppressEmpty => 0, # ? only works for xml_in KeyAttr => [], ); return \%opts; } sub _build_script_helpers { LIMS::Local::ScriptHelpers->new } 1; __DATA__ Norbert Colon 87 2 CD20 88 2 ki-67