=begin # telnet command: telnet 163.160.214.206 5900 Intellicode.Instrument.Profile.load( fluidx [48|96].xtprof ) Intellicode.Instrument.Profile.scan Intellicode.Instrument.Profile.Exporter.getResults(xml_exporter) =cut use List::Util; use Net::Telnet; use XML::LibXML; use Modern::Perl; use Data::Printer; use Sort::Naturally; use XML::Simple qw(:strict); use Time::HiRes qw(gettimeofday tv_interval); use Getopt::Std; getopts('p:'); # (p)late type - 48 or 96 our($opt_p); # warn $opt_p; exit; my $plate_type = $opt_p or die "require plate-type (48 or 96)"; grep { $plate_type == $_ } (48, 96) or die "plate-type must be 48 or 96"; my ($host,$port) = split /:/, # '163.160.119.21:2001'; # genomics # '163.160.215.218:2001'; # hmds xtr-96 '163.160.214.206:5900'; # hmds intellicode my $t0 = [gettimeofday]; do_intellicode_method(); # do_buffer_method(); # works for both # do_waitfor_method(); # only reliably works for xtr-96 using /H12,(.*)/ # do_cmd_method(); # doesn't work say sprintf 'finished: %.2f sec', tv_interval $t0, [gettimeofday]; # works for both XTR-96 & Intellicode: sub do_buffer_method { # original HILIS method - uses buffer(): my @args = ( Timeout => 15, Errmode => 'return', # don't die (default) Input_Log => './xtr-96.log', # uncomment to debug ); my $t = connect_and_get(@args); # direct manipulation of buffer easier than documented methods!! my $ref = $t->buffer; # p $ref; say $t->errmsg if $t->errmsg; $t->close; do_extract(${$ref}); # send deref'd string say "do_buffer_method for $host"; ; } # works for both using /H12,(.*)/ for XTR-96, and using /(.*)/ for Intellicode sometimes!!: sub do_waitfor_method { # new HILIS method - uses waitfor(): my @args = ( # Timeout => 15, done in waitfor() now otherwise processes delay until $secs Errmode => 'return', # don't die (default) Input_Log => './xtr-96.log', # uncomment to debug ); my $t = connect_and_get(@args); =begin # this works for both but on 96-well only (can't use less than H12 as it'll send as soon as /$re/): my $re = qr{H12,(.*)}; # end of output = H12, my ($prematch, $match) = $t->waitfor(Match => "/$re/", Timeout => undef); # no timeout my $output = join '', $prematch, $match; =cut #=begin # this (sometimes!!) works for Intellicode only (xtr-96 gives empty $output): my $re = qr{(.*)}; my ($output) = $t->waitfor(Match => "/$re/", Timeout => undef); # no timeout #=cut say $t->errmsg if $t->errmsg; $t->close; # p $output; do_extract($output); say "do_waitfor_method for $host"; } sub do_cmd_method { my $t = Net::Telnet->new(@_); my @host = ( Host => $host, Port => $port ); unless ( $t->open(@host) ) { # returns 1 on success, 0 on failure: die $t->errmsg; } my $ref; my @data = $t->getlines(Timeout => 30); p @data; my $line = $t->lastline; p $line; $t->dump_log(); } sub do_intellicode_method { # return extract_xml( _read_xml() ); my @args = ( # Timeout => 15, done in waitfor() now otherwise processes delay until $secs Errmode => 'return', # don't die (default) # Input_Log => './xtr-96.log', # uncomment to debug ); my $t = Net::Telnet->new(@args); $t->input_log('telnet.log'); my @host = ( Host => $host, Port => $port ); # p @host; unless ( $t->open(@host) ) { # returns 1 on success, 0 on failure: die $t->errmsg; } # initiate plate read: say sprintf 'opened ftp connection: %.2f sec', tv_interval $t0, [gettimeofday]; $t->cmd( String => "Intellicode.Instrument.Profile.load( fluidx $plate_type.xtprof )", Timeout => 0 ); $t->waitfor(String => 'success:load'); say sprintf 'profile loaded, initiating scan: %.2f sec', tv_interval $t0, [gettimeofday]; $t->cmd( String => 'Intellicode.Instrument.Profile.scan', Timeout => 0, ); # p $t; $t->waitfor(String => 'success:scan'); say sprintf 'completed scan: %.2f sec', tv_interval $t0, [gettimeofday]; # get results: $t->cmd( String => 'Intellicode.Instrument.Profile.Exporter.getResults(xml_exporter)', Timeout => 0, ); # p $t; my $ref = $t->buffer; # p $ref; # captures all output my ($prematch, $match) = $t->waitfor(String => 'success:getResults'); say sprintf 'returned results: %.2f sec', tv_interval $t0, [gettimeofday]; unless ($prematch) { # warn 'here'; die ${ $t->buffer }; # send this back as error } # p $prematch; my ($xml) = $prematch =~ /msg:(.*)/ms; # p $xml; $t->input_log(''); my $plate_data = extract_xml($xml); # p $plate_data; say sprintf 'extracted xml: %.2f sec', tv_interval $t0, [gettimeofday]; } sub extract_xml { # original intellicode xml my $xml = shift; # p $xml; my $ref = XMLin($xml, ForceArray => 0, KeyAttr => []); # p $ref; exit; my ($plate_id) = map $ref->{$_}, # linear or 2-d barcode reading: grep { $ref->{$_} =~ /\w+?\d+/ } qw/idlbc id2d/; my $well_data = $ref->{well}; my %h = ( plateId => $plate_id ); for my $well(@$well_data) { # p $well; next; my $well_id = $well->{id}; my $value = $well->{value}; $h{data}{$well_id} = $value; } { # calculate max well position (D6, F8 or H12): my @wells = Sort::Naturally::nsort( keys %{ $h{data} } ); # p @wells; my @alphanum_max = $wells[-1] =~ /([a-z])(\d+)/i; # p @alphanum_max; @{ $h{well_max} }{ qw/alpha_max numbr_max/ } = @alphanum_max; } p %h; return \%h; } =begin sub _extract_xml { # original intellicode xml my $xml = shift; my $ref = XMLin($xml, ForceArray => 0, KeyAttr => []); p $ref; exit; my $data = $ref->{ValueList} ->{NvPair} ->[0] ->{ValueList} ->{NvPair} ->[0] ->{ValueList} ->{NvPair} ; # p $data; my %h; for my $well(@$data) { # p $well; next; my $well_name = $well->{Name}; my $result = $well->{ValueList}->{NvPair}->{Name}; if ($well_name =~ /Count/) { # FailCount, SuccessCount $h{outcome}{$well_name} = $result; next; } $h{data}{$well_name} = $result; } # p %h; return \%h; } =cut sub do_extract { my $string = shift; # say $string; die '$string empty' unless $string; my ($plateId, $str) = $string =~ /Rack Identifier = ([A-Z0-9]+)\s+(A01,.*)/; say sprintf qq!cannot extract data from output: $string! and return 0 unless $str; $str =~ s/\s//g; # remove (arbitrary?) spaces my %plate_data = split /,\s?/, $str; p %plate_data; p $plateId; } sub connect_and_get { my $t = Net::Telnet->new(@_); my @host = ( Host => $host, Port => $port ); unless ( $t->open(@host) ) { # returns 1 on success, 0 on failure: die $t->errmsg; } # initiate plate read: $t->cmd('get'); return $t; } sub _read_xml { return q! !; } =begin # original intellicode output: sub _read_xml { return q! 0 Root 0 imager 8 rack 0 SuccessCount 0 96 0 FailCount 0 0 0 A1 34 1035165120 0 A2 34 1035165128 0 A3 34 1035165136 0 A4 34 1035165144 0 A5 34 1035165152 0 A6 34 1035165160 0 A7 34 1035165168 0 A8 34 1035165176 0 A9 34 1035165184 0 A10 34 1035165192 0 A11 34 1035165200 0 A12 34 1035165208 0 B1 34 1035165121 0 B2 34 1035165129 0 B3 34 1035165137 0 B4 34 1035165145 0 B5 34 1035165153 0 B6 34 1035165161 0 B7 34 1035165169 0 B8 34 1035165177 0 B9 34 1035165185 0 B10 34 1035165193 0 B11 34 1035165201 0 B12 34 1035165209 0 C1 34 1035165122 0 C2 34 1035165130 0 C3 34 1035165138 0 C4 34 1035165146 0 C5 34 1035165154 0 C6 34 1035165162 0 C7 34 1035165170 0 C8 34 1035165178 0 C9 34 1035165186 0 C10 34 1035165194 0 C11 34 1035165202 0 C12 34 1035165210 0 D1 34 1035165123 0 D2 34 1035165131 0 D3 34 1035165139 0 D4 34 1035165147 0 D5 34 1035165155 0 D6 34 1035165163 0 D7 34 1035165171 0 D8 34 1035165179 0 D9 34 1035165187 0 D10 34 1035165195 0 D11 34 1035165203 0 D12 34 1035165211 0 E1 34 1035165124 0 E2 34 1035165132 0 E3 34 1035165140 0 E4 34 1035165148 0 E5 34 1035165156 0 E6 34 1035165164 0 E7 34 1035165172 0 E8 34 1035165180 0 E9 34 1035165188 0 E10 34 1035165196 0 E11 34 1035165204 0 E12 34 1035165212 0 F1 34 1035165125 0 F2 34 1035165133 0 F3 34 1035165141 0 F4 34 1035165149 0 F5 34 1035165157 0 F6 34 1035165165 0 F7 34 1035165173 0 F8 34 1035165181 0 F9 34 1035165189 0 F10 34 1035165197 0 F11 34 1035165205 0 F12 34 1035165213 0 G1 34 1035165126 0 G2 34 1035165134 0 G3 34 1035165142 0 G4 34 1035165150 0 G5 34 1035165158 0 G6 34 1035165166 0 G7 34 1035165174 0 G8 34 1035165182 0 G9 34 1035165190 0 G10 34 1035165198 0 G11 34 1035165206 0 G12 34 1035165214 0 H1 34 1035165127 0 H2 34 1035165135 0 H3 34 1035165143 0 H4 34 1035165151 0 H5 34 1035165159 0 H6 34 1035165167 0 H7 34 1035165215 0 H8 34 1035165207 0 H9 34 1035165199 0 H10 34 1035165191 0 H11 34 1035165183 0 H12 34 1035165175 0 2d_rackid_1 0 ID 33 SA00584054 0 UserName 0 cooperdd 0 MachineName 0 LTH203595 0 Time 0 04 July 2018 !; } =cut __END__ Intellicode output using: my $re = qr{(.*)$}; my ($output) = $t->waitfor(Match => "/$re/", Timeout => undef); ===================================================================== xtr-96 Connected Reading... Rack Identifier = SA00136849 A01, FR09988928, A02, FR09988848, A03, FR09988856, A04, FR09988864, A05, FR09988872, A06, FR09988880, A07, FR09988888, A08, FR09988896, A09, FR09988904, A10, FR09988912, A11, FR09988920, A12, FR09988891, B01, FR09988841, B02, FR09988849, B03, FR09988857, B04, FR09988865, B05, FR09988873, B06, FR09988881, B07, FR09988889, B08, FR09988897, B09, FR09988905, B10, FR09988913, B11, FR09988921, B12, FR09988929, C01, FR09988842, C02, FR09988850, C03, FR09988858, C04, FR09988866, C05, FR09988874, C06, FR09988882, C07, FR09988890, C08, FR09988898, C09, FR09988906, C10, FR09988914, C11, FR09988922, C12, FR09988930, D01, FR09988843, D02, FR09988851, D03, FR09988859, D04, FR09988867, D05, FR09988875, D06, FR09988883, D07, FR09988847, D08, FR09988899, D09, FR09988907, D10, FR09988915, D11, FR09988923, D12, FR09988931, E01, FR09988844, E02, FR09988852, E03, FR09988860, E04, FR09988868, E05, FR09988876, E06, FR09988884, E07, FR09988892, E08, FR09988900, E09, FR09988908, E10, FR09988916, E11, FR09988924, E12, FR09988932, F01, FR09988845, F02, FR09988853, F03, FR09988861, F04, FR09988869, F05, FR09988877, F06, FR09988885, F07, FR09988893, F08, FR09988901, F09, FR09988909, F10, FR09988917, F11, FR09988925, F12, FR09988933, G01, FR09988846, G02, FR09988854, G03, FR09988862, G04, FR09988870, G05, FR09988878, G06, FR09988886, G07, FR09988894, G08, FR09988902, G09, FR09988910, G10, FR09988918, G11, FR09988926, G12, FR09988934, H01, FR09988935, H02, FR09988855, H03, FR09988863, H04, FR09988871, H05, FR09988879, H06, FR09988887, H07, FR09988895, H08, FR09988903, H09, NO TUBE, H10, 1025448211, H11, 1025448489, H12, 1025448243 ===================================================================== XTR-96 output using: my $re = qr{H12,(.*)$}; # end of output = H12, my ($prematch, $match) = $t->waitfor(Match => "/$re/", Timeout => undef); # no timeout my $output = join '', $prematch, $match; ===================================================================== xtr-96 ConnectedReading...Rack Identifier = SA00083770 A01,No Tube,B01,1020861345,C01,1020861346,D01,1020861347,E01,1020861348,F01,1020861349,G01,1020861350,H01,1020861351,A02,No Tube,B02,1020861353,C02,1020861354,D02,1020861355,E02,1020861356,F02,1020861357,G02,1020861358,H02,1020861359,A03,No Tube,B03,1020861361,C03,1020861362,D03,1020861363,E03,1020861364,F03,1020861365,G03,1020861366,H03,1020861367,A04,No Tube,B04,1020861369,C04,1020861370,D04,1020861371,E04,1020861372,F04,1020861373,G04,1020861374,H04,1020861375,A05,No Tube,B05,1020861377,C05,1020861378,D05,1020861379,E05,1020861380,F05,1020861381,G05,1020861382,H05,1020861383,A06,No Tube,B06,1020861385,C06,1020861386,D06,1020861387,E06,1020861388,F06,1020861389,G06,1020861390,H06,1020861391,A07,No Tube,B07,1020861393,C07,1020861394,D07,1020861395,E07,1020861396,F07,1020861397,G07,1020861398,H07,1020861399,A08,No Tube,B08,1020861401,C08,1020861402,D08,1020861403,E08,1020861404,F08,1020861405,G08,1020861406,H08,1020861407,A09,No Tube,B09,1020861409,C09,1020861410,D09,1020861411,E09,1020861412,F09,1020861413,G09,1020861414,H09,1020861415,A10,No Tube,B10,1020861417,C10,1020861418,D10,1020861419,E10,1020861420,F10,1020861421,G10,1020861422,H10,1020861423,A11,1020861424,B11,1020861425,C11,1020861426,D11,1020861427,E11,1020861428,F11,1020861429,G11,1020861430,H11,1020861431,A12,1020861432,B12,1020861433,C12,1020861434,D12,1020861435,E12,1020861436,F12,1020861437,G12,1020861438,H12,1020861439 =====================================================================