You cannot select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
153 lines
2.7 KiB
Perl
153 lines
2.7 KiB
Perl
##############################################
|
|
|
|
package main;
|
|
|
|
use strict;
|
|
use warnings;
|
|
use Time::HiRes qw(gettimeofday);
|
|
use IPC::Open2;
|
|
|
|
sub FHZ_Write($$$);
|
|
sub FHZ_Read($);
|
|
sub FHZ_Ready($);
|
|
|
|
sub
|
|
EB_Initialize($)
|
|
{
|
|
my ($hash) = @_;
|
|
|
|
# Provider
|
|
$hash->{ReadyFn} = "EB_Ready";
|
|
$hash->{ReadFn} = "EB_Read";
|
|
$hash->{WriteFn} = "EB_Write";
|
|
$hash->{Clients} = ":EB:EBN:";
|
|
|
|
my %mc = (
|
|
"1:EBN" => "^R",
|
|
);
|
|
$hash->{MatchList} = \%mc;
|
|
|
|
# Normal devices
|
|
$hash->{DefFn} = "EB_Define";
|
|
$hash->{UndefFn} = "EB_Undef";
|
|
$hash->{SetFn} = "EB_Set";
|
|
$hash->{AttrList}= "loglevel:0,1,2,3,4,5,6";
|
|
}
|
|
|
|
sub
|
|
EB_Define($$)
|
|
{
|
|
my ($hash, $def) = @_;
|
|
my @a = split("[ \t][ \t]*", $def);
|
|
|
|
Log 3, "$hash->{NAME} define ";
|
|
if(@a < 3 || @a > 3) {
|
|
my $msg = "wrong syntax: define <name> EB {devicename}";
|
|
Log 2, $msg;
|
|
Log 2, @a;
|
|
return $msg;
|
|
}
|
|
my $name = $a[0];
|
|
my $dev = $a[2];
|
|
|
|
$hash->{DeviceName} = $dev;
|
|
|
|
my($pid, $chld_out, $chld_in);
|
|
$pid = open2($chld_out, $chld_in, '/root/ebd -d '.$dev);
|
|
|
|
$hash->{RDPIPE} = $chld_out;
|
|
$hash->{WRPIPE} = $chld_in;
|
|
$hash->{FD} = fileno($chld_out);
|
|
$hash->{PID} = $pid;
|
|
$hash->{STATE} = "Open";
|
|
$selectlist{"$name.pipe"} = $hash;
|
|
return undef;
|
|
}
|
|
|
|
#####################################
|
|
sub
|
|
EB_Undef($$)
|
|
{
|
|
my ($hash, $arg) = @_;
|
|
|
|
Log 3, "$hash->{NAME} undef";
|
|
return if ($hash->{STATE} ne "Open");
|
|
|
|
EB_Write($hash,'Q','');
|
|
|
|
kill $hash->{PID};
|
|
close($hash->{RDPIPE});
|
|
close($hash->{WRPIPE});
|
|
|
|
delete $hash->{FD};
|
|
delete $hash->{RDPIPE};
|
|
delete $hash->{WRPIPE};
|
|
delete $hash->{PID};
|
|
|
|
$hash->{STATE} = "Closed";
|
|
return undef;
|
|
}
|
|
|
|
#####################################
|
|
sub
|
|
EB_Ready($)
|
|
{
|
|
my ($hash,$fn,$msg) = @_;
|
|
Log 5, "$hash->{NAME} ready";
|
|
return 1;
|
|
}
|
|
|
|
#####################################
|
|
sub
|
|
EB_Write($$$)
|
|
{
|
|
my ($hash,$fn,$msg) = @_;
|
|
my ($buf);
|
|
|
|
$buf = $fn . ' ' . $msg;
|
|
Log 5, "$hash->{NAME} write: " . $buf;
|
|
$buf .= "\n";
|
|
syswrite($hash->{WRPIPE}, $buf);
|
|
|
|
return undef;
|
|
}
|
|
|
|
#####################################
|
|
sub
|
|
EB_Read($)
|
|
{
|
|
my ($hash) = @_;
|
|
my ($buf, $res, $nextbyte);
|
|
|
|
|
|
CHAR: while (sysread($hash->{RDPIPE}, $nextbyte, 1)) {
|
|
last CHAR if $nextbyte eq "\n";
|
|
$buf .= $nextbyte;
|
|
}
|
|
|
|
Log 5, "$hash->{NAME} read: " . $buf;
|
|
$hash->{RAWMSG} = $buf;
|
|
Dispatch($hash, $buf, undef);
|
|
return $buf;
|
|
}
|
|
|
|
#####################################
|
|
sub
|
|
EB_Set($@)
|
|
{
|
|
my ($hash, @a) = @_;
|
|
|
|
my $name = shift @a;
|
|
my $type = shift @a;
|
|
my $arg = join(" ", @a);
|
|
|
|
return "Unknown argument $type, choose one of raw" if($type ne "raw");
|
|
|
|
$arg .= "\n";
|
|
|
|
syswrite($hash->{WRPIPE}, $arg);
|
|
return undef;
|
|
}
|
|
|
|
1;
|