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;
}