This virtual counter uses a socket connection to communicate with an external server.
Here is the VC code:
if( $method =~ /reset/i) { ADQ1600::reset_ADQ1600( $Spectra::SYM{ scan_name}, $Spectra::SYM{ sindex}); return 1; } if( $method =~ /read/i) { return ADQ1600::read_ADQ1600(); }
The module ADQ1600 is defined in /online_dir/TkIrc.pl:
# # ADQ1600: WP76 (XFEL) # package ADQ1600; use strict; use IO::Socket::INET; use IO::Select; use Spectra; our $node = "exflXXX.desy.de"; our $port = 23; sub open_ADQ1600 { my $status = 1; $Util::res_h{ sock_ADQ1600} = IO::Socket::INET->new(PeerAddr => $node, PeerPort => $port, Proto => 'tcp', Type => SOCK_STREAM); if( !$Util::res_h{ sock_ADQ1600}) { $status = Spectra::error( "open_ADQ1600: failed to connect to $node port $port"); goto finish; } my $res = recv_ADQ1600(); print "open_ADQ1600: welcome msg, $res \n"; finish: return $status; } sub close_ADQ1600 { my $status = 1; send_ADQ1600( "exit"); close( $Util::res_h{ sock_ADQ1600}); delete $Util::res_h{ sock_ADQ1600}; finish: return $status; } sub send_ADQ1600 { my ( $argin) = @_; my $status = 1; if( !defined( $Util::res_h{ sock_ADQ1600})) { if( !open_ADQ1600()) { $status = Spectra::error( "send_ADQ1600: open_ADQ1600 returned error"); goto finish; } } $argin =~ s/^\s*(.*?)\s*$/$1/; $argin .= "\015\012"; $status = $Util::res_h{ sock_ADQ1600}->send( $argin); finish: return $status; } sub recv_ADQ1600 { my $argout; my $status = 1; if( !defined( $Util::res_h{ sock_ADQ1600})) { if( !open_ADQ1600()) { $status = Spectra::error( "recv_ADQ1600: open_ADQ1600 returned error"); goto finish; } } my $s = new IO::Select(); $s->add( $Util::resh_h{ sock_ADQ1600}); $argout = ""; my $buffer; while( !length( $argout) || $s->can_read(0.1)) { $Util::res_h{ sock_ADQ1600}->recv( $buffer, 100); $argout .= $buffer; $buffer = ""; } $argout =~ s/^\s*(.*?)\s*$/$1/; return $argout; } sub read_ADQ1600 { send_ADQ1600( "read"); my $res = recv_ADQ1600(); return $res; } sub read_ADQ1600_laser { send_ADQ1600( "read laser"); my $res = recv_ADQ1600(); return $res; } sub reset_ADQ1600 { my ( $sname, $index, $st) = @_; my $cmd = sprintf( "reset %s_%05d", $sname, $index); send_ADQ1600( $cmd); my $res = recv_ADQ1600(); my $ret = 0; if( $res =~ /done/i) { $ret = 1; } return $ret; }