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