FHEM/fhem-mirror
2
0
Fork 0
mirror of https://github.com/fhem/fhem-mirror.git synced 2025-04-19 00:26:03 +00:00
Code Issues Releases Wiki Activity

OWX_ASYNC: cleanup and refactor interface to busmaster-classes (do all nested protothreads)

Browse Source 
Merge branch 'owx_protothreads'

git-svn-id: https://svn.fhem.de/fhem/trunk@6259 2b470e98-0d58-463d-a4d8-8e2adae1ed80
This commit is contained in:
ntruchsess 2014-07-15 16:44:35 +00:00
parent 1d098fe7c6
commit fbf43ce944
13 changed files with 2332 additions and 2321 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

763
fhem/FHEM/00_OWX_ASYNC.pm
View File

@ -128,7 +128,7 @@ my %attrs = (
);
#-- some globals needed for the 1-Wire module
$owx_async_version=5.4;
$owx_async_version=5.5;
#-- Debugging 0,1,2,3
$owx_async_debug=0;
@ -251,7 +251,7 @@ sub OWX_ASYNC_Attr(@) {
return $ret;
}
sub OWX_ASYNC_Notify {
sub OWX_ASYNC_Notify ($$) {
my ($hash,$dev) = @_;
my $name = $hash->{NAME};
my $type = $hash->{TYPE};
@ -276,12 +276,14 @@ sub OWX_ASYNC_Ready ($) {
sub OWX_ASYNC_Read ($) {
my $hash = shift;
Log3 ($hash->{NAME},5,"OWX_ASYNC_Read") if ($owx_async_debug > 2);
OWX_ASYNC_Poll($hash);
OWX_ASYNC_RunTasks($hash);
};
sub OWX_ASYNC_Poll ($) {
my $hash = shift;
Log3 ($hash->{NAME},5,"OWX_ASYNC_Poll") if ($owx_async_debug > 2);
if (defined $hash->{ASYNC}) {
$hash->{ASYNC}->poll($hash);
};
@ -326,56 +328,35 @@ sub OWX_ASYNC_Disconnected($) {
#TODO fix OWX_ASYNC_Alarms return value on failure
########################################################################################
sub OWX_ASYNC_Alarms ($) {
my ($hash) = @_;
sub OWX_ASYNC_PT_Alarms ($) {
my ($hash) = @_;
#-- get the interface
my $async = $hash->{ASYNC};
#-- get the interface
my $name = $hash->{NAME};
my $async = $hash->{ASYNC};
my $res;
if (defined $async) {
delete $hash->{ALARMDEVS};
return $async->alarms($hash);
} else {
#-- interface error
my $owx_interface = $hash->{INTERFACE};
if( !(defined($owx_interface))){
return undef;
} else {
return "OWX: Alarms called with unknown interface $owx_interface on bus $name";
}
}
};
#######################################################################################
#
# OWX_ASYNC_AwaitAlarmsResponse - Wait for the result of a call to OWX_ASYNC_Alarms
#
# Parameter hash = hash of bus master
#
# Return: Reference to Array of alarmed 1-Wire-addresses found on 1-Wire bus.
# undef if timeout occours
#
########################################################################################
sub OWX_ASYNC_AwaitAlarmsResponse($) {
my ($hash) = @_;
#-- get the interface
my $async = $hash->{ASYNC};
if (defined $async) {
my $times = AttrVal($hash->{NAME},"timeout",5000) / 50; #timeout in ms, defaults to 1 sec #TODO add attribute timeout?
for (my $i=0;$i<$times;$i++) {
if(! defined $hash->{ALARMDEVS} ) {
select (undef,undef,undef,0.05);
$async->poll($hash);
} else {
return $hash->{ALARMDEVS};
};
};
};
return undef;
#-- Discover all devices on the 1-Wire bus, they will be found in $hash->{DEVS}
if (defined $async) {
return PT_THREAD(sub {
my ($thread) = @_;
PT_BEGIN($thread);
$thread->{pt_alarms} = $async->get_pt_alarms();
$thread->{TimeoutTime} = gettimeofday()+2; #TODO: implement attribute-based timeout
PT_WAIT_THREAD($thread->{pt_alarms});
delete $thread->{TimeoutTime};
die $thread->{pt_alarms}->PT_CAUSE() if ($thread->{pt_alarms}->PT_STATE() == PT_ERROR);
if (defined (my $alarmed_devs = $thread->{pt_alarms}->PT_RETVAL())) {
OWX_ASYNC_AfterAlarms($hash,$alarmed_devs);
};
PT_END;
});
} else {
my $owx_interface = $hash->{INTERFACE};
if( !defined($owx_interface) ) {
die "OWX: Alarms called with undefined interface on bus $hash->{NAME}";
} else {
die "OWX: Alarms called with unknown interface $owx_interface on bus $hash->{NAME}";
}
}
}
########################################################################################
@ -384,10 +365,10 @@ sub OWX_ASYNC_AwaitAlarmsResponse($) {
#
# stores device-addresses found in $hash->{ALARMDEVS}
#
# Attention: this function is not intendet to be called directly!
# Attention: this function is not intendet to be called directly!
#
# Parameter hash = hash of bus master
# alarmed_devs = Reference to Array of device-address-strings
# alarmed_devs = Reference to Array of device-address-strings
#
# Returns: nothing
#
@ -395,63 +376,22 @@ sub OWX_ASYNC_AwaitAlarmsResponse($) {
sub OWX_ASYNC_AfterAlarms($$) {
my ($hash,$alarmed_devs) = @_;
$hash->{ALARMDEVS} = $alarmed_devs;
my @alarmed_devnames = ();
GP_ForallClients($hash,sub {
my ($hash,$devs) = @_;
my $romid = $hash->{ROM_ID};
if (grep {/$romid/} @$devs) {
readingsSingleUpdate($hash,"alarm",1,!$hash->{ALARM});
$hash->{ALARM}=1;
} else {
readingsSingleUpdate($hash,"alarm",0, $hash->{ALARM});
$hash->{ALARM}=0;
}
},$alarmed_devs);
};
########################################################################################
#
# OWX_ASYNC_DiscoverAlarms - Search for devices on the 1-Wire bus which have the alarm flag set
#
# Parameter hash = hash of bus master
#
# Return: Message or list of alarmed devices
#
########################################################################################
sub OWX_ASYNC_DiscoverAlarms($) {
my ($hash) = @_;
if (OWX_ASYNC_Alarms($hash)) {
if (my $alarmed_devs = OWX_ASYNC_AwaitAlarmsResponse($hash)) {
my @owx_alarm_names=();
my $name = $hash->{NAME};
if( $alarmed_devs == 0){
return "OWX: No alarmed 1-Wire devices found on bus $name";
}
#-- walk through all the devices to get their proper fhem names
foreach my $fhem_dev (sort keys %main::defs) {
#-- skip if busmaster
next if( $name eq $main::defs{$fhem_dev}{NAME} );
#-- all OW types start with OW
next if( substr($main::defs{$fhem_dev}{TYPE},0,2) ne "OW");
foreach my $owx_dev (@{$alarmed_devs}) {
#-- two pieces of the ROM ID found on the bus
my $owx_rnf = substr($owx_dev,3,12);
my $owx_f = substr($owx_dev,0,2);
my $id_owx = $owx_f.".".$owx_rnf;
#-- skip if not in alarm list
if( $owx_dev eq $main::defs{$fhem_dev}{ROM_ID} ){
$main::defs{$fhem_dev}{STATE} = "Alarmed";
push(@owx_alarm_names,$main::defs{$fhem_dev}{NAME});
}
my ($client) = @_;
my $romid = $client->{ROM_ID};
Log3 ($client->{IODev}->{NAME},5,"OWX_ASYNC_AfterAlarms client NAME: $client->{NAME}, ROM_ID: $romid, ALARM: $client->{ALARM}, alarmed_devs: [".join(",",@$alarmed_devs)."]") if ($owx_async_debug>2);
if (grep {$romid eq $_} @$alarmed_devs) {
readingsSingleUpdate($client,"alarm",1,!$client->{ALARM});
$client->{ALARM}=1;
push (@alarmed_devnames,$client->{NAME});
} else {
readingsSingleUpdate($client,"alarm",0, $client->{ALARM});
$client->{ALARM}=0;
}
}
#-- so far, so good - what do we want to do with this ?
return "OWX: ".scalar(@owx_alarm_names)." alarmed 1-Wire devices found on bus $name (".join(",",@owx_alarm_names).")";
}
}
});
$hash->{ALARMDEVS} = \@alarmed_devnames;
Log3 ($hash->{NAME},5,"OWX_ASYNC_AfterAlarms: ALARMDEVS = [".join(",",@alarmed_devnames)."]") if ($owx_async_debug>2);
};
########################################################################################
@ -465,15 +405,35 @@ sub OWX_ASYNC_DiscoverAlarms($) {
#
########################################################################################
sub OWX_ASYNC_Discover ($) {
sub OWX_ASYNC_PT_Discover ($) {
my ($hash) = @_;
if (OWX_ASYNC_Search($hash)) {
if (my $owx_devices = OWX_ASYNC_AwaitSearchResponse($hash)) {
return OWX_ASYNC_AutoCreate($hash,$owx_devices);
};
} else {
return undef;
}
#-- get the interface
my $async = $hash->{ASYNC};
#-- Discover all devices on the 1-Wire bus, they will be found in $hash->{DEVS}
if (defined $async) {
return PT_THREAD(sub {
my ($thread) = @_;
PT_BEGIN($thread);
$thread->{pt_discover} = $async->get_pt_discover();
$thread->{TimeoutTime} = gettimeofday()+2; #TODO: implement attribute-based timeout
PT_WAIT_THREAD($thread->{pt_discover});
delete $thread->{TimeoutTime};
die $thread->{pt_discover}->PT_CAUSE() if ($thread->{pt_discover}->PT_STATE() == PT_ERROR);
if (my $owx_devices = $thread->{pt_discover}->PT_RETVAL()) {
PT_EXIT(OWX_ASYNC_AutoCreate($hash,$owx_devices));
};
PT_END;
});
} else {
my $owx_interface = $hash->{INTERFACE};
if( !defined($owx_interface) ) {
die "OWX: Discover called with undefined interface on bus $hash->{NAME}";
} else {
die "OWX: Discover called with unknown interface $owx_interface on bus $hash->{NAME}";
}
}
}
#######################################################################################
@ -486,71 +446,47 @@ sub OWX_ASYNC_Discover ($) {
#
########################################################################################
sub OWX_ASYNC_Search($) {
my ($hash) = @_;
sub OWX_ASYNC_PT_Search($) {
my ($hash) = @_;
my $res;
my $ow_dev;
#-- get the interface
my $async = $hash->{ASYNC};
#-- get the interface
my $async = $hash->{ASYNC};
#-- Discover all devices on the 1-Wire bus, they will be found in $hash->{DEVS}
if (defined $async) {
delete $hash->{DEVS};
return $async->discover($hash);
} else {
my $owx_interface = $hash->{INTERFACE};
if( !defined($owx_interface) ) {
return undef;
} else {
Log3 ($hash->{NAME},3,"OWX: Search called with unknown interface $owx_interface");
return undef;
}
}
#-- Discover all devices on the 1-Wire bus, they will be found in $hash->{DEVS}
if (defined $async) {
return PT_THREAD(sub {
my ($thread) = @_;
PT_BEGIN($thread);
$thread->{pt_discover} = $async->get_pt_discover();
$thread->{TimeoutTime} = gettimeofday()+2; #TODO: implement attribute-based timeout
PT_WAIT_THREAD($thread->{pt_discover});
delete $thread->{TimeoutTime};
die $thread->{pt_discover}->PT_CAUSE() if ($thread->{pt_discover}->PT_STATE() == PT_ERROR);
if (defined (my $owx_devs = $thread->{pt_discover}->PT_RETVAL())) {
OWX_ASYNC_AfterSearch($hash,$owx_devs);
}
PT_END;
});
} else {
my $owx_interface = $hash->{INTERFACE};
if( !defined($owx_interface) ) {
die "OWX: Search called with undefined interface on bus $hash->{NAME}";
} else {
die "OWX: Search called with unknown interface $owx_interface on bus $hash->{NAME}";
}
}
}
#######################################################################################
#
# OWX_ASYNC_AwaitSearchResponse - Wait for the result of a call to OWX_ASYNC_Search
#
# Parameter hash = hash of bus master
#
# Return: Reference to Array of 1-Wire-addresses found on 1-Wire bus.
# undef if timeout occours
#
########################################################################################
sub OWX_ASYNC_AwaitSearchResponse($) {
my ($hash) = @_;
#-- get the interface
my $async = $hash->{ASYNC};
#-- Discover all devices on the 1-Wire bus, they will be found in $hash->{DEVS}
if (defined $async) {
my $times = AttrVal($hash->{NAME},"timeout",5000) / 50; #timeout in ms, defaults to 1 sec #TODO add attribute timeout?
for (my $i=0;$i<$times;$i++) {
if(! defined $hash->{DEVS} ) {
select (undef,undef,undef,0.05);
$async->poll($hash);
} else {
return $hash->{DEVS};
};
};
};
return undef;
};
########################################################################################
#
# OWX_ASYNC_AfterSearch - is called when the search initiated by OWX_ASYNC_Search successfully returns
#
# stores device-addresses found in $hash->{DEVS}
#
# Attention: this function is not intendet to be called directly!
# Attention: this function is not intendet to be called directly!
#
# Parameter hash = hash of bus master
# owx_devs = Reference to Array of device-address-strings
# owx_devs = Reference to Array of device-address-strings
#
# Returns: nothing
#
@ -558,20 +494,24 @@ sub OWX_ASYNC_AwaitSearchResponse($) {
sub OWX_ASYNC_AfterSearch($$) {
my ($hash,$owx_devs) = @_;
if (defined $owx_devs and (ref($owx_devs) eq "ARRAY")) {
$hash->{DEVS} = $owx_devs;
GP_ForallClients($hash,sub {
my ($hash,$devs) = @_;
my $romid = $hash->{ROM_ID};
if (grep {/$romid/} @$devs) {
readingsSingleUpdate($hash,"present",1,!$hash->{PRESENT});
$hash->{PRESENT} = 1;
} else {
readingsSingleUpdate($hash,"present",0,$hash->{PRESENT});
$hash->{PRESENT} = 0;
}
},$owx_devs);
}
# if (defined $owx_devs and (ref($owx_devs) eq "ARRAY")) {
my @devnames = ();
GP_ForallClients($hash,sub {
my ($client) = @_;
my $romid = $client->{ROM_ID};
Log3 ($client->{IODev}->{NAME},5,"OWX_ASYNC_AfterSearch client NAME: $client->{NAME}, ROM_ID: $romid, PRESENT: $client->{PRESENT}, devs: [".join(",",@$owx_devs)."]") if ($owx_async_debug>2);
if (grep {$romid eq $_} @$owx_devs) {
readingsSingleUpdate($client,"present",1,!$client->{PRESENT});
$client->{PRESENT} = 1;
push (@devnames,$client->{NAME});
} else {
readingsSingleUpdate($client,"present",0,$client->{PRESENT});
$client->{PRESENT} = 0;
}
});
$hash->{DEVS} = \@devnames;
Log3 ($hash->{NAME},5,"OWX_ASYNC_AfterSearch: DEVS = [".join(",",@devnames)."]") if ($owx_async_debug>2);
# }
}
########################################################################################
@ -585,7 +525,7 @@ sub OWX_ASYNC_AfterSearch($$) {
#
########################################################################################
sub OWX_ASYNC_AutoCreate($$) {
sub OWX_ASYNC_AutoCreate($$) {
my ($hash,$owx_devs) = @_;
my $name = $hash->{NAME};
my ($chip,$acstring,$acname,$exname);
@ -633,7 +573,8 @@ sub OWX_ASYNC_AutoCreate($$) {
push(@owx_names,$exname);
#-- replace the ROM ID by the proper value including CRC
$main::defs{$fhem_dev}{ROM_ID}=$owx_dev;
$main::defs{$fhem_dev}{PRESENT}=1;
readingsSingleUpdate($main::defs{$fhem_dev},"present",1,!$main::defs{$fhem_dev}->{PRESENT});
$main::defs{$fhem_dev}{PRESENT}=1;
$match = 1;
last;
}
@ -668,6 +609,7 @@ sub OWX_ASYNC_AutoCreate($$) {
} else{
select(undef,undef,undef,0.1);
push(@owx_names,$acname);
readingsSingleUpdate($main::defs{$acname},"present",1,!$main::defs{$acname}->{PRESENT});
$main::defs{$acname}{PRESENT}=1;
#-- THIS IODev, default room (model is set in the device module)
CommandAttr (undef,"$acname IODev $hash->{NAME}");
@ -710,7 +652,7 @@ sub OWX_ASYNC_AutoCreate($$) {
Log3 ($hash->{NAME},2, "OWX: 1-Wire devices found on bus $name (".join(",",@owx_names).")");
#-- tabular view as return value
return "OWX: 1-Wire devices found on bus $name \n".$ret;
}
}
########################################################################################
#
@ -727,16 +669,28 @@ sub OWX_ASYNC_Get($@) {
my $name = $hash->{NAME};
my $owx_dev = $hash->{ROM_ID};
my ($task,$task_state);
if( $a[1] eq "alarms") {
my $res = OWX_ASYNC_DiscoverAlarms($hash);
#-- process result
return $res
eval {
$task = OWX_ASYNC_PT_Alarms($hash);
OWX_ASYNC_ScheduleMaster($hash,$task);
$task_state = OWX_ASYNC_RunToCompletion($hash,$task);
};
return $@ if $@;
return $task->PT_CAUSE() if ($task_state == PT_ERROR or $task_state == PT_CANCELED);
unless ( defined $hash->{ALARMDEVS} and @{$hash->{ALARMDEVS}}) {
return "OWX: No alarmed 1-Wire devices found on bus $name";
}
return "OWX: ".scalar(@{$hash->{ALARMDEVS}})." alarmed 1-Wire devices found on bus $name (".join(",",@{$hash->{ALARMDEVS}}).")";
} elsif( $a[1] eq "devices") {
my $res = OWX_ASYNC_Discover($hash);
#-- process result
return $res
eval {
$task = OWX_ASYNC_PT_Discover($hash);
OWX_ASYNC_ScheduleMaster($hash,$task);
$task_state = OWX_ASYNC_RunToCompletion($hash,$task);
};
return $@ if $@;
return ($task_state == PT_ERROR or $task_state == PT_CANCELED) ? $task->PT_CAUSE() : $task->PT_RETVAL();
} elsif( $a[1] eq "version") {
return $owx_async_version;
@ -781,15 +735,23 @@ sub OWX_ASYNC_Init ($) {
return "OWX_ASYNC_Init failed: $err";
};
$hash->{ASYNC} = $ret;
$hash->{ASYNC}->{debug} = $owx_async_debug;
$hash->{INTERFACE} = $owx->{interface};
} else {
return "OWX: Init called with undefined interface";
}
$hash->{STATE} = "Active";
#-- Fourth step: discovering devices on the bus
# in 10 seconds discover all devices on the 1-Wire bus
InternalTimer(gettimeofday()+10, "OWX_ASYNC_Discover", $hash,0);
my $pt_discover = OWX_ASYNC_PT_Discover($hash);
$pt_discover->{ExecuteTime} = gettimeofday()+10;
eval {
OWX_ASYNC_ScheduleMaster($hash,$pt_discover);
};
return GP_Catch($@) if $@;
#-- Default settings
$hash->{interval} = AttrVal($hash->{NAME},"interval",300); # kick every 5 minutes
$hash->{followAlarms} = "off";
@ -800,7 +762,6 @@ sub OWX_ASYNC_Init ($) {
#readingsSingleUpdate($hash,"state","defined",1);
#-- Intiate first alarm detection and eventually conversion in a minute or so
InternalTimer(gettimeofday() + $hash->{interval}, "OWX_ASYNC_Kick", $hash,0);
$hash->{STATE} = "Active";
GP_ForallClients($hash,\&OWX_ASYNC_InitClient,undef);
return undef;
}
@ -833,43 +794,58 @@ sub OWX_ASYNC_Kick($) {
#-- Call us in n seconds again.
InternalTimer(gettimeofday()+ $hash->{interval}, "OWX_ASYNC_Kick", $hash,0);
eval {
OWX_ASYNC_ScheduleMaster( $hash, PT_THREAD(\&OWX_ASYNC_PT_Kick), $hash );
};
Log3 $hash->{NAME},3,"OWX_ASYNC_Kick: ".GP_Catch($@) if $@;
unless ($hash->{".kickrunning"}) {
$hash->{".kickrunning"} = 1;
eval {
OWX_ASYNC_ScheduleMaster( $hash, PT_THREAD(sub {
my ($thread) = @_;
PT_BEGIN($thread);
#-- Only if we have the dokick attribute set to 1
if (main::AttrVal($hash->{NAME},"dokick",0)) {
Log3 $hash->{NAME},5,"OWX_ASYNC_PT_Kick: kicking DS14B20 temperature conversion";
#-- issue the skip ROM command \xCC followed by start conversion command \x44
$thread->{pt_execute} = OWX_ASYNC_PT_Execute($hash,1,undef,"\x44",0);
$thread->{TimeoutTime} = gettimeofday()+2; #TODO: implement attribute-based timeout
PT_WAIT_THREAD($thread->{pt_execute});
delete $thread->{TimeoutTime};
if ($thread->{pt_execute}->PT_STATE() == PT_ERROR) {
Log3 ($hash->{NAME},4,"OWX_ASYNC_PT_Kick: Failure in temperature conversion: ".$thread->{pt_execute}->PT_CAUSE());
} else {
$thread->{ExecuteTime} = gettimeofday()+1;
PT_YIELD_UNTIL(gettimeofday() >= $thread->{ExecuteTime});
delete $thread->{ExecuteTime};
GP_ForallClients($hash,sub {
my ($client) = @_;
if ($client->{TYPE} eq "OWTHERM" and AttrVal($client->{NAME},"tempConv","") eq "onkick" ) {
Log3 $client->{NAME},5,"OWX_ASYNC_PT_Kick: doing tempConv for $client->{NAME}";
OWX_ASYNC_Schedule($client, PT_THREAD(\&OWXTHERM_PT_GetValues), $client );
}
},undef);
}
}
return 1;
}
sub OWX_ASYNC_PT_Kick($) {
my ($thread,$hash) = @_;
PT_BEGIN($thread);
#-- Only if we have the dokick attribute set to 1
if (main::AttrVal($hash->{NAME},"dokick",0)) {
Log3 $hash->{NAME},5,"OWX_ASYNC_PT_Kick: kicking DS14B20 temperature conversion";
#-- issue the skip ROM command \xCC followed by start conversion command \x44
unless (OWX_ASYNC_Execute($hash,$thread,1,undef,"\x44",0)) {
PT_EXIT("OWX_ASYNC: Failure in temperature conversion");
}
$thread->{ExecuteTime} = gettimeofday()+1;
PT_YIELD_UNTIL(defined $thread->{ExecuteResponse} and (gettimeofday() >= $thread->{ExecuteTime}));
GP_ForallClients($hash,sub {
my ($client) = @_;
if ($client->{TYPE} eq "OWTHERM" and AttrVal($client->{NAME},"tempConv","") eq "onkick" ) {
Log3 $client->{NAME},5,"OWX_ASYNC_PT_Kick: doing tempConv for $client->{NAME}";
OWX_ASYNC_Schedule($client, PT_THREAD(\&OWXTHERM_PT_GetValues), $client );
}
},undef);
$thread->{pt_search} = OWX_ASYNC_PT_Search($hash);
$thread->{TimeoutTime} = gettimeofday()+2; #TODO: implement attribute-based timeout
PT_WAIT_THREAD($thread->{pt_search});
delete $thread->{Timeouttime};
if ($thread->{pt_search}->PT_STATE() == PT_ERROR) {
Log3 ($hash->{NAME},4,"OWX_ASYNC_PT_Kick: Failure in search: ".$thread->{pt_search}->PT_CAUSE());
} else {
$thread->{pt_alarms} = OWX_ASYNC_PT_Alarms($hash);
$thread->{TimeoutTime} = gettimeofday()+2; #TODO: implement attribute-based timeout
PT_WAIT_THREAD($thread->{pt_alarms});
delete $thread->{TimeoutTime};
if ($thread->{pt_alarms}->PT_STATE() == PT_ERROR) {
Log3 ($hash->{NAME},4,"OWX_ASYNC_PT_Kick: Failure in alarm-search: ".$thread->{pt_alarms}->PT_CAUSE());
};
}
delete $hash->{".kickrunning"};
PT_END;
}));
};
Log3 ($hash->{NAME},4,"OWX_ASYNC_PT_Kick".GP_Catch($@)) if ($@);
}
#TODO OWX_ASYNC_Search allways returns 1 when busmaster is active
if (OWX_ASYNC_Search($hash)) {
OWX_ASYNC_Alarms($hash);
};
PT_END;
return 1;
}
########################################################################################
@ -950,17 +926,42 @@ sub OWX_ASYNC_Undef ($$) {
#
########################################################################################
sub OWX_ASYNC_Verify ($$) {
my ($hash,$dev) = @_;
my $address = substr($dev,0,15);
if (OWX_ASYNC_Search($hash)) {
if (my $owx_devices = OWX_ASYNC_AwaitSearchResponse($hash)) {
if (grep {/$address/} @{$owx_devices}) {
return 1;
};
};
}
return 0;
sub OWX_ASYNC_PT_Verify($) {
my ($hash) = @_;
#-- get the interface
my $async = $hash->{IODev}->{ASYNC};
my $romid = $hash->{ROM_ID};
#-- Verify a devices is present on the 1-Wire bus
if (defined $async) {
return PT_THREAD(sub {
my ($thread) = @_;
PT_BEGIN($thread);
$thread->{pt_verify} = $async->get_pt_verify($romid);
$thread->{TimeoutTime} = gettimeofday()+2; #TODO: implement attribute-based timeout
PT_WAIT_THREAD($thread->{pt_verify});
delete $thread->{TimeoutTime};
die $thread->{pt_verify}->PT_CAUSE() if ($thread->{pt_verify}->PT_STATE() == PT_ERROR);
my $value = $thread->{pt_verify}->PT_RETVAL();
if( $value == 0 ){
readingsSingleUpdate($hash,"present",0,$hash->{PRESENT});
} else {
readingsSingleUpdate($hash,"present",1,!$hash->{PRESENT});
}
$hash->{PRESENT} = $value;
PT_END;
});
} else {
my $owx_interface = $hash->{IODev}->{INTERFACE};
if( !defined($owx_interface) ) {
die "OWX: Verify called with undefined interface on bus $hash->{IODev}->{NAME}";
} else {
die "OWX: Verify called with unknown interface $owx_interface on bus $hash->{IODev}->{NAME}";
}
}
}
########################################################################################
@ -983,209 +984,171 @@ sub OWX_ASYNC_Verify ($$) {
#
########################################################################################
sub OWX_ASYNC_Execute($$$$$$) {
my ( $hash, $context, $reset, $owx_dev, $data, $numread ) = @_;
if (my $executor = $hash->{ASYNC}) {
delete $context->{ExecuteResponse};
my $now = gettimeofday();
#TODO implement propper timeout based on timeout-attribute
#my $timeoutms = AttrVal($hash->{NAME},"timeout",1000);
$context->{TimeoutTime} = $now+2;
Log3 ($hash->{NAME},5,sprintf("OWX_ASYNC_Execute: set TimeoutTime: %.6f, now: %.6f",$context->{TimeoutTime},$now)) if ($owx_async_debug);
return $executor->execute( $hash, $context, $reset, $owx_dev, $data, $numread );
} else {
return 0;
}
};
########################################################################################
#
# OWX_ASYNC_AfterExecute - is called when a query initiated by OWX_Execute successfully returns
#
# calls 'AfterExecuteFn' on the devices module (if such is defined)
# stores data read in $hash->{replies}{$owx_dev}{$context} after calling 'AfterExecuteFn'
#
# Attention: this function is not intendet to be called directly!
#
# Parameter hash = hash of bus master
# context = context parameter of call to OWX_Execute. Allows to correlate request and response
# success = indicates whether an error did occur
# reset = indicates whether a reset was carried out
# owx_dev = 1-wire device-address
# data = data written to the 1-wire device before read was executed
# numread = number of bytes requested from 1-wire device
# readdata = bytes read from 1-wire device
#
# Returns: nothing
#
########################################################################################
sub OWX_ASYNC_AfterExecute($$$$$$$$) {
my ( $master, $context, $success, $reset, $owx_dev, $writedata, $numread, $readdata ) = @_;
Log3 ($master->{NAME},5,"AfterExecute:".
" context: ".(defined $context ? $context : "undef").
", success: ".(defined $success ? $success : "undef").
", reset: ".(defined $reset ? $reset : "undef").
", owx_dev: ".(defined $owx_dev ? $owx_dev : "undef").
", writedata: ".(defined $writedata ? unpack ("H*",$writedata) : "undef").
", numread: ".(defined $numread ? $numread : "undef").
", readdata: ".(defined $readdata ? unpack ("H*",$readdata) : "undef"));
if ( defined $context and ref $context eq "ProtoThreads" ) {
$context->{ExecuteResponse} = {
success => $success,
'reset' => $reset,
writedata => $writedata,
readdata => $readdata,
numread => $numread,
};
delete $context->{TimeoutTime};
sub OWX_ASYNC_PT_Execute($$$$$) {
my ( $hash, $reset, $owx_dev, $data, $numread ) = @_;
if (my $executor = $hash->{ASYNC}) {
return $executor->get_pt_execute($reset,$owx_dev,$data,$numread);
} else {
die "OWX_ASYNC_AfterExecute: $context is not a ProtoThread";
die "OWX_ASYNC_PT_Execute: no async device assigned";
}
};
}
sub OWX_ASYNC_Schedule($$@) {
my ( $hash, $task, @args ) = @_;
my $master = $hash->{IODev};
die "OWX_ASYNC_Schedule: Master not Active" unless $master->{STATE} eq "Active";
my $owx_dev = $hash->{ROM_ID};
my $name = $hash->{NAME};
$task->{ExecuteArgs} = \@args;
my $now = gettimeofday();
$task->{ExecuteTime} = $now;
if (defined $master->{tasks}->{$owx_dev}) {
push @{$master->{tasks}->{$owx_dev}}, $task;
$task->{ExecuteTime} = gettimeofday() unless (defined $task->{ExecuteTime});
if (defined $master->{tasks}->{$name}) {
push @{$master->{tasks}->{$name}}, $task;
$hash->{NUMTASKS} = @{$master->{tasks}->{$name}};
} else {
$master->{tasks}->{$owx_dev} = [$task];
$master->{tasks}->{$name} = [$task];
$hash->{NUMTASKS} = 1;
}
main::InternalTimer($now, "OWX_ASYNC_RunTasks", $master,0);
#TODO make use of $master->{".nexttasktime"}
InternalTimer($task->{ExecuteTime}, "OWX_ASYNC_RunTasks", $master,0);
};
sub OWX_ASYNC_ScheduleMaster($$@) {
my ( $master, $task, @args ) = @_;
die "OWX_ASYNC_Schedule: Master not Active" unless $master->{STATE} eq "Active";
my $name = $master->{NAME};
$task->{ExecuteArgs} = \@args;
my $now = gettimeofday();
$task->{ExecuteTime} = $now;
if (defined $master->{tasks}->{master}) {
push @{$master->{tasks}->{master}}, $task;
$task->{ExecuteTime} = gettimeofday() unless (defined $task->{ExecuteTime});
if (defined $master->{tasks}->{$name}) {
push @{$master->{tasks}->{$name}}, $task;
$master->{NUMTASKS} = @{$master->{tasks}->{$name}};
} else {
$master->{tasks}->{master} = [$task];
$master->{tasks}->{$name} = [$task];
$master->{NUMTASKS} = 1;
}
main::InternalTimer($now, "OWX_ASYNC_RunTasks", $master,0);
#TODO make use of $master->{".nexttasktime"}
InternalTimer($task->{ExecuteTime}, "OWX_ASYNC_RunTasks", $master,0);
};
sub OWX_ASYNC_RunToCompletion($$) {
my ($master,$task) = @_;
my $task_state;
do {
OWX_ASYNC_Poll($master);
OWX_ASYNC_RunTasks($master);
$task_state = $task->PT_STATE();
} while ($task_state == PT_INITIAL or $task_state == PT_WAITING or $task_state == PT_YIELDED);
return $task_state;
}
sub OWX_ASYNC_RunTasks($) {
my ( $master ) = @_;
if ($master->{STATE} eq "Active") {
Log3 ($master->{NAME},5,"OWX_ASYNC_RunTasks: ".((defined $master->{".currenttaskdevice"}) ? $master->{".currenttaskdevice"} : "-undefined-")." called") if ($owx_async_debug);
Log3 ($master->{NAME},5,"OWX_ASYNC_RunTasks: called") if ($owx_async_debug>2);
my $now = gettimeofday();
my $currentqueue;
my $currentdevice = $master->{".currenttaskdevice"};
$currentqueue = $master->{tasks}->{$currentdevice} if (defined $currentdevice);
do {
unless (defined $currentqueue and @$currentqueue) {
foreach my $owx_dev (keys %{$master->{tasks}}) {
my $queue = $master->{tasks}->{$owx_dev};
if (@$queue) {
# if task is eligible to run now:
if (defined ($queue->[0]->{ExecuteTime}) and ($now >= $queue->[0]->{ExecuteTime})) {
$currentqueue = $queue;
$currentdevice = $owx_dev;
Log3 ($master->{NAME},5,"OWX_ASYNC_RunTasks: $owx_dev identified") if ($owx_async_debug);
while(1) {
my @queue_waiting = ();
my @queue_ready = ();
my @queue_sleeping = ();
my @queue_initial = ();
foreach my $name (keys %{$master->{tasks}}) {
my $queue = $master->{tasks}->{$name};
while (@$queue) {
my $state = $queue->[0]->PT_STATE();
if ($state == PT_WAITING) {
push @queue_waiting,{ device => $name, queue => $queue};
last;
} elsif ($state == PT_YIELDED) {
if ($now >= $queue->[0]->{ExecuteTime}) {
push @queue_ready, { device => $name, queue => $queue};
} else {
push @queue_sleeping, { device => $name, queue => $queue};
}
last;
} elsif ($state == PT_INITIAL) {
push @queue_initial, { device => $name, queue => $queue};
last;
} else {
shift @$queue;
$main::defs{$name}->{NUMTASKS} = @$queue;
}
};
delete $master->{tasks}->{$name} unless (@$queue);
}
if (defined (my $current = @queue_waiting ? shift @queue_waiting : @queue_ready ? shift @queue_ready : @queue_initial ? shift @queue_initial : undef)) {
my $task = $current->{queue}->[0];
my $timeout = $task->{TimeoutTime};
if ($task->PT_SCHEDULE(@{$task->{ExecuteArgs}})) {
my $state = $task->PT_STATE();
# waiting for ExecuteResponse:
if ($state == PT_WAITING) {
die "$current->{device} unexpected thread state PT_WAITING without TimeoutTime" unless (defined $task->{TimeoutTime});
#task timed out:
if ($now >= $task->{TimeoutTime}) {
Log3 ($master->{NAME},4,"OWX_ASYNC_RunTasks: $current->{device} task timed out");
Log3 ($master->{NAME},5,sprintf("OWX_ASYNC_RunTasks: $current->{device} TimeoutTime: %.6f, now: %.6f",$task->{TimeoutTime},$now)) if ($owx_async_debug>1);
$task->PT_CANCEL("Timeout");
shift @{$current->{queue}};
$main::defs{$current->{device}}->{NUMTASKS} = @{$current->{queue}};
next;
} else {
Log3 $master->{NAME},5,"OWX_ASYNC_RunTasks: $current->{device} waiting for data or timeout" if ($owx_async_debug>2);
#new timeout or timeout did change:
if (!defined $timeout or $timeout != $task->{TimeoutTime}) {
Log3 $master->{NAME},5,sprintf("OWX_ASYNC_RunTasks: $current->{device} schedule for timeout at %.6f",$task->{TimeoutTime});
InternalTimer($task->{TimeoutTime}, "OWX_ASYNC_RunTasks", $master,0);
}
last;
}
# sleeping:
} elsif ($state == PT_YIELDED) {
next;
} else {
delete $master->{tasks}->{$owx_dev};
die "$current->{device} unexpected thread state while running: $state";
}
}
}
if (defined $currentqueue and @$currentqueue) {
my $task = $currentqueue->[0];
my $timeout = $task->{TimeoutTime};
my $ret;
eval {
$ret = $task->PT_SCHEDULE(@{$task->{ExecuteArgs}});
};
# finished running or error:
if (!$ret or $@) {
shift @$currentqueue;
undef $currentqueue;
my $msg = ($@) ? GP_Catch($@) : $task->PT_RETVAL();
if (defined $msg) {
Log3 ($master->{NAME},3,"OWX_ASYNC_RunTasks: $currentdevice Error running task: $msg");
} else {
my $state = $task->PT_STATE();
if ($state == PT_ENDED) {
Log3 ($master->{NAME},5,"OWX_ASYNC_RunTasks: $current->{device} finished task");
} elsif ($state == PT_EXITED) {
Log3 ($master->{NAME},4,"OWX_ASYNC_RunTasks: $current->{device} exited task: ".(defined $task->PT_RETVAL() ? $task->PT_RETVAL : "- no retval -"));
} elsif ($state == PT_ERROR) {
Log3 ($master->{NAME},4,"OWX_ASYNC_RunTasks: $current->{device} Error task: ".$task->PT_CAUSE());
$main::defs{$current->{device}}->{PRESENT} = 0;
} else {
Log3 ($master->{NAME},5,"OWX_ASYNC_RunTasks: $currentdevice finished task");
die "$current->{device} unexpected thread state after termination: $state";
}
# waiting for ExecuteResponse:
} elsif (defined $task->{TimeoutTime}) {
#task timed out:
if ($now >= $task->{TimeoutTime}) {
shift @$currentqueue;
undef $currentqueue;
Log3 ($master->{NAME},3,"OWX_ASYNC_RunTasks: $currentdevice task timed out");
Log3 ($master->{NAME},5,sprintf("OWX_ASYNC_RunTasks: $currentdevice TimeoutTime: %.6f, now: %.6f",$task->{TimeoutTime},$now));
} else {
Log3 $master->{NAME},5,"OWX_ASYNC_RunTasks: $currentdevice waiting for data or timeout" if ($owx_async_debug);
#new timeout or timeout did change:
if (!defined $timeout or $timeout != $task->{TimeoutTime}) {
Log3 $master->{NAME},5,sprintf("OWX_ASYNC_RunTasks: $currentdevice schedule for timeout at %.6f",$task->{TimeoutTime});
main::InternalTimer($task->{TimeoutTime}, "OWX_ASYNC_RunTasks", $master,0);
}
}
# or not finished running, no error but scheduled for future:
} elsif (defined $task->{ExecuteTime} and $now < $task->{ExecuteTime}) {
undef $currentqueue;
Log3 ($master->{NAME},5,"OWX_ASYNC_RunTasks: $currentdevice task not finished, next executetime: $task->{ExecuteTime}");
} elsif ($owx_async_debug) {
Log3 $master->{NAME},5,"OWX_ASYNC_RunTasks: $currentdevice no action";
}
if (defined $currentqueue and @$currentqueue) {
Log3 $master->{NAME},5,"OWX_ASYNC_RunTasks: $currentdevice exit loop" if ($owx_async_debug);
$master->{".currenttaskdevice"} = $currentdevice;
OWX_ASYNC_Poll($master);
return;
} elsif ($owx_async_debug) {
Log3 $master->{NAME},5,sprintf("OWX_ASYNC_RunTasks: -undefined- continue loop");
shift @{$current->{queue}};
$main::defs{$current->{device}}->{NUMTASKS} = @{$current->{queue}};
next;
}
} else {
my $nexttime;
foreach my $owx_dev (keys %{$master->{tasks}}) {
my $queue = $master->{tasks}->{$owx_dev};
if (@$queue) {
my $nexttask = $queue->[0];
# if task is scheduled for future:
if (defined $nexttask->{ExecuteTime}) {
$nexttime = $nexttask->{ExecuteTime} if (!defined $nexttime or ($nexttime > $nexttask->{ExecuteTime}));
$currentdevice = $owx_dev;
}
} else {
delete $master->{tasks}->{$owx_dev};
my $nextdevice;
foreach my $current (@queue_sleeping) {
# if task is scheduled for future:
if (!defined $nexttime or ($nexttime > $current->{queue}->[0]->{ExecuteTime})) {
$nexttime = $current->{queue}->[0]->{ExecuteTime};
$nextdevice = $current->{device};
}
}
if (defined $nexttime) {
if ($nexttime > $now) {
if (!defined $master->{".nexttasktime"} or $nexttime < $master->{".nexttasktime"} or $now >= $master->{".nexttasktime"}) {
Log3 $master->{NAME},5,sprintf("OWX_ASYNC_RunTasks: $currentdevice schedule next at %.6f",$nexttime);
Log3 $master->{NAME},5,sprintf("OWX_ASYNC_RunTasks: $nextdevice schedule next at %.6f",$nexttime) if ($owx_async_debug);
main::InternalTimer($nexttime, "OWX_ASYNC_RunTasks", $master,0);
$master->{".nexttasktime"} = $nexttime;
} else {
Log3 $master->{NAME},5,sprintf("OWX_ASYNC_RunTasks: $currentdevice skip %.6f, allready scheduled at %.6f",$nexttime,$master->{".nexttasktime"}) if ($owx_async_debug);
Log3 $master->{NAME},5,sprintf("OWX_ASYNC_RunTasks: $nextdevice skip %.6f, allready scheduled at %.6f",$nexttime,$master->{".nexttasktime"}) if ($owx_async_debug>2);
}
} else {
delete $master->{".nexttasktime"};
Log3 $master->{NAME},5,sprintf("OWX_ASYNC_RunTasks: $currentdevice nexttime at %.6f allready passed",$nexttime) if ($owx_async_debug);
Log3 $master->{NAME},5,sprintf("OWX_ASYNC_RunTasks: $nextdevice nexttime at %.6f allready passed",$nexttime) if ($owx_async_debug>2);
}
} else {
Log3 $master->{NAME},5,sprintf("OWX_ASYNC_RunTasks: -undefined- no nexttime") if ($owx_async_debug);
Log3 $master->{NAME},5,sprintf("OWX_ASYNC_RunTasks: -undefined- no nexttime") if ($owx_async_debug>2);
}
delete $master->{".currenttaskdevice"};
Log3 $master->{NAME},5,sprintf("OWX_ASYNC_RunTasks: -undefined- exit loop") if ($owx_async_debug);
OWX_ASYNC_Poll($master);
return;
Log3 $master->{NAME},5,sprintf("OWX_ASYNC_RunTasks: -undefined- exit loop") if ($owx_async_debug>2);
last;
}
} while (1);
};
}
};

339
fhem/FHEM/21_OWAD.pm
View File

@ -75,7 +75,7 @@ use vars qw{%attr %defs %modules $readingFnAttributes $init_done};
use strict;
use warnings;
use GPUtils qw(:all);
use Time::HiRes qw( gettimeofday tv_interval usleep );
use Time::HiRes qw( gettimeofday );
#add FHEM/lib to @INC if it's not allready included. Should rather be in fhem.pl than here though...
BEGIN {
@ -90,7 +90,7 @@ use ProtoThreads;
no warnings 'deprecated';
sub Log($$);
my $owx_version="5.15";
my $owx_version="5.16";
#-- fixed raw channel name, flexible channel name
my @owg_fixed = ("A","B","C","D");
my @owg_channel = ("A","B","C","D");
@ -157,6 +157,8 @@ sub OWAD_Initialize ($) {
$hash->{UndefFn} = "OWAD_Undef";
$hash->{GetFn} = "OWAD_Get";
$hash->{SetFn} = "OWAD_Set";
$hash->{NotifyFn}= "OWAD_Notify";
$hash->{InitFn} = "OWAD_Init";
$hash->{AttrFn} = "OWAD_Attr";
my $attlist = "IODev do_not_notify:0,1 showtime:0,1 model:DS2450 loglevel:0,1,2,3,4,5 ".
@ -276,15 +278,30 @@ sub OWAD_Define ($$) {
readingsSingleUpdate($hash,"state","defined",1);
Log 3, "OWAD: Device $name defined.";
#-- Initialization reading according to interface type
my $interface= $hash->{IODev}->{TYPE};
$hash->{NOTIFYDEV} = "global";
#-- Start timer for updates
InternalTimer(time()+60, "OWAD_GetValues", $hash, 0);
if ($init_done) {
OWAD_Init($hash);
}
return undef;
}
sub OWAD_Notify ($$) {
my ($hash,$dev) = @_;
if( grep(m/^(INITIALIZED|REREADCFG)$/, @{$dev->{CHANGED}}) ) {
OWAD_Init($hash);
} elsif( grep(m/^SAVE$/, @{$dev->{CHANGED}}) ) {
}
}
sub OWAD_Init ($) {
my ($hash)=@_;
#-- Start timer for updates
RemoveInternalTimer($hash);
InternalTimer(gettimeofday()+10, "OWAD_InitializeDevice", $hash, 0);
return undef;
}
#######################################################################################
#
# OWAD_Attr - Set one attribute value for device
@ -326,6 +343,9 @@ sub OWAD_Attr(@) {
AssignIoPort($hash,$value);
if( defined($hash->{IODev}) ) {
$hash->{ASYNC} = $hash->{IODev}->{TYPE} eq "OWX_ASYNC" ? 1 : 0;
if ($init_done) {
OWAD_Init($hash);
}
}
last;
};
@ -565,11 +585,17 @@ sub OWAD_Get($@) {
#-- get present
if($a[1] eq "present") {
#-- hash of the busmaster
my $master = $hash->{IODev};
#-- asynchronous mode
if( $hash->{ASYNC} ){
$value = OWX_ASYNC_Verify($master,$hash->{ROM_ID});
my ($task,$task_state);
eval {
$task = OWX_ASYNC_PT_Verify($hash);
OWX_ASYNC_Schedule($hash,$task);
$task_state = OWX_ASYNC_RunToCompletion($master,$task);
};
return GP_Catch($@) if $@;
return $task->PT_CAUSE() if ($task_state == PT_ERROR or $task_state == PT_CANCELED);
return "$name.present => ".ReadingsVal($name,"present","unknown");
} else {
$value = OWX_Verify($master,$hash->{ROM_ID});
}
@ -595,12 +621,13 @@ sub OWAD_Get($@) {
if( $interface eq "OWX" ){
$ret = OWXAD_GetPage($hash,"reading",1);
}elsif( $interface eq "OWX_ASYNC" ){
#TODO use OWX_ASYNC_Schedule instead
my $task = PT_THREAD(\&OWXAD_PT_GetPage);
my ($task,$task_state);
eval {
while ($task->PT_SCHEDULE($hash,"reading",1)) { OWX_ASYNC_Poll($hash->{IODev}); };
$task = OWXAD_PT_GetPage($hash,"reading",1);
OWX_ASYNC_Schedule($hash,$task);
$task_state = OWX_ASYNC_RunToCompletion($master,$task);
};
$ret = ($@) ? GP_Catch($@) : $task->PT_RETVAL();
$ret = ($@) ? GP_Catch($@) : ($task_state == PT_ERROR or $task_state == PT_CANCELED) ? $task->PT_CAUSE() : $task->PT_RETVAL();
#-- OWFS interface
}elsif( $interface eq "OWServer" ){
$ret = OWFSAD_GetPage($hash,"reading",1);
@ -610,7 +637,7 @@ sub OWAD_Get($@) {
}
#-- process results
if( defined($ret) ){
if( defined($ret) ){
$hash->{ERRCOUNT}=$hash->{ERRCOUNT}+1;
if( $hash->{ERRCOUNT} > 5 ){
$hash->{INTERVAL} = 9999;
@ -626,12 +653,13 @@ sub OWAD_Get($@) {
if( $interface eq "OWX" ){
$ret = OWXAD_GetPage($hash,"alarm",1);
}elsif( $interface eq "OWX_ASYNC" ){
#TODO use OWX_ASYNC_Schedule instead
my $task = PT_THREAD(\&OWXAD_PT_GetPage);
my ($task,$task_state);
eval {
while ($task->PT_SCHEDULE($hash,"alarm",1)) { OWX_ASYNC_Poll($hash->{IODev}); };
$task = OWXAD_PT_GetPage($hash,"alarm",1);
OWX_ASYNC_Schedule($hash,$task);
$task_state = OWX_ASYNC_RunToCompletion($master,$task);
};
$ret = ($@) ? GP_Catch($@) : $task->PT_RETVAL();
$ret = ($@) ? GP_Catch($@) : ($task_state == PT_ERROR or $task_state == PT_CANCELED) ? $task->PT_CAUSE() : $task->PT_RETVAL();
#-- OWFS interface
}elsif( $interface eq "OWServer" ){
$ret = OWFSAD_GetPage($hash,"alarm",1);
@ -641,7 +669,7 @@ sub OWAD_Get($@) {
}
#-- process results
if( defined($ret) ){
if( defined($ret) ){
$hash->{ERRCOUNT}=$hash->{ERRCOUNT}+1;
if( $hash->{ERRCOUNT} > 5 ){
$hash->{INTERVAL} = 9999;
@ -665,12 +693,13 @@ sub OWAD_Get($@) {
if( $interface eq "OWX" ){
$ret = OWXAD_GetPage($hash,"status",1);
}elsif( $interface eq "OWX_ASYNC" ){
#TODO use OWX_ASYNC_Schedule instead
my $task = PT_THREAD(\&OWXAD_PT_GetPage);
my ($task,$task_state);
eval {
while ($task->PT_SCHEDULE($hash,"status",1)) { OWX_ASYNC_Poll($hash->{IODev}); };
$task = OWXAD_PT_GetPage($hash,"status",1);
OWX_ASYNC_Schedule($hash,$task);
$task_state = OWX_ASYNC_RunToCompletion($master,$task);
};
$ret = ($@) ? GP_Catch($@) : $task->PT_RETVAL();
$ret = ($@) ? GP_Catch($@) : ($task_state == PT_ERROR or $task_state == PT_CANCELED) ? $task->PT_CAUSE() : $task->PT_RETVAL();
#-- OWFS interface
}elsif( $interface eq "OWServer" ){
$ret = OWFSAD_GetPage($hash,"status",1);
@ -680,7 +709,7 @@ sub OWAD_Get($@) {
}
#-- process results
if( defined($ret) ){
if( defined($ret) ){
$hash->{ERRCOUNT}=$hash->{ERRCOUNT}+1;
if( $hash->{ERRCOUNT} > 5 ){
$hash->{INTERVAL} = 9999;
@ -740,11 +769,7 @@ sub OWAD_GetValues($) {
my $value = "";
my $ret = "";
my ($ret1,$ret2,$ret3);
#-- check if device needs to be initialized
OWAD_InitializeDevice($hash)
if( $hash->{READINGS}{"state"}{VAL} eq "defined");
#-- define warnings
my $warn = "none";
$hash->{ALARM} = "0";
@ -763,9 +788,9 @@ sub OWAD_GetValues($) {
#}
}elsif( $interface eq "OWX_ASYNC" ){
eval {
OWX_ASYNC_Schedule( $hash, PT_THREAD(\&OWXAD_PT_GetPage),$hash,"reading",0 );
OWX_ASYNC_Schedule( $hash, PT_THREAD(\&OWXAD_PT_GetPage),$hash,"alarm",0 );
OWX_ASYNC_Schedule( $hash, PT_THREAD(\&OWXAD_PT_GetPage),$hash,"status",1 );
OWX_ASYNC_Schedule( $hash, OWXAD_PT_GetPage($hash,"reading",0));
OWX_ASYNC_Schedule( $hash, OWXAD_PT_GetPage($hash,"alarm",0));
OWX_ASYNC_Schedule( $hash, OWXAD_PT_GetPage($hash,"status",1));
};
$ret .= GP_Catch($@) if $@;
}elsif( $interface eq "OWServer" ){
@ -859,8 +884,8 @@ sub OWAD_InitializeDevice($) {
$ret2 = OWXAD_SetPage($hash,"alarm");
}elsif( $interface eq "OWX_ASYNC" ){
eval {
OWX_ASYNC_Schedule( $hash, PT_THREAD(\&OWXAD_PT_SetPage),$hash,"status" );
OWX_ASYNC_Schedule( $hash, PT_THREAD(\&OWXAD_PT_SetPage),$hash,"alarm" );
OWX_ASYNC_Schedule( $hash, OWXAD_PT_SetPage($hash,"status"));
OWX_ASYNC_Schedule( $hash, OWXAD_PT_SetPage($hash,"alarm"));
};
$ret .= GP_Catch($@) if $@;
#-- OWFS interface
@ -880,7 +905,7 @@ sub OWAD_InitializeDevice($) {
#-- Set state to initialized
readingsSingleUpdate($hash,"state","initialized",1);
return undef;
return OWAD_GetValues($hash);
}
#######################################################################################
@ -982,7 +1007,7 @@ sub OWAD_Set($@) {
$ret = OWXAD_SetPage($hash,"status");
}elsif( $interface eq "OWX_ASYNC" ){
eval {
OWX_ASYNC_Schedule( $hash, PT_THREAD(\&OWXAD_PT_SetPage),$hash,"status" );
OWX_ASYNC_Schedule( $hash, OWXAD_PT_SetPage($hash,"status"));
};
$ret = GP_Catch($@) if $@;
#-- OWFS interface
@ -1033,7 +1058,7 @@ sub OWAD_Set($@) {
$ret = OWXAD_SetPage($hash,"alarm");
}elsif( $interface eq "OWX_ASYNC" ){
eval {
OWX_ASYNC_Schedule( $hash, PT_THREAD(\&OWXAD_PT_SetPage),$hash,"status" );
OWX_ASYNC_Schedule( $hash, OWXAD_PT_SetPage($hash,"status"));
};
$ret = GP_Catch($@) if $@;
#-- OWFS interface
@ -1537,62 +1562,67 @@ sub OWXAD_SetPage($$) {
sub OWXAD_PT_GetPage($$$) {
my ($thread,$hash,$page,$final) = @_;
my ($hash,$page,$final) = @_;
my ($select, $res, $res2, $res3, @data, $an, $vn);
#-- ID of the device, hash of the busmaster
my $owx_dev = $hash->{ROM_ID};
my $master = $hash->{IODev};
my ($i,$j,$k);
PT_BEGIN($thread);
return PT_THREAD(sub {
#-- reset presence
$hash->{PRESENT} = 0;
#=============== get the voltage reading ===============================
if( $page eq "reading") {
#-- issue the match ROM command \x55 and the start conversion command
unless (OWX_ASYNC_Execute( $master, $thread, 1, $owx_dev, "\x3C\x0F\x00\xFF\xFF", 0 )) {
PT_EXIT("$owx_dev not accessible for conversion");
my ($thread) = @_;
my ($res, $res2, $res3, @data, $an, $vn);
#-- ID of the device, hash of the busmaster
my $owx_dev = $hash->{ROM_ID};
my $master = $hash->{IODev};
my ($i,$j,$k);
PT_BEGIN($thread);
#=============== get the voltage reading ===============================
if( $page eq "reading") {
#-- issue the match ROM command \x55 and the start conversion command
$thread->{pt_execute} = OWX_ASYNC_PT_Execute($master,1,$owx_dev, "\x3C\x0F\x00\xFF\xFF", 0 );
$thread->{ExecuteTime} = gettimeofday() + 0.05; # was 0.02
$thread->{TimeoutTime} = gettimeofday()+2; #TODO: implement attribute-based timeout
PT_WAIT_THREAD($thread->{pt_execute});
delete $thread->{TimeoutTime};
die $thread->{pt_execute}->PT_CAUSE() if ($thread->{pt_execute}->PT_STATE() == PT_ERROR);
PT_YIELD_UNTIL(gettimeofday() >= $thread->{ExecuteTime});
delete $thread->{ExecuteTime};
#-- issue the match ROM command \x55 and the read conversion page command
# \xAA\x00\x00
$thread->{'select'}="\xAA\x00\x00";
#=============== get the alarm reading ===============================
} elsif ( $page eq "alarm" ) {
#-- issue the match ROM command \x55 and the read alarm page command
# \xAA\x10\x00
$thread->{'select'}="\xAA\x10\x00";
#=============== get the status reading ===============================
} elsif ( $page eq "status" ) {
#-- issue the match ROM command \x55 and the read status memory page command
# \xAA\x08\x00 r
$thread->{'select'}="\xAA\x08\x00";
#=============== wrong value requested ===============================
} else {
die "wrong memory page requested from $owx_dev";
}
PT_WAIT_UNTIL(defined $thread->{ExecuteResponse});
#TODO async 20ms delay
select(undef,undef,undef,0.02);
#-- reading 9 + 3 + 8 data bytes and 2 CRC bytes = 22 bytes
#-- issue the match ROM command \x55 and the read conversion page command
# \xAA\x00\x00
$select="\xAA\x00\x00";
#=============== get the alarm reading ===============================
} elsif ( $page eq "alarm" ) {
#-- issue the match ROM command \x55 and the read alarm page command
# \xAA\x10\x00
$select="\xAA\x10\x00";
#=============== get the status reading ===============================
} elsif ( $page eq "status" ) {
#-- issue the match ROM command \x55 and the read status memory page command
# \xAA\x08\x00 r
$select="\xAA\x08\x00";
#=============== wrong value requested ===============================
} else {
return "wrong memory page requested from $owx_dev";
}
#-- reading 9 + 3 + 8 data bytes and 2 CRC bytes = 22 bytes
unless (OWX_ASYNC_Execute( $master, $thread, 1, $owx_dev, $select, 10 )) {
PT_EXIT("$owx_dev not accessible in reading $page page");
}
PT_WAIT_UNTIL(defined $thread->{ExecuteResponse});
my $response = $thread->{ExecuteResponse};
unless ($response->{success}) {
PT_EXIT("$owx_dev read not successful");
}
my $res = OWXAD_BinValues($hash,"ds2450.get".$page.($final ? ".final" : ""),1,1,$owx_dev,$response->{writedata},$response->{numread},$response->{readdata});
if ($res) {
PT_EXIT($res);
}
PT_END;
$thread->{pt_execute} = OWX_ASYNC_PT_Execute($master,1,$owx_dev, $thread->{'select'}, 10 );
$thread->{TimeoutTime} = gettimeofday()+2; #TODO: implement attribute-based timeout
PT_WAIT_THREAD($thread->{pt_execute});
delete $thread->{TimeoutTime};
die $thread->{pt_execute}->PT_CAUSE() if ($thread->{pt_execute}->PT_STATE() == PT_ERROR);
my $response = $thread->{pt_execute}->PT_RETVAL();
my $res = OWXAD_BinValues($hash,"ds2450.get".$page.($final ? ".final" : ""),1,1,$owx_dev,$thread->{'select'},10,$response);
if ($res) {
die $res;
}
PT_END;
});
}
########################################################################################
@ -1606,72 +1636,73 @@ sub OWXAD_PT_GetPage($$$) {
sub OWXAD_PT_SetPage($$) {
my ($thread,$hash,$page) = @_;
my ($select, $res, $res2, $res3, @data);
#-- ID of the device, hash of the busmaster
my $owx_dev = $hash->{ROM_ID};
my $master = $hash->{IODev};
my ($i,$j,$k);
PT_BEGIN($thread);
#=============== set the alarm values ===============================
if ( $page eq "alarm" ) {
#-- issue the match ROM command \x55 and the set alarm page command
# \x55\x10\x00 reading 8 data bytes and 2 CRC bytes
$select="\x55\x10\x00";
for( $i=0;$i<int(@owg_fixed);$i++){
$select .= sprintf "%c\xFF\xFF\xFF",int($hash->{owg_vlow}->[$i]*256000/$owg_range[$i]);
$select .= sprintf "%c\xFF\xFF\xFF",int($hash->{owg_vhigh}->[$i]*256000/$owg_range[$i]);
}
#++Use of uninitialized value within @owg_vlow in multiplication at
#++/usr/share/fhem/FHEM/21_OWAD.pm line 1362.
#=============== set the status ===============================
} elsif ( $page eq "status" ) {
my ($sb1,$sb2)=(0,0);
#-- issue the match ROM command \x55 and the set status memory page command
# \x55\x08\x00 reading 8 data bytes and 2 CRC bytes
$select="\x55\x08\x00";
for( $i=0;$i<int(@owg_fixed);$i++){
#if( $owg_mode[$i] eq "input" ){
if( 1 > 0){
#-- resolution (TODO: check !)
$sb1 = $owg_resoln[$i] & 15;
#-- alarm enabled
if( defined($hash->{owg_slow}->[$i]) ){
$sb2 = ( $hash->{owg_slow}->[$i] ne 0 ) ? 4 : 0;
}
if( defined($hash->{owg_shigh}->[$i]) ){
$sb2 += ( $hash->{owg_shigh}->[$i] ne 0 ) ? 8 : 0;
}
#-- range
$sb2 |= 1
if( $owg_range[$i] > 2560 );
} else {
$sb1 = 128;
$sb2 = 0;
my ($hash,$page) = @_;
return PT_THREAD(sub {
my ($thread) = @_;
my ($select, $res, $res2, $res3, @data);
#-- ID of the device, hash of the busmaster
my $owx_dev = $hash->{ROM_ID};
my $master = $hash->{IODev};
my ($i,$j,$k);
PT_BEGIN($thread);
#=============== set the alarm values ===============================
if ( $page eq "alarm" ) {
#-- issue the match ROM command \x55 and the set alarm page command
# \x55\x10\x00 reading 8 data bytes and 2 CRC bytes
$select="\x55\x10\x00";
for( $i=0;$i<int(@owg_fixed);$i++){
$select .= sprintf "%c\xFF\xFF\xFF",int($hash->{owg_vlow}->[$i]*256000/$owg_range[$i]);
$select .= sprintf "%c\xFF\xFF\xFF",int($hash->{owg_vhigh}->[$i]*256000/$owg_range[$i]);
}
$select .= sprintf "%c\xFF\xFF\xFF",$sb1;
$select .= sprintf "%c\xFF\xFF\xFF",$sb2;
#++Use of uninitialized value within @owg_vlow in multiplication at
#++/usr/share/fhem/FHEM/21_OWAD.pm line 1362.
#=============== set the status ===============================
} elsif ( $page eq "status" ) {
my ($sb1,$sb2)=(0,0);
#-- issue the match ROM command \x55 and the set status memory page command
# \x55\x08\x00 reading 8 data bytes and 2 CRC bytes
$select="\x55\x08\x00";
for( $i=0;$i<int(@owg_fixed);$i++){
#if( $owg_mode[$i] eq "input" ){
if( 1 > 0){
#-- resolution (TODO: check !)
$sb1 = $owg_resoln[$i] & 15;
#-- alarm enabled
if( defined($hash->{owg_slow}->[$i]) ){
$sb2 = ( $hash->{owg_slow}->[$i] ne 0 ) ? 4 : 0;
}
if( defined($hash->{owg_shigh}->[$i]) ){
$sb2 += ( $hash->{owg_shigh}->[$i] ne 0 ) ? 8 : 0;
}
#-- range
$sb2 |= 1
if( $owg_range[$i] > 2560 );
} else {
$sb1 = 128;
$sb2 = 0;
}
$select .= sprintf "%c\xFF\xFF\xFF",$sb1;
$select .= sprintf "%c\xFF\xFF\xFF",$sb2;
}
#=============== wrong page write attempt ===============================
} else {
PT_EXIT("wrong memory page write attempt");
}
#=============== wrong page write attempt ===============================
} else {
PT_EXIT("wrong memory page write attempt");
}
#"setpage"
unless (OWX_ASYNC_Execute( $master, $thread, 1, $owx_dev, $select, 0 )) {
PT_EXIT("device $owx_dev not accessible for writing");
}
PT_WAIT_UNTIL(defined $thread->{ExecuteResponse});
my $response = $thread->{ExecuteResponse};
unless ($response->{success}) {
PT_EXIT("$owx_dev write not successful");
}
PT_END;
#"setpage"
$thread->{pt_execute} = OWX_ASYNC_PT_Execute($master,1,$owx_dev, $select, 0 );
$thread->{TimeoutTime} = gettimeofday()+2; #TODO: implement attribute-based timeout
PT_WAIT_THREAD($thread->{pt_execute});
delete $thread->{TimeoutTime};
die $thread->{pt_execute}->PT_CAUSE() if ($thread->{pt_execute}->PT_STATE() == PT_ERROR);
PT_END;
});
}
1;

395
fhem/FHEM/21_OWCOUNT.pm
View File

@ -99,7 +99,7 @@ no warnings 'deprecated';
sub Log3($$$);
my $owx_version="5.22";
my $owx_version="5.23";
#-- fixed raw channel name, flexible channel name
my @owg_fixed = ("A","B");
my @owg_channel = ("A","B");
@ -151,6 +151,8 @@ sub OWCOUNT_Initialize ($) {
$hash->{UndefFn} = "OWCOUNT_Undef";
$hash->{GetFn} = "OWCOUNT_Get";
$hash->{SetFn} = "OWCOUNT_Set";
$hash->{NotifyFn}= "OWCOUNT_Notify";
$hash->{InitFn} = "OWCOUNT_Init";
$hash->{AttrFn} = "OWCOUNT_Attr";
#-- see header for attributes
my $attlist = "IODev do_not_notify:0,1 showtime:0,1 model:DS2423,DS2423enew,DS2423eold LogM LogY ".
@ -264,9 +266,29 @@ sub OWCOUNT_Define ($$) {
readingsSingleUpdate($hash,"state","defined",1);
Log3 $name, 3, "OWCOUNT: Device $name defined.";
#-- Start timer for updates
InternalTimer(time()+10, "OWCOUNT_GetValues", $hash, 0);
$hash->{NOTIFYDEV} = "global";
if ($init_done) {
OWCOUNT_Init($hash);
}
return undef;
}
sub OWCOUNT_Notify ($$) {
my ($hash,$dev) = @_;
if( grep(m/^(INITIALIZED|REREADCFG)$/, @{$dev->{CHANGED}}) ) {
OWCOUNT_Init($hash);
} elsif( grep(m/^SAVE$/, @{$dev->{CHANGED}}) ) {
}
}
sub OWCOUNT_Init ($) {
my ($hash)=@_;
#-- Start timer for updates
RemoveInternalTimer($hash);
InternalTimer(gettimeofday()+10, "OWCOUNT_GetValues", $hash, 0);
#--
readingsSingleUpdate($hash,"state","Initialized",1);
return undef;
}
@ -303,6 +325,9 @@ sub OWCOUNT_Attr(@) {
AssignIoPort($hash,$value);
if( defined($hash->{IODev}) ) {
$hash->{ASYNC} = $hash->{IODev}->{TYPE} eq "OWX_ASYNC" ? 1 : 0;
if ($init_done) {
OWCOUNT_Init($hash);
}
}
last;
};
@ -626,7 +651,15 @@ sub OWCOUNT_Get($@) {
my $master = $hash->{IODev};
#-- asynchronous mode
if( $hash->{ASYNC} ){
$value = OWX_ASYNC_Verify($master,$hash->{ROM_ID});
my ($task,$task_state);
eval {
$task = OWX_ASYNC_PT_Verify($hash);
OWX_ASYNC_Schedule($hash,$task);
$task_state = OWX_ASYNC_RunToCompletion($master,$task);
};
return GP_Catch($@) if $@;
return $task->PT_CAUSE() if ($task_state == PT_ERROR or $task_state == PT_CANCELED);
return "$name.present => ".ReadingsVal($name,"present","unknown");
} else {
$value = OWX_Verify($master,$hash->{ROM_ID});
}
@ -800,6 +833,7 @@ sub OWCOUNT_GetPage ($$$@) {
my ($hash, $page,$final,$sync) = @_;
#-- get memory page/counter according to interface type
my $master= $hash->{IODev};
my $interface= $hash->{IODev}->{TYPE};
my $name = $hash->{NAME};
my $ret;
@ -815,15 +849,16 @@ sub OWCOUNT_GetPage ($$$@) {
$ret = OWXCOUNT_GetPage($hash,$page,$final);
}elsif( $interface eq "OWX_ASYNC" ){
if ($sync) {
#TODO use OWX_ASYNC_Schedule instead
my $task = PT_THREAD(\&OWXCOUNT_PT_GetPage);
my ($task,$task_state);
eval {
while ($task->PT_SCHEDULE($hash,$page,$final)) { OWX_ASYNC_Poll($hash->{IODev}); };
$task = OWXCOUNT_PT_GetPage($hash,$page,$final);
OWX_ASYNC_Schedule($hash,$task);
$task_state = OWX_ASYNC_RunToCompletion($master,$task);
};
$ret = ($@) ? GP_Catch($@) : $task->PT_RETVAL();
$ret = ($@) ? GP_Catch($@) : ($task_state == PT_ERROR or $task_state == PT_CANCELED) ? $task->PT_CAUSE() : $task->PT_RETVAL();
} else {
eval {
OWX_ASYNC_Schedule( $hash, PT_THREAD(\&OWXCOUNT_PT_GetPage),$hash,$page,$final );
OWX_ASYNC_Schedule( $hash, OWXCOUNT_PT_GetPage($hash,$page,$final) );
};
$ret = GP_Catch($@) if $@;
}
@ -1097,6 +1132,7 @@ sub OWCOUNT_InitializeDevice($) {
my $name = $hash->{NAME};
#-- get memory page/counter according to interface type
my $master= $hash->{IODev};
my $interface= $hash->{IODev}->{TYPE};
my $olddata = "";
@ -1123,12 +1159,13 @@ sub OWCOUNT_InitializeDevice($) {
$ret = OWXCOUNT_GetPage($hash,14,0);
$ret = OWXCOUNT_SetPage($hash,14,$olddata);
}elsif( $interface eq "OWX_ASYNC" ){
#TODO use OWX_ASYNC_Schedule instead
my $task = PT_THREAD(\&OWXCOUNT_PT_InitializeDevicePage);
my ($task,$task_state);
eval {
while ($task->PT_SCHEDULE($hash,14,$newdata)) { OWX_ASYNC_Poll($hash->{IODev}); };
$task = OWXCOUNT_PT_InitializeDevicePage($hash,14,$newdata);
OWX_ASYNC_Schedule($hash,$task);
$task_state = OWX_ASYNC_RunToCompletion($master,$task);
};
$ret = ($@) ? GP_Catch($@) : $task->PT_RETVAL();
$ret = ($@) ? GP_Catch($@) : ($task_state == PT_ERROR or $task_state == PT_CANCELED) ? $task->PT_CAUSE() : $task->PT_RETVAL();
#-- OWFS interface
}elsif( $interface eq "OWServer" ){
$ret = OWFSCOUNT_GetPage($hash,14,0);
@ -1150,12 +1187,13 @@ sub OWCOUNT_InitializeDevice($) {
$ret = OWXCOUNT_GetPage($hash,0,0);
$ret = OWXCOUNT_SetPage($hash,0,$olddata);
}elsif( $interface eq "OWX_ASYNC" ){
#TODO use OWX_ASYNC_Schedule instead
my $task = PT_THREAD(\&OWXCOUNT_PT_InitializeDevicePage);
my ($task,$task_state);
eval {
while ($task->PT_SCHEDULE($hash,0,$newdata)) { OWX_ASYNC_Poll($hash->{IODev}); };
$task = OWXCOUNT_PT_InitializeDevicePage($hash,0,$newdata);
OWX_ASYNC_Schedule($hash,$task);
$task_state = OWX_ASYNC_RunToCompletion($master,$task);
};
$ret = ($@) ? GP_Catch($@) : $task->PT_RETVAL();
$ret = ($@) ? GP_Catch($@) : ($task_state == PT_ERROR or $task_state == PT_CANCELED) ? $task->PT_CAUSE() : $task->PT_RETVAL();
#-- OWFS interface
}elsif( $interface eq "OWServer" ){
$ret = OWFSCOUNT_GetPage($hash,0,0);
@ -1372,7 +1410,7 @@ sub OWCOUNT_SetPage ($$$) {
$ret = OWXCOUNT_SetPage($hash,$page,$data);
}elsif( $interface eq "OWX_ASYNC" ){
eval {
OWX_ASYNC_Schedule( $hash, PT_THREAD(\&OWXCOUNT_PT_SetPage),$hash,$page,$data );
OWX_ASYNC_Schedule( $hash, OWXCOUNT_PT_SetPage($hash,$page,$data) );
};
$ret = GP_Catch($@) if $@;
#-- OWFS interface
@ -1578,12 +1616,12 @@ sub OWFSCOUNT_SetPage($$$) {
#
########################################################################################
sub OWXCOUNT_BinValues($$$$$$$$) {
my ($hash, $context, $success, $reset, $owx_dev, $select, $numread, $res) = @_;
sub OWXCOUNT_BinValues($$$$$) {
my ($hash, $context, $owx_dev, $select, $res) = @_;
#-- unused are success, reset, data
return undef unless ($success and defined $context and $context =~ /^(get|set)page\.([\d]+)(\.final|)$/);
return undef unless (defined $context and $context =~ /^(get|set)page\.([\d]+)(\.final|)$/);
my $cmd = $1;
my $page = $2;
@ -1711,7 +1749,7 @@ sub OWXCOUNT_GetPage($$$) {
if( $res eq 0 );
return "$owx_dev has returned invalid data"
if( length($res)!=54);
return OWXCOUNT_BinValues($hash,$context,1,1,$owx_dev,$select,42,substr($res,12));
return OWXCOUNT_BinValues($hash,$context,$owx_dev,$select,substr($res,12));
}
########################################################################################
@ -1822,54 +1860,50 @@ sub OWXCOUNT_SetPage($$$) {
########################################################################################
sub OWXCOUNT_PT_GetPage($$$) {
my ($thread,$hash,$page,$final) = @_;
my ($select, $res, $response);
#-- ID of the device, hash of the busmaster
my $owx_dev = $hash->{ROM_ID};
my $master = $hash->{IODev};
PT_BEGIN($thread);
#-- reset presence
$hash->{PRESENT} = 0;
#=============== wrong value requested ===============================
if( ($page<0) || ($page>15) ){
PT_EXIT("wrong memory page requested");
}
#=============== get memory + counter ===============================
#-- issue the match ROM command \x55 and the read memory + counter command
# \xA5 TA1 TA2 reading 40 data bytes and 2 CRC bytes
my $ta2 = ($page*32) >> 8;
my $ta1 = ($page*32) & 255;
$select=sprintf("\xA5%c%c",$ta1,$ta2);
#-- reading 9 + 3 + 40 data bytes (32 byte memory, 4 byte counter + 4 byte zeroes) and 2 CRC bytes = 54 bytes
unless (OWX_ASYNC_Execute( $master, $thread, 1, $owx_dev, $select, 42 )) {
PT_EXIT("device $owx_dev not accessible for reading page $page");
}
PT_WAIT_UNTIL($thread->{ExecuteResponse});
$response = $thread->{ExecuteResponse};
my ($hash,$page,$final) = @_;
#-- reset the bus (needed to stop receiving data ?)
OWX_ASYNC_Execute( $master, $thread, 1, undef, undef, undef );
return PT_THREAD(sub {
my ($thread) = @_;
unless ($response->{success}) {
PT_EXIT("device $owx_dev error reading page $page");
}
$res = $response->{readdata};
#TODO validate whether testing '0' is appropriate with async interface
if( $res eq 0 ) {
PT_EXIT("device $owx_dev error reading page $page");
}
$res = OWXCOUNT_BinValues($hash,"getpage.".$page.($final ? ".final" : ""),1,1,$owx_dev,$response->{writedata},$response->{numread},$res);
if ($res) {
PT_EXIT($res);
}
PT_END;
#-- ID of the device, hash of the busmaster
my $owx_dev = $hash->{ROM_ID};
my $master = $hash->{IODev};
PT_BEGIN($thread);
#=============== wrong value requested ===============================
if( ($page<0) || ($page>15) ){
die("wrong memory page requested");
}
#=============== get memory + counter ===============================
#-- issue the match ROM command \x55 and the read memory + counter command
# \xA5 TA1 TA2 reading 40 data bytes and 2 CRC bytes
my $ta2 = ($page*32) >> 8;
my $ta1 = ($page*32) & 255;
$thread->{'select'}=sprintf("\xA5%c%c",$ta1,$ta2);
#-- reading 9 + 3 + 40 data bytes (32 byte memory, 4 byte counter + 4 byte zeroes) and 2 CRC bytes = 54 bytes
$thread->{pt_execute} = OWX_ASYNC_PT_Execute($master,1,$owx_dev, $thread->{'select'}, 42 );
$thread->{TimeoutTime} = gettimeofday()+2; #TODO: implement attribute-based timeout
PT_WAIT_THREAD($thread->{pt_execute});
delete $thread->{TimeoutTime};
die $thread->{pt_execute}->PT_CAUSE() if ($thread->{pt_execute}->PT_STATE() == PT_ERROR);
$thread->{response} = $thread->{pt_execute}->PT_RETVAL();
#-- reset the bus (needed to stop receiving data ?)
$thread->{pt_execute} = OWX_ASYNC_PT_Execute($master,1,undef,undef,undef);
$thread->{TimeoutTime} = gettimeofday()+2; #TODO: implement attribute-based timeout
PT_WAIT_THREAD($thread->{pt_execute});
delete $thread->{TimeoutTime};
die $thread->{pt_execute}->PT_CAUSE() if ($thread->{pt_execute}->PT_STATE() == PT_ERROR);
if (my $ret = OWXCOUNT_BinValues($hash,"getpage.".$page.($final ? ".final" : ""),$owx_dev,$thread->{'select'},$thread->{response})) {
die $ret;
}
PT_END;
});
}
########################################################################################
@ -1883,144 +1917,119 @@ sub OWXCOUNT_PT_GetPage($$$) {
sub OWXCOUNT_PT_SetPage($$$) {
my ($thread,$hash,$page,$data) = @_;
my ($hash,$page,$data) = @_;
my ($select, $res, $response);
#-- ID of the device, hash of the busmaster
my $owx_dev = $hash->{ROM_ID};
my $master = $hash->{IODev};
PT_BEGIN($thread);
#=============== wrong page requested ===============================
if( ($page<0) || ($page>15) ){
PT_EXIT("wrong memory page write attempt");
}
#=============== midnight value =====================================
if( ($page==14) || ($page==15) ){
OWCOUNT_ParseMidnight($hash,$data,$page);
}
#=============== set memory =========================================
#-- issue the match ROM command \x55 and the write scratchpad command
# \x0F TA1 TA2 followed by the data
my $ta2 = ($page*32) >> 8;
my $ta1 = ($page*32) & 255;
#Log 1, "OWXCOUNT: setting page Nr. $ta2 $ta1 $data";
$select=sprintf("\x0F%c%c",$ta1,$ta2).$data;
#-- first command, next 2 are address, then data
#$res2 = "OWCOUNT SET PAGE 1 device $owx_dev ";
#for($i=0;$i<10;$i++){
# $j=int(ord(substr($select,$i,1))/16);
# $k=ord(substr($select,$i,1))%16;
# $res2.=sprintf "0x%1x%1x ",$j,$k;
#}
#main::Log(1, $res2);
return PT_THREAD(sub {
my ($thread) = @_;
#"setpage.1"
unless (OWX_ASYNC_Execute( $master, $thread, 1, $owx_dev, $select, 0)) {
PT_EXIT("device $owx_dev not accessible in writing scratchpad");
}
PT_WAIT_UNTIL($thread->{ExecuteResponse});
unless ($thread->{ExecuteResponse}->{success}) {
PT_EXIT("device $owx_dev error writing scratchpad");
}
my ($res, $response);
#-- issue the match ROM command \x55 and the read scratchpad command
# \xAA, receiving 2 address bytes, 1 status byte and scratchpad content
$select = "\xAA";
#-- reading 9 + 3 + up to 32 bytes
# TODO: sometimes much less than 28
#"setpage.2"
unless (OWX_ASYNC_Execute( $master, $thread, 1, $owx_dev, $select, 28)) {
PT_EXIT("device $owx_dev not accessible in writing scratchpad");
}
PT_WAIT_UNTIL($thread->{ExecuteResponse});
$response = $thread->{ExecuteResponse};
unless ($response->{success}) {
PT_EXIT("device $owx_dev error writing scratchpad");
}
$res = $response->{readdata};
if( length($res) < 13 ){
PT_EXIT("device $owx_dev not accessible in reading scratchpad");
}
#-- first 1 command, next 2 are address, then data
#$res3 = substr($res,9,10);
#$res2 = "OWCOUNT SET PAGE 2 device $owx_dev ";
#for($i=0;$i<10;$i++){
# $j=int(ord(substr($res3,$i,1))/16);
# $k=ord(substr($res3,$i,1))%16;
# $res2.=sprintf "0x%1x%1x ",$j,$k;
#}
#main::Log(1, $res2);
#-- issue the match ROM command \x55 and the copy scratchpad command
# \x5A followed by 3 byte authentication code obtained in previous read
$select="\x5A".substr($res,0,3);
#-- first command, next 2 are address, then data
#$res2 = "OWCOUNT SET PAGE 3 device $owx_dev ";
#for($i=0;$i<10;$i++){
# $j=int(ord(substr($select,$i,1))/16);
# $k=ord(substr($select,$i,1))%16;
# $res2.=sprintf "0x%1x%1x ",$j,$k;
#}
#main::Log(1, $res2);
#-- ID of the device, hash of the busmaster
my $owx_dev = $hash->{ROM_ID};
my $master = $hash->{IODev};
#"setpage.3"
unless (OWX_ASYNC_Execute( $master, $thread, 1, $owx_dev, $select, 6)) {
PT_EXIT("device $owx_dev not accessible for copying scratchpad");
}
PT_WAIT_UNTIL($thread->{ExecuteResponse});
$response = $thread->{ExecuteResponse};
unless ($response->{success}) {
PT_EXIT("device $owx_dev error copying scratchpad");
}
$res = $response->{readdata};
#TODO validate whether testing '0' is appropriate with async interface
#-- process results
if( $res eq 0 ){
PT_EXIT("device $owx_dev error copying scratchpad");
}
PT_END;
PT_BEGIN($thread);
#=============== wrong page requested ===============================
if( ($page<0) || ($page>15) ){
PT_EXIT("wrong memory page write attempt");
}
#=============== midnight value =====================================
if( ($page==14) || ($page==15) ){
OWCOUNT_ParseMidnight($hash,$data,$page);
}
#=============== set memory =========================================
#-- issue the match ROM command \x55 and the write scratchpad command
# \x0F TA1 TA2 followed by the data
my $ta2 = ($page*32) >> 8;
my $ta1 = ($page*32) & 255;
#Log 1, "OWXCOUNT: setting page Nr. $ta2 $ta1 $data";
$thread->{'select'}=sprintf("\x0F%c%c",$ta1,$ta2).$data;
#"setpage.1"
$thread->{pt_execute} = OWX_ASYNC_PT_Execute($master,1,$owx_dev, $thread->{'select'}, 0 );
$thread->{TimeoutTime} = gettimeofday()+2; #TODO: implement attribute-based timeout
PT_WAIT_THREAD($thread->{pt_execute});
delete $thread->{TimeoutTime};
die $thread->{pt_execute}->PT_CAUSE() if ($thread->{pt_execute}->PT_STATE() == PT_ERROR);
#-- issue the match ROM command \x55 and the read scratchpad command
# \xAA, receiving 2 address bytes, 1 status byte and scratchpad content
$thread->{'select'} = "\xAA";
#-- reading 9 + 3 + up to 32 bytes
# TODO: sometimes much less than 28
#"setpage.2"
$thread->{pt_execute} = OWX_ASYNC_PT_Execute($master,1,$owx_dev, $thread->{'select'}, 28 );
$thread->{TimeoutTime} = gettimeofday()+2; #TODO: implement attribute-based timeout
PT_WAIT_THREAD($thread->{pt_execute});
delete $thread->{TimeoutTime};
die $thread->{pt_execute}->PT_CAUSE() if ($thread->{pt_execute}->PT_STATE() == PT_ERROR);
$res = $thread->{pt_execute}->PT_RETVAL();
if( length($res) < 13 ){
PT_EXIT("device $owx_dev not accessible in reading scratchpad");
}
#-- issue the match ROM command \x55 and the copy scratchpad command
# \x5A followed by 3 byte authentication code obtained in previous read
$thread->{'select'}="\x5A".substr($res,0,3);
#-- first command, next 2 are address, then data
#"setpage.3"
$thread->{pt_execute} = OWX_ASYNC_PT_Execute($master,1,$owx_dev, $thread->{'select'}, 6 );
$thread->{TimeoutTime} = gettimeofday()+2; #TODO: implement attribute-based timeout
PT_WAIT_THREAD($thread->{pt_execute});
delete $thread->{TimeoutTime};
die $thread->{pt_execute}->PT_CAUSE() if ($thread->{pt_execute}->PT_STATE() == PT_ERROR);
$res = $thread->{pt_execute}->PT_RETVAL();
#TODO validate whether testing '0' is appropriate with async interface
#-- process results
if( $res eq 0 ){
PT_EXIT("device $owx_dev error copying scratchpad");
}
PT_END;
});
}
sub OWXCOUNT_PT_InitializeDevicePage($$$) {
my ($thread,$hash,$page,$newdata) = @_;
my ($hash,$page,$newdata) = @_;
my $ret;
PT_BEGIN($thread);
return PT_THREAD(sub {
my ($thread) = @_;
$thread->{task} = PT_THREAD(\&OWXCOUNT_PT_GetPage);
PT_WAIT_THREAD($thread->{task},$hash,$page,0);
$ret = $thread->{task}->PT_RETVAL();
if ($ret) {
PT_EXIT($ret);
}
my $ret;
$thread->{olddata} = $hash->{owg_str}->[14];
PT_BEGIN($thread);
$thread->{task} = PT_THREAD(\&OWXCOUNT_PT_SetPage);
PT_WAIT_THREAD($thread->{task},$hash,$page,$newdata);
$ret = $thread->{task}->PT_RETVAL();
if ($ret) {
PT_EXIT($ret);
}
$thread->{task} = OWXCOUNT_PT_GetPage($hash,$page,0);
PT_WAIT_THREAD($thread->{task});
$ret = $thread->{task}->PT_RETVAL();
if ($ret) {
PT_EXIT($ret);
}
$thread->{task} = PT_THREAD(\&OWXCOUNT_PT_GetPage);
PT_WAIT_THREAD($thread->{task},$hash,$page,0);
$ret = $thread->{task}->PT_RETVAL();
if ($ret) {
PT_EXIT($ret);
}
$thread->{task} = PT_THREAD(\&OWXCOUNT_PT_SetPage);
PT_WAIT_THREAD($thread->{task},$hash,$page,$thread->{olddata});
$ret = $thread->{task}->PT_RETVAL();
if ($ret) {
PT_EXIT($ret);
}
PT_END;
$thread->{olddata} = $hash->{owg_str}->[14];
$thread->{task} = OWXCOUNT_PT_SetPage($hash,$page,$newdata);
PT_WAIT_THREAD($thread->{task});
$ret = $thread->{task}->PT_RETVAL();
if ($ret) {
PT_EXIT($ret);
}
$thread->{task} = OWXCOUNT_PT_GetPage($hash,$page,0);
PT_WAIT_THREAD($thread->{task});
$ret = $thread->{task}->PT_RETVAL();
if ($ret) {
PT_EXIT($ret);
}
$thread->{task} = OWXCOUNT_PT_SetPage($hash,$page,$thread->{olddata});
PT_WAIT_THREAD($thread->{task});
$ret = $thread->{task}->PT_RETVAL();
if ($ret) {
PT_EXIT($ret);
}
PT_END;
});
}
1;

77
fhem/FHEM/21_OWID.pm
View File

@ -49,13 +49,26 @@
package main;
use vars qw{%attr %defs %modules $readingFnAttributes $init_done};
use Time::HiRes qw(usleep ualarm gettimeofday tv_interval);
use Time::HiRes qw(gettimeofday);
use strict;
use warnings;
#add FHEM/lib to @INC if it's not allready included. Should rather be in fhem.pl than here though...
BEGIN {
if (!grep(/FHEM\/lib$/,@INC)) {
foreach my $inc (grep(/FHEM$/,@INC)) {
push @INC,$inc."/lib";
};
};
};
use GPUtils qw(:all);
use ProtoThreads;
no warnings 'deprecated';
sub Log($$);
my $owx_version="5.12";
my $owx_version="5.13";
#-- declare variables
my %gets = (
"present" => "",
@ -92,6 +105,8 @@ sub OWID_Initialize ($) {
$hash->{GetFn} = "OWID_Get";
$hash->{SetFn} = "OWID_Set";
$hash->{AttrFn} = "OWID_Attr";
$hash->{NotifyFn} = "OWID_Notify";
$hash->{InitFn} = "OWID_Init";
$hash->{AttrList} = "IODev do_not_notify:0,1 showtime:0,1 model loglevel:0,1,2,3,4,5 ".
"interval ".
$readingFnAttributes;
@ -197,14 +212,29 @@ sub OWID_Define ($$) {
$modules{OWID}{defptr}{$id} = $hash;
#--
readingsSingleUpdate($hash,"state","Defined",1);
Log 3, "OWID: Device $name defined.";
Log 3, "OWID: Device $name defined.";
#-- Initialization reading according to interface type
my $interface= $hash->{IODev}->{TYPE};
$hash->{NOTIFYDEV} = "global";
if ($init_done) {
return OWID_Init($hash);
}
return undef;
}
sub OWID_Notify ($$) {
my ($hash,$dev) = @_;
if( grep(m/^(INITIALIZED|REREADCFG)$/, @{$dev->{CHANGED}}) ) {
OWID_Init($hash);
} elsif( grep(m/^SAVE$/, @{$dev->{CHANGED}}) ) {
}
}
sub OWID_Init ($) {
my ($hash)=@_;
#-- Start timer for updates
InternalTimer(time()+5+$hash->{INTERVAL}, "OWID_GetValues", $hash, 0);
RemoveInternalTimer($hash);
InternalTimer(gettimeofday()+10, "OWID_GetValues", $hash, 0);
#--
readingsSingleUpdate($hash,"state","Initialized",1);
@ -248,6 +278,9 @@ sub OWID_Attr(@) {
AssignIoPort($hash,$value);
if( defined($hash->{IODev}) ) {
$hash->{ASYNC} = $hash->{IODev}->{TYPE} eq "OWX_ASYNC" ? 1 : 0;
if ($init_done) {
OWID_Init($hash);
}
}
last;
};
@ -301,7 +334,15 @@ sub OWID_Get($@) {
my $master = $hash->{IODev};
#-- asynchronous mode
if( $hash->{ASYNC} ){
$value = OWX_ASYNC_Verify($master,$hash->{ROM_ID});
my ($task,$task_state);
eval {
$task = OWX_ASYNC_PT_Verify($hash);
OWX_ASYNC_Schedule($hash,$task);
$task_state = OWX_ASYNC_RunToCompletion($master,$task);
};
return GP_Catch($@) if $@;
return $task->PT_CAUSE() if ($task_state == PT_ERROR or $task_state == PT_CANCELED);
return "$name.present => ".ReadingsVal($name,"present","unknown");
} else {
$value = OWX_Verify($master,$hash->{ROM_ID});
}
@ -344,22 +385,18 @@ sub OWID_GetValues($) {
#-- hash of the busmaster
my $master = $hash->{IODev};
#-- measure elapsed time
my $t0 = [gettimeofday];
if( $hash->{ASYNC} ){
$value = OWX_ASYNC_Verify($master,$hash->{ROM_ID});
#TODO use OWX_ASYNC_Schedule instead
my $task = OWX_ASYNC_PT_Verify($hash);
eval {
OWX_ASYNC_Schedule($hash,$task);
};
return GP_Catch($@) if $@;
return undef;
} else {
$value = OWX_Verify($master,$hash->{ROM_ID});
}
#my $thr = threads->create('OWX_Verify', $master, $hash->{ROM_ID});
#$thr->detach();
my $t1 = [gettimeofday];
my $t0_t1 = tv_interval $t0, $t1;
#Log 1,"====> Time for verify = $t0_t1";
#-- generate an event only if presence has changed
if( $value == 0 ){
readingsSingleUpdate($hash,"present",0,$hash->{PRESENT});

963
fhem/FHEM/21_OWLCD.pm
View File

File diff suppressed because it is too large Load Diff

446
fhem/FHEM/21_OWMULTI.pm
View File

@ -82,7 +82,7 @@ no warnings 'deprecated';
sub Log($$);
my $owx_version="5.15";
my $owx_version="5.16";
#-- flexible channel name
my $owg_channel;
@ -130,6 +130,8 @@ sub OWMULTI_Initialize ($) {
$hash->{UndefFn} = "OWMULTI_Undef";
$hash->{GetFn} = "OWMULTI_Get";
$hash->{SetFn} = "OWMULTI_Set";
$hash->{NotifyFn}= "OWMULTI_Notify";
$hash->{InitFn} = "OWMULTI_Init";
$hash->{AttrFn} = "OWMULTI_Attr";
#tempOffset = a temperature offset added to the temperature reading for correction
@ -182,6 +184,9 @@ sub OWMULTI_Attr(@) {
AssignIoPort($hash,$value);
if( defined($hash->{IODev}) ) {
$hash->{ASYNC} = $hash->{IODev}->{TYPE} eq "OWX_ASYNC" ? 1 : 0;
if ($init_done) {
OWMULTI_Init($hash);
}
}
last;
};
@ -276,10 +281,30 @@ sub OWMULTI_Define ($$) {
#--
readingsSingleUpdate($hash,"state","defined",1);
Log 3, "OWMULTI: Device $name defined.";
#-- Start timer for updates
InternalTimer(time()+10, "OWMULTI_GetValues", $hash, 0);
$hash->{NOTIFYDEV} = "global";
if ($init_done) {
OWMULTI_Init($hash);
}
return undef;
}
sub OWMULTI_Notify ($$) {
my ($hash,$dev) = @_;
if( grep(m/^(INITIALIZED|REREADCFG)$/, @{$dev->{CHANGED}}) ) {
OWMULTI_Init($hash);
} elsif( grep(m/^SAVE$/, @{$dev->{CHANGED}}) ) {
}
}
sub OWMULTI_Init ($) {
my ($hash)=@_;
#-- Start timer for updates
RemoveInternalTimer($hash);
InternalTimer(gettimeofday()+10, "OWMULTI_GetValues", $hash, 0);
#--
readingsSingleUpdate($hash,"state","Initialized",1);
return undef;
}
@ -445,6 +470,8 @@ sub OWMULTI_Get($@) {
return "$name.id => $value";
}
#-- hash of the busmaster
my $master = $hash->{IODev};
#-- Get other values according to interface type
my $interface= $hash->{IODev}->{TYPE};
@ -452,11 +479,17 @@ sub OWMULTI_Get($@) {
if($a[1] eq "present" ) {
#-- OWX interface
if( $interface =~ /^OWX/ ){
#-- hash of the busmaster
my $master = $hash->{IODev};
#-- asynchronous mode
if( $hash->{ASYNC} ){
$value = OWX_ASYNC_Verify($master,$hash->{ROM_ID});
my ($task,$task_state);
eval {
$task = OWX_ASYNC_PT_Verify($hash);
OWX_ASYNC_Schedule($hash,$task);
$task_state = OWX_ASYNC_RunToCompletion($master,$task);
};
return GP_Catch($@) if $@;
return $task->PT_CAUSE() if ($task_state == PT_ERROR or $task_state == PT_CANCELED);
return "$name.present => ".ReadingsVal($name,"present","unknown");
} else {
$value = OWX_Verify($master,$hash->{ROM_ID});
}
@ -484,12 +517,13 @@ sub OWMULTI_Get($@) {
#-- not different from getting all values ..
$ret = OWXMULTI_GetValues($hash);
}elsif( $interface eq "OWX_ASYNC"){
#TODO use OWX_ASYNC_Schedule instead
my $task = PT_THREAD(\&OWXMULTI_PT_GetValues);
my ($task,$task_state);
eval {
while ($task->PT_SCHEDULE($hash)) { OWX_ASYNC_Poll($hash->{IODev}); };
$task = OWXMULTI_PT_GetValues($hash);
OWX_ASYNC_Schedule($hash,$task);
$task_state = OWX_ASYNC_RunToCompletion($master,$task);
};
$ret = ($@) ? GP_Catch($@) : $task->PT_RETVAL();
$ret = ($@) ? GP_Catch($@) : ($task_state == PT_ERROR or $task_state == PT_CANCELED) ? $task->PT_CAUSE() : $task->PT_RETVAL();
#-- OWFS interface not yet implemented
}elsif( $interface eq "OWServer" ){
$ret = OWFSMULTI_GetValues($hash);
@ -558,7 +592,7 @@ sub OWMULTI_GetValues($) {
}
}elsif( $interface eq "OWX_ASYNC" ){
eval {
OWX_ASYNC_Schedule( $hash, PT_THREAD(\&OWXMULTI_PT_GetValues),$hash );
OWX_ASYNC_Schedule( $hash, OWXMULTI_PT_GetValues($hash) );
};
$ret = GP_Catch($@) if $@;
}elsif( $interface eq "OWServer" ){
@ -656,7 +690,7 @@ sub OWMULTI_Set($@) {
$ret = OWXMULTI_SetValues($hash,@a);
}elsif( $interface eq "OWX_ASYNC" ){
eval {
OWX_ASYNC_Schedule( $hash, PT_THREAD(\&OWXMULTI_PT_SetValues),$hash,@a );
OWX_ASYNC_Schedule( $hash, OWXMULTI_PT_SetValues($hash,@a) );
};
$ret = GP_Catch($@) if $@;
#-- OWFS interface
@ -1013,173 +1047,166 @@ sub OWXMULTI_SetValues($@) {
sub OWXMULTI_PT_GetValues($) {
my ($thread,$hash) = @_;
my ($hash) = @_;
return PT_THREAD(sub {
my ($thread) = @_;
my ($i,$j,$k,$res,$ret,$response);
#-- ID of the device
my $owx_dev = $hash->{ROM_ID};
#-- hash of the busmaster
my $master = $hash->{IODev};
PT_BEGIN($thread);
#------------------------------------------------------------------------------------
#-- switch the device to current measurement off, VDD only
#-- issue the match ROM command \x55 and the write scratchpad command
#"ds2438.writestatusvdd"
$thread->{pt_execute} = OWX_ASYNC_PT_Execute($master,1,$owx_dev,"\x4E\x00\x08",0);
$thread->{TimeoutTime} = gettimeofday()+2; #TODO: implement attribute-based timeout
PT_WAIT_THREAD($thread->{pt_execute});
delete $thread->{TimeoutTime};
die $thread->{pt_execute}->PT_CAUSE() if ($thread->{pt_execute}->PT_STATE() == PT_ERROR);
#-- copy scratchpad to register
#-- issue the match ROM command \x55 and the copy scratchpad command
#"ds2438.copyscratchpadvdd"
$thread->{pt_execute} = OWX_ASYNC_PT_Execute($master,1,$owx_dev,"\x48\x00",0);
$thread->{TimeoutTime} = gettimeofday()+2; #TODO: implement attribute-based timeout
PT_WAIT_THREAD($thread->{pt_execute});
delete $thread->{TimeoutTime};
die $thread->{pt_execute}->PT_CAUSE() if ($thread->{pt_execute}->PT_STATE() == PT_ERROR);
#-- initiate temperature conversion
#-- conversion needs some 12 ms !
#-- issue the match ROM command \x55 and the start conversion command
#"ds2438.temperaturconversionvdd"
$thread->{pt_execute} = OWX_ASYNC_PT_Execute($master,1,$owx_dev,"\x44",0);
$thread->{TimeoutTime} = gettimeofday()+2; #TODO: implement attribute-based timeout
PT_WAIT_THREAD($thread->{pt_execute});
delete $thread->{TimeoutTime};
die $thread->{pt_execute}->PT_CAUSE() if ($thread->{pt_execute}->PT_STATE() == PT_ERROR);
$thread->{ExecuteTime} = gettimeofday() + 0.012;
PT_YIELD_UNTIL(gettimeofday() >= $thread->{ExecuteTime});
delete $thread->{ExecuteTime};
my ($i,$j,$k,$res,$ret,$response);
#-- ID of the device
my $owx_dev = $hash->{ROM_ID};
#-- hash of the busmaster
my $master = $hash->{IODev};
#-- initiate voltage conversion
#-- conversion needs some 6 ms !
#-- issue the match ROM command \x55 and the start conversion command
#"ds2438.voltageconversionvdd"
$thread->{pt_execute} = OWX_ASYNC_PT_Execute($master,1,$owx_dev,"\xB4",0);
$thread->{TimeoutTime} = gettimeofday()+2; #TODO: implement attribute-based timeout
PT_WAIT_THREAD($thread->{pt_execute});
delete $thread->{TimeoutTime};
die $thread->{pt_execute}->PT_CAUSE() if ($thread->{pt_execute}->PT_STATE() == PT_ERROR);
$thread->{ExecuteTime} = gettimeofday() + 0.006;
PT_YIELD_UNTIL(gettimeofday() >= $thread->{ExecuteTime});
delete $thread->{ExecuteTime};
PT_BEGIN($thread);
#-- reset presence
$hash->{PRESENT} = 0;
#------------------------------------------------------------------------------------
#-- switch the device to current measurement off, VDD only
#-- issue the match ROM command \x55 and the write scratchpad command
#"ds2438.writestatusvdd"
unless (OWX_ASYNC_Execute( $master, $thread, 1, $owx_dev, "\x4E\x00\x08", 0)) {
PT_EXIT("$owx_dev not accessible for writing status");
}
PT_WAIT_UNTIL($thread->{ExecuteResponse});
unless ($thread->{ExecuteResponse}->{success}) {
PT_EXIT("$owx_dev write status failed");
}
#-- copy scratchpad to register
#-- issue the match ROM command \x55 and the copy scratchpad command
#"ds2438.copyscratchpadvdd"
unless (OWX_ASYNC_Execute( $master, $thread, 1, $owx_dev, "\x48\x00", 0)) {
PT_EXIT("$owx_dev not accessible to copy scratchpad");
}
PT_WAIT_UNTIL($thread->{ExecuteResponse});
unless ($thread->{ExecuteResponse}->{success}) {
PT_EXIT("$owx_dev copy scratchpad failed");
}
#-- initiate temperature conversion
#-- conversion needs some 12 ms !
#-- issue the match ROM command \x55 and the start conversion command
#"ds2438.temperaturconversionvdd"
unless (OWX_ASYNC_Execute( $master, $thread, 1, $owx_dev, "\x44", 0)) {
PT_EXIT("$owx_dev not accessible for temperature conversion");
}
PT_WAIT_UNTIL($thread->{ExecuteResponse});
unless ($thread->{ExecuteResponse}->{success}) {
PT_EXIT("$owx_dev temperature conversion failed");
}
#TODO implement async wait
select(undef,undef,undef,0.012);
#-- initiate voltage conversion
#-- conversion needs some 6 ms !
#-- issue the match ROM command \x55 and the start conversion command
#"ds2438.voltageconversionvdd"
unless (OWX_ASYNC_Execute( $master, $thread, 1, $owx_dev, "\xB4", 0)) {
PT_EXIT("$owx_dev not accessible for voltage conversion");
}
PT_WAIT_UNTIL($thread->{ExecuteResponse});
unless ($thread->{ExecuteResponse}->{success}) {
PT_EXIT("$owx_dev voltage conversion failed");
}
#TODO implement async wait
select(undef,undef,undef,0.006);
#-- from memory to scratchpad
#-- copy needs some 12 ms !
#-- issue the match ROM command \x55 and the recall memory command
#"ds2438.recallmemoryvdd"
unless (OWX_ASYNC_Execute( $master, $thread, 1, $owx_dev, "\xB8\x00", 0)) {
PT_EXIT("$owx_dev not accessible for recall memory");
}
PT_WAIT_UNTIL($thread->{ExecuteResponse});
unless ($thread->{ExecuteResponse}->{success}) {
PT_EXIT("$owx_dev recall memory failed");
}
#TODO implement async wait
select(undef,undef,undef,0.012);
#-- NOW ask the specific device
#-- issue the match ROM command \x55 and the read scratchpad command \xBE
#-- reading 9 + 2 + 9 data bytes = 20 bytes
#"ds2438.getvdd"
unless (OWX_ASYNC_Execute( $master, $thread, 1, $owx_dev, "\xBE\x00", 9)) {
PT_EXIT("$owx_dev not accessible in 2nd step");
}
PT_WAIT_UNTIL($thread->{ExecuteResponse});
$response = $thread->{ExecuteResponse};
unless ($response->{success}) {
PT_EXIT("$owx_dev not accessible in 2nd step");
}
$res = $response->{readdata};
unless (defined $res and length($res)==9) {
PT_EXIT("$owx_dev has returned invalid data");
}
$ret = OWXMULTI_BinValues($hash,"ds2438.getvdd",1,undef,$owx_dev,undef,undef,$res);
if (defined $ret) {
PT_EXIT($ret);
}
#------------------------------------------------------------------------------------
#-- switch the device to current measurement off, V external only
#-- issue the match ROM command \x55 and the write scratchpad command
#"ds2438.writestatusvad"
unless (OWX_ASYNC_Execute( $master, $thread, 1, $owx_dev, "\x4E\x00\x00", 0)) {
PT_EXIT("$owx_dev not accessible to write status");
}
PT_WAIT_UNTIL($thread->{ExecuteResponse});
unless ($thread->{ExecuteResponse}->{success}) {
PT_EXIT("$owx_dev write status failed");
}
#-- copy scratchpad to register
#-- issue the match ROM command \x55 and the copy scratchpad command
#"ds2438.copyscratchpadvad"
unless (OWX_ASYNC_Execute( $master, $thread, 1, $owx_dev, "\x48\x00", 0)) {
PT_EXIT("$owx_dev not accessible to copy scratchpad");
}
PT_WAIT_UNTIL($thread->{ExecuteResponse});
unless ($thread->{ExecuteResponse}->{success}) {
PT_EXIT("$owx_dev copy scratchpad failed");
}
#-- initiate voltage conversion
#-- conversion needs some 6 ms !
#-- issue the match ROM command \x55 and the start conversion command
#"ds2438.voltageconversionvad"
unless (OWX_ASYNC_Execute( $master, $thread, 1, $owx_dev, "\xB4", 0)) {
PT_EXIT("$owx_dev not accessible for voltage conversion");
}
PT_WAIT_UNTIL($thread->{ExecuteResponse});
unless ($thread->{ExecuteResponse}->{success}) {
PT_EXIT("$owx_dev voltage conversion failed");
}
#TODO implement async wait
select(undef,undef,undef,0.006);
#-- from memory to scratchpad
#-- copy needs some 12 ms !
#-- issue the match ROM command \x55 and the recall memory command
#"ds2438.recallmemoryvdd"
$thread->{pt_execute} = OWX_ASYNC_PT_Execute($master,1,$owx_dev,"\xB8\x00",0);
$thread->{TimeoutTime} = gettimeofday()+2; #TODO: implement attribute-based timeout
PT_WAIT_THREAD($thread->{pt_execute});
delete $thread->{TimeoutTime};
die $thread->{pt_execute}->PT_CAUSE() if ($thread->{pt_execute}->PT_STATE() == PT_ERROR);
$thread->{ExecuteTime} = gettimeofday() + 0.012;
PT_YIELD_UNTIL(gettimeofday() >= $thread->{ExecuteTime});
delete $thread->{ExecuteTime};
#-- NOW ask the specific device
#-- issue the match ROM command \x55 and the read scratchpad command \xBE
#-- reading 9 + 2 + 9 data bytes = 20 bytes
#"ds2438.getvdd"
$thread->{pt_execute} = OWX_ASYNC_PT_Execute($master,1,$owx_dev,"\xBE\x00",9);
$thread->{TimeoutTime} = gettimeofday()+2; #TODO: implement attribute-based timeout
PT_WAIT_THREAD($thread->{pt_execute});
delete $thread->{TimeoutTime};
die $thread->{pt_execute}->PT_CAUSE() if ($thread->{pt_execute}->PT_STATE() == PT_ERROR);
$res = $thread->{pt_execute}->PT_RETVAL();
unless (defined $res and length($res)==9) {
PT_EXIT("$owx_dev has returned invalid data");
}
$ret = OWXMULTI_BinValues($hash,"ds2438.getvdd",1,undef,$owx_dev,undef,undef,$res);
if ($ret) {
die $ret;
}
#------------------------------------------------------------------------------------
#-- switch the device to current measurement off, V external only
#-- issue the match ROM command \x55 and the write scratchpad command
#"ds2438.writestatusvad"
$thread->{pt_execute} = OWX_ASYNC_PT_Execute($master,1,$owx_dev,"\x4E\x00\x00",0);
$thread->{TimeoutTime} = gettimeofday()+2; #TODO: implement attribute-based timeout
PT_WAIT_THREAD($thread->{pt_execute});
delete $thread->{TimeoutTime};
die $thread->{pt_execute}->PT_CAUSE() if ($thread->{pt_execute}->PT_STATE() == PT_ERROR);
#-- copy scratchpad to register
#-- issue the match ROM command \x55 and the copy scratchpad command
#"ds2438.copyscratchpadvad"
$thread->{pt_execute} = OWX_ASYNC_PT_Execute($master,1,$owx_dev,"\x48\x00",0);
$thread->{TimeoutTime} = gettimeofday()+2; #TODO: implement attribute-based timeout
PT_WAIT_THREAD($thread->{pt_execute});
delete $thread->{TimeoutTime};
die $thread->{pt_execute}->PT_CAUSE() if ($thread->{pt_execute}->PT_STATE() == PT_ERROR);
#-- initiate voltage conversion
#-- conversion needs some 6 ms !
#-- issue the match ROM command \x55 and the start conversion command
#"ds2438.voltageconversionvad"
$thread->{pt_execute} = OWX_ASYNC_PT_Execute($master,1,$owx_dev,"\xB4",0);
$thread->{TimeoutTime} = gettimeofday()+2; #TODO: implement attribute-based timeout
PT_WAIT_THREAD($thread->{pt_execute});
delete $thread->{TimeoutTime};
die $thread->{pt_execute}->PT_CAUSE() if ($thread->{pt_execute}->PT_STATE() == PT_ERROR);
$thread->{ExecuteTime} = gettimeofday() + 0.006;
PT_YIELD_UNTIL(gettimeofday() >= $thread->{ExecuteTime});
delete $thread->{ExecuteTime};
#-- from memory to scratchpad
#-- copy needs some 12 ms !
#-- issue the match ROM command \x55 and the recall memory command
#"ds2438.recallmemoryvad"
unless (OWX_ASYNC_Execute( $master, $thread, 1, $owx_dev, "\xB8\x00", 0)) {
PT_EXIT("$owx_dev not accessible to recall memory");
}
PT_WAIT_UNTIL($thread->{ExecuteResponse});
unless ($thread->{ExecuteResponse}->{success}) {
PT_EXIT("$owx_dev recall memory failed");
}
#TODO implement async wait
select(undef,undef,undef,0.012);
#-- NOW ask the specific device
#-- issue the match ROM command \x55 and the read scratchpad command \xBE
#-- reading 9 + 2 + 9 data bytes = 20 bytes
#"ds2438.getvad"
unless (OWX_ASYNC_Execute( $master, $thread, 1, $owx_dev, "\xBE\x00", 9)) {
PT_EXIT("$owx_dev not accessible in 2nd step");
}
PT_WAIT_UNTIL($thread->{ExecuteResponse});
$response = $thread->{ExecuteResponse};
unless ($response->{success}) {
PT_EXIT("$owx_dev not accessible in 2nd step");
}
#-- process results
$res = $response->{readdata};
unless (defined $res and length($res)==9) {
PT_EXIT("$owx_dev has returned invalid data");
}
$ret = OWXMULTI_BinValues($hash,"ds2438.getvad",1,undef,$owx_dev,undef,undef,$res);
if (defined $ret) {
PT_EXIT($ret);
}
PT_END;
#-- from memory to scratchpad
#-- copy needs some 12 ms !
#-- issue the match ROM command \x55 and the recall memory command
#"ds2438.recallmemoryvad"
$thread->{pt_execute} = OWX_ASYNC_PT_Execute($master,1,$owx_dev,"\xB8\x00",0);
$thread->{TimeoutTime} = gettimeofday()+2; #TODO: implement attribute-based timeout
PT_WAIT_THREAD($thread->{pt_execute});
delete $thread->{TimeoutTime};
die $thread->{pt_execute}->PT_CAUSE() if ($thread->{pt_execute}->PT_STATE() == PT_ERROR);
$thread->{ExecuteTime} = gettimeofday() + 0.012;
PT_YIELD_UNTIL(gettimeofday() >= $thread->{ExecuteTime});
delete $thread->{ExecuteTime};
#-- NOW ask the specific device
#-- issue the match ROM command \x55 and the read scratchpad command \xBE
#-- reading 9 + 2 + 9 data bytes = 20 bytes
#"ds2438.getvad"
$thread->{pt_execute} = OWX_ASYNC_PT_Execute($master,1,$owx_dev,"\xBE\x00", 9);
$thread->{TimeoutTime} = gettimeofday()+2; #TODO: implement attribute-based timeout
PT_WAIT_THREAD($thread->{pt_execute});
delete $thread->{TimeoutTime};
die $thread->{pt_execute}->PT_CAUSE() if ($thread->{pt_execute}->PT_STATE() == PT_ERROR);
#-- process results
$res = $thread->{pt_execute}->PT_RETVAL();
unless (defined $res and length($res)==9) {
PT_EXIT("$owx_dev has returned invalid data");
}
$ret = OWXMULTI_BinValues($hash,"ds2438.getvad",1,undef,$owx_dev,undef,undef,$res);
if ($ret) {
die $ret;
}
PT_END;
});
}
#######################################################################################
@ -1192,40 +1219,43 @@ sub OWXMULTI_PT_GetValues($) {
########################################################################################
sub OWXMULTI_PT_SetValues($@) {
my ($thread,$hash, @a) = @_;
my ($hash, @a) = @_;
my ($i,$j,$k);
return PT_THREAD(sub {
my $name = $hash->{NAME};
#-- ID of the device
my $owx_dev = $hash->{ROM_ID};
#-- hash of the busmaster
my $master = $hash->{IODev};
PT_BEGIN($thread);
#-- define vars
my $key = $a[1];
my $value = $a[2];
my ($thread) = @_;
my ($i,$j,$k);
my $name = $hash->{NAME};
#-- ID of the device
my $owx_dev = $hash->{ROM_ID};
#-- hash of the busmaster
my $master = $hash->{IODev};
#-- issue the match ROM command \x55 and the write scratchpad command \x4E,
# followed by the write EEPROM command \x48
#
# so far writing the EEPROM does not work properly.
# 1. \x48 directly appended to the write scratchpad command => command ok, no effect on EEPROM
# 2. \x48 appended to match ROM => command not ok.
# 3. \x48 sent by WriteBytePower after match ROM => command ok, no effect on EEPROM
my $select=sprintf("\x4E%c%c\x48",0,0);
#"setvalues"
unless (OWX_ASYNC_Execute( $master, $thread, 1, $owx_dev, $select, 0)) {
PT_EXIT("OWXMULTI: Device $owx_dev not accessible");
}
PT_WAIT_UNTIL($thread->{ExecuteResponse});
unless ($thread->{ExecuteResponse}->{success}) {
PT_EXIT("OWXMULTI: error setting values in $owx_dev");
}
PT_END;
PT_BEGIN($thread);
#-- define vars
my $key = $a[1];
my $value = $a[2];
#-- issue the match ROM command \x55 and the write scratchpad command \x4E,
# followed by the write EEPROM command \x48
#
# so far writing the EEPROM does not work properly.
# 1. \x48 directly appended to the write scratchpad command => command ok, no effect on EEPROM
# 2. \x48 appended to match ROM => command not ok.
# 3. \x48 sent by WriteBytePower after match ROM => command ok, no effect on EEPROM
my $select=sprintf("\x4E%c%c\x48",0,0);
#"setvalues"
$thread->{pt_execute} = OWX_ASYNC_PT_Execute($master,1,$owx_dev,$select, 0);
$thread->{TimeoutTime} = gettimeofday()+2; #TODO: implement attribute-based timeout
PT_WAIT_THREAD($thread->{pt_execute});
delete $thread->{TimeoutTime};
die $thread->{pt_execute}->PT_CAUSE() if ($thread->{pt_execute}->PT_STATE() == PT_ERROR);
PT_END;
});
}
1;

505
fhem/FHEM/21_OWSWITCH.pm
View File

@ -89,7 +89,7 @@ no warnings 'deprecated';
sub Log($$);
my $owx_version="5.16";
my $owx_version="5.17";
#-- fixed raw channel name, flexible channel name
my @owg_fixed = ("A","B","C","D","E","F","G","H");
my @owg_channel = ("A","B","C","D","E","F","G","H");
@ -144,6 +144,8 @@ sub OWSWITCH_Initialize ($) {
$hash->{UndefFn} = "OWSWITCH_Undef";
$hash->{GetFn} = "OWSWITCH_Get";
$hash->{SetFn} = "OWSWITCH_Set";
$hash->{NotifyFn}= "OWSWITCH_Notify";
$hash->{InitFn} = "OWSWITCH_Init";
$hash->{AttrFn} = "OWSWITCH_Attr";
my $attlist = "IODev do_not_notify:0,1 showtime:0,1 model:DS2413,DS2406,DS2408 loglevel:0,1,2,3,4,5 ".
@ -265,10 +267,30 @@ sub OWSWITCH_Define ($$) {
#--
readingsSingleUpdate($hash,"state","defined",1);
Log 3, "OWSWITCH: Device $name defined.";
#-- Start timer for updates
InternalTimer(time()+10, "OWSWITCH_GetValues", $hash, 0);
$hash->{NOTIFYDEV} = "global";
if ($init_done) {
OWSWITCH_Init($hash);
}
return undef;
}
sub OWSWITCH_Notify ($$) {
my ($hash,$dev) = @_;
if( grep(m/^(INITIALIZED|REREADCFG)$/, @{$dev->{CHANGED}}) ) {
OWSWITCH_Init($hash);
} elsif( grep(m/^SAVE$/, @{$dev->{CHANGED}}) ) {
}
}
sub OWSWITCH_Init ($) {
my ($hash)=@_;
#-- Start timer for updates
RemoveInternalTimer($hash);
InternalTimer(gettimeofday()+10, "OWSWITCH_GetValues", $hash, 0);
#--
readingsSingleUpdate($hash,"state","Initialized",1);
return undef;
}
@ -307,6 +329,9 @@ sub OWSWITCH_Attr(@) {
AssignIoPort($hash,$value);
if( defined($hash->{IODev}) ) {
$hash->{ASYNC} = $hash->{IODev}->{TYPE} eq "OWX_ASYNC" ? 1 : 0;
if ($init_done) {
OWSWITCH_Init($hash);
}
}
last;
};
@ -456,14 +481,23 @@ sub OWSWITCH_Get($@) {
$value = $hash->{ROM_ID};
return "$name.id => $value";
}
#-- hash of the busmaster
my $master = $hash->{IODev};
#-- get present
if($a[1] eq "present") {
#-- hash of the busmaster
my $master = $hash->{IODev};
#-- asynchronous mode
if( $hash->{ASYNC} ){
$value = OWX_ASYNC_Verify($master,$hash->{ROM_ID});
my ($task,$task_state);
eval {
$task = OWX_ASYNC_PT_Verify($hash);
OWX_ASYNC_Schedule($hash,$task);
$task_state = OWX_ASYNC_RunToCompletion($master,$task);
};
return GP_Catch($@) if $@;
return $task->PT_CAUSE() if ($task_state == PT_ERROR or $task_state == PT_CANCELED);
return "$name.present => ".ReadingsVal($name,"present","unknown");
} else {
$value = OWX_Verify($master,$hash->{ROM_ID});
}
@ -506,12 +540,13 @@ sub OWSWITCH_Get($@) {
if( $interface eq "OWX" ){
$ret = OWXSWITCH_GetState($hash);
}elsif( $interface eq "OWX_ASYNC") {
#TODO use OWX_ASYNC_Schedule instead
my $task = PT_THREAD(\&OWXSWITCH_PT_GetState);
my ($task,$task_state);
eval {
while ($task->PT_SCHEDULE($hash)) { OWX_ASYNC_Poll($hash->{IODev}); };
$task = OWXSWITCH_PT_GetState($hash);
OWX_ASYNC_Schedule($hash,$task);
$task_state = OWX_ASYNC_RunToCompletion($master,$task);
};
$ret = ($@) ? GP_Catch($@) : $task->PT_RETVAL();
$ret = ($@) ? GP_Catch($@) : ($task_state == PT_ERROR or $task_state == PT_CANCELED) ? $task->PT_CAUSE() : $task->PT_RETVAL();
#-- OWFS interface
}elsif( $interface eq "OWFS" ){
$ret = OWFSSWITCH_GetState($hash);
@ -530,12 +565,13 @@ sub OWSWITCH_Get($@) {
if( $interface eq "OWX" ){
$ret = OWXSWITCH_GetState($hash);
}elsif( $interface eq "OWX_ASYNC" ){
#TODO use OWX_ASYNC_Schedule instead
my $task = PT_THREAD(\&OWXSWITCH_PT_GetState);
my ($task,$task_state);
eval {
while ($task->PT_SCHEDULE($hash)) { OWX_ASYNC_Poll($hash->{IODev}); };
$task = OWXSWITCH_PT_GetState($hash);
OWX_ASYNC_Schedule($hash,$task);
$task_state = OWX_ASYNC_RunToCompletion($master,$task);
};
$ret = ($@) ? GP_Catch($@) : $task->PT_RETVAL();
$ret = ($@) ? GP_Catch($@) : ($task_state == PT_ERROR or $task_state == PT_CANCELED) ? $task->PT_CAUSE() : $task->PT_RETVAL();
}elsif( $interface eq "OWServer" ){
$ret = OWFSSWITCH_GetState($hash);
}else{
@ -583,7 +619,7 @@ sub OWSWITCH_GetValues($) {
}
}elsif( $interface eq "OWX_ASYNC" ){
eval {
OWX_ASYNC_Schedule( $hash, PT_THREAD(\&OWXSWITCH_PT_GetState),$hash );
OWX_ASYNC_Schedule( $hash, OWXSWITCH_PT_GetState($hash) );
};
return unless $@;
$ret = GP_Catch($@);
@ -753,7 +789,7 @@ sub OWSWITCH_Set($@) {
$ret2 = OWXSWITCH_SetState($hash,$value);
}elsif( $interface eq "OWX_ASYNC"){
eval {
OWX_ASYNC_Schedule( $hash, PT_THREAD(\&OWXSWITCH_PT_SetOutput),$hash,$fnd,$nval );
OWX_ASYNC_Schedule( $hash, OWXSWITCH_PT_SetOutput($hash,$fnd,$nval) );
};
$ret2 = GP_Catch($@) if $@;
#-- OWFS interface
@ -791,7 +827,7 @@ sub OWSWITCH_Set($@) {
$ret = OWXSWITCH_SetState($hash,int($value));
}elsif( $interface eq "OWX_ASYNC" ){
eval {
OWX_ASYNC_Schedule( $hash, PT_THREAD(\&OWXSWITCH_PT_SetState),$hash,int($value) );
OWX_ASYNC_Schedule( $hash, OWXSWITCH_PT_SetState($hash,int($value)) );
};
$ret = GP_Catch($@) if $@;
}elsif( $interface eq "OWServer" ){
@ -1245,93 +1281,89 @@ sub OWXSWITCH_SetState($$) {
########################################################################################
sub OWXSWITCH_PT_GetState($) {
my ($thread,$hash) = @_;
my ($select, $ret, @data, $response);
#-- ID of the device
my $owx_dev = $hash->{ROM_ID};
#-- hash of the busmaster
my $master = $hash->{IODev};
PT_BEGIN($thread);
#-- reset presence
$hash->{PRESENT} = 0;
my ($i,$j,$k);
#-- family = 12 => DS2406
if( $hash->{OW_FAMILY} eq "12" ) {
#=============== get gpio values ===============================
#-- issue the match ROM command \x55 and the access channel command
# \xF5 plus the two byte channel control and the value
#-- reading 9 + 3 + 2 data bytes + 2 CRC bytes = 16 bytes
$select=sprintf("\xF5\xDD\xFF");
unless(OWX_ASYNC_Execute( $master, $thread, 1, $owx_dev, $select, 4)) {
PT_EXIT("device $owx_dev not accessible in reading");
my ($hash) = @_;
return PT_THREAD( sub {
my ($thread) = @_;
my ($select, $ret, @data, $response);
#-- ID of the device
my $owx_dev = $hash->{ROM_ID};
#-- hash of the busmaster
my $master = $hash->{IODev};
PT_BEGIN($thread);
my ($i,$j,$k);
#-- family = 12 => DS2406
if( $hash->{OW_FAMILY} eq "12" ) {
#=============== get gpio values ===============================
#-- issue the match ROM command \x55 and the access channel command
# \xF5 plus the two byte channel control and the value
#-- reading 9 + 3 + 2 data bytes + 2 CRC bytes = 16 bytes
$thread->{'select'}=sprintf("\xF5\xDD\xFF");
$thread->{pt_execute} = OWX_ASYNC_PT_Execute($master,1,$owx_dev,$thread->{'select'},4);
$thread->{TimeoutTime} = gettimeofday()+2; #TODO: implement attribute-based timeout
PT_WAIT_THREAD($thread->{pt_execute});
delete $thread->{TimeoutTime};
die $thread->{pt_execute}->PT_CAUSE() if ($thread->{pt_execute}->PT_STATE() == PT_ERROR);
$response = $thread->{pt_execute}->PT_RETVAL();
unless (length($response) == 4) {
PT_EXIT("$owx_dev has returned invalid data");
}
$ret = OWXSWITCH_BinValues($hash,"ds2406.getstate",1,1,$owx_dev,$thread->{'select'},4,$response);
if (defined $ret) {
PT_EXIT($ret);
}
#-- family = 29 => DS2408
}elsif( $hash->{OW_FAMILY} eq "29" ) {
#=============== get gpio values ===============================
#-- issue the match ROM command \x55 and the read PIO rtegisters command
# \xF5 plus the two byte channel target address
#-- reading 9 + 3 + 8 data bytes + 2 CRC bytes = 22 bytes
$thread->{'select'}=sprintf("\xF0\x88\x00");
$thread->{pt_execute} = OWX_ASYNC_PT_Execute($master,1,$owx_dev,$thread->{'select'},10);
$thread->{TimeoutTime} = gettimeofday()+2; #TODO: implement attribute-based timeout
PT_WAIT_THREAD($thread->{pt_execute});
delete $thread->{TimeoutTime};
die $thread->{pt_execute}->PT_CAUSE() if ($thread->{pt_execute}->PT_STATE() == PT_ERROR);
$response = $thread->{pt_execute}->PT_RETVAL();
unless (length($response) == 10) {
PT_EXIT("$owx_dev has returned invalid data")
};
$ret = OWXSWITCH_BinValues($hash,"ds2408.getstate",1,1,$owx_dev,$thread->{'select'},10,$response);
if (defined $ret) {
PT_EXIT($ret);
}
#-- family = 3A => DS2413
}elsif( $hash->{OW_FAMILY} eq "3A" ) {
#=============== get gpio values ===============================
#-- issue the match ROM command \x55 and the read gpio command
# \xF5 plus 2 empty bytes
#-- reading 9 + 1 + 2 data bytes = 12 bytes
$thread->{'select'}="\xF5";
$thread->{pt_execute} = OWX_ASYNC_PT_Execute($master,1,$owx_dev,$thread->{'select'},2);
$thread->{TimeoutTime} = gettimeofday()+2; #TODO: implement attribute-based timeout
PT_WAIT_THREAD($thread->{pt_execute});
delete $thread->{TimeoutTime};
die $thread->{pt_execute}->PT_CAUSE() if ($thread->{pt_execute}->PT_STATE() == PT_ERROR);
$response = $thread->{pt_execute}->PT_RETVAL();
unless (length($response) == 2) {
PT_EXIT("$owx_dev has returned invalid data");
}
$ret = OWXSWITCH_BinValues($hash,"ds2413.getstate",1,1,$owx_dev,$thread->{'select'},2,$response);
if (defined $ret) {
PT_EXIT($ret);
}
} else {
PT_EXIT("unknown device family $hash->{OW_FAMILY}\n");
}
PT_WAIT_UNTIL(defined $thread->{ExecuteResponse});
$response = $thread->{ExecuteResponse};
unless ($response->{success}) {
PT_EXIT("$owx_dev has returned invalid data");
}
unless (length($response->{readdata}) == 4) {
PT_EXIT("$owx_dev has returned invalid data");
}
$ret = OWXSWITCH_BinValues($hash,"ds2406.getstate",1,1,$owx_dev,$response->{writedata},4,$response->{readdata});
if (defined $ret) {
PT_EXIT($ret);
}
#-- family = 29 => DS2408
}elsif( $hash->{OW_FAMILY} eq "29" ) {
#=============== get gpio values ===============================
#-- issue the match ROM command \x55 and the read PIO rtegisters command
# \xF5 plus the two byte channel target address
#-- reading 9 + 3 + 8 data bytes + 2 CRC bytes = 22 bytes
$select=sprintf("\xF0\x88\x00");
unless (OWX_ASYNC_Execute( $master, $thread, 1, $owx_dev, $select, 10)) {
PT_EXIT("device $owx_dev not accessible in reading");
}
PT_WAIT_UNTIL($thread->{ExecuteResponse});
$response = $thread->{ExecuteResponse};
unless ($response->{success}) {
PT_EXIT("$owx_dev has returned invalid data");
}
unless (length($response->{readdata}) == 10) {
PT_EXIT("$owx_dev has returned invalid data")
};
$ret = OWXSWITCH_BinValues($hash,"ds2408.getstate",1,1,$owx_dev,$response->{writedata},10,$response->{readdata});
if (defined $ret) {
PT_EXIT($ret);
}
#-- family = 3A => DS2413
}elsif( $hash->{OW_FAMILY} eq "3A" ) {
#=============== get gpio values ===============================
#-- issue the match ROM command \x55 and the read gpio command
# \xF5 plus 2 empty bytes
#-- reading 9 + 1 + 2 data bytes = 12 bytes
$select = "\xF5";
unless (OWX_ASYNC_Execute( $master, $thread, 1, $owx_dev, $select, 2)) {
PT_EXIT("device $owx_dev not accessible in reading");
}
PT_WAIT_UNTIL($thread->{ExecuteResponse});
$response = $thread->{ExecuteResponse};
unless ($response->{success}) {
PT_EXIT("$owx_dev has returned invalid data");
}
unless (length($response->{readdata}) == 2) {
PT_EXIT("$owx_dev has returned invalid data");
}
$ret = OWXSWITCH_BinValues($hash,"ds2413.getstate",1,1,$owx_dev,$response->{writedata},2,$response->{readdata});
if (defined $ret) {
PT_EXIT($ret);
}
} else {
PT_EXIT("unknown device family $hash->{OW_FAMILY}\n");
}
PT_END;
PT_END;
});
}
########################################################################################
@ -1345,152 +1377,153 @@ sub OWXSWITCH_PT_GetState($) {
sub OWXSWITCH_PT_SetState($$) {
my ($thread,$hash,$value) = @_;
my ($select,$res,@data);
#-- ID of the device
my $owx_dev = $hash->{ROM_ID};
#-- hash of the busmaster
my $master = $hash->{IODev};
my ($hash,$value) = @_;
PT_BEGIN($thread);
return PT_THREAD( sub {
#-- family = 12 => DS2406
if( $hash->{OW_FAMILY} eq "12" ) {
#=============== set gpio values ===============================
# Writing the output state via the access channel command does
# not work contrary to documentation. Using the write status command
#-- issue the match ROM command \x55 and the read status command
# \xAA at address TA1 = \x07 TA2 = \x00
#-- reading 9 + 3 + 1 data bytes + 2 CRC bytes = 15 bytes
my ($thread) = @_;
my ($select,$res,@data);
unless (OWX_ASYNC_Execute( $master, $thread, 1, $owx_dev, "\xAA\x07\x00", 3)) {
PT_EXIT("device $owx_dev not accessible in writing");
}
PT_WAIT_UNTIL($thread->{ExecuteResponse});
unless ($thread->{ExecuteResponse}->{success}) {
PT_EXIT("state could not be set for device $owx_dev");
}
$res = $thread->{ExecuteResponse}->{readdata};
#-- ID of the device
my $owx_dev = $hash->{ROM_ID};
#-- first step
my $stat = ord(substr($res,0,1));
my $statneu = ( $stat & 159 ) | (($value<<5) & 96) ;
#-- call the second step
#-- issue the match ROM command \x55 and the write status command
# \x55 at address TA1 = \x07 TA2 = \x00
#-- reading 9 + 4 + 2 data bytes = 15 bytes
$select=sprintf("\x55\x07\x00%c",$statneu);
#-- hash of the busmaster
my $master = $hash->{IODev};
unless (OWX_ASYNC_Execute( $master, $thread, 1, $owx_dev, $select, 2)) {
PT_EXIT("device $owx_dev not accessible in writing");
}
PT_WAIT_UNTIL($thread->{ExecuteResponse});
unless ($thread->{ExecuteResponse}->{success}) {
PT_EXIT("state could not be set for device $owx_dev");
}
$res = $thread->{ExecuteResponse}->{readdata};
my $command = $thread->{ExecuteResponse}->{writedata};
#-- second step from above
@data=split(//,$res);
if( int(@data) != 2){
PT_EXIT("state could not be set for device $owx_dev");
}
if (OWX_CRC16($command,$data[0],$data[1]) == 0) {
PT_EXIT("invalid CRC");
}
#-- put into local buffer
$hash->{owg_val}->[0] = $value % 2;
$hash->{owg_vax}->[0] = $value % 2;
$hash->{owg_val}->[1] = int($value / 2);
$hash->{owg_vax}->[1] = int($value / 2);
#-- family = 29 => DS2408
} elsif( $hash->{OW_FAMILY} eq "29" ) {
#=============== set gpio values ===============================
#-- issue the match ROM command \x55 and the write gpio command
# \x5A plus the value byte and its complement
$select=sprintf("\x5A%c%c",$value,255-$value);
PT_BEGIN($thread);
unless (OWX_ASYNC_Execute( $master, $thread, 1, $owx_dev, $select, 1)) {
PT_EXIT("device $owx_dev not accessible in writing");
}
PT_WAIT_UNTIL($thread->{ExecuteResponse});
unless ($thread->{ExecuteResponse}->{success}) {
PT_EXIT("state could not be set for device $owx_dev");
}
$res = $thread->{ExecuteResponse}->{readdata};
#-- family = 12 => DS2406
if( $hash->{OW_FAMILY} eq "12" ) {
#=============== set gpio values ===============================
# Writing the output state via the access channel command does
# not work contrary to documentation. Using the write status command
#-- issue the match ROM command \x55 and the read status command
# \xAA at address TA1 = \x07 TA2 = \x00
#-- reading 9 + 3 + 1 data bytes + 2 CRC bytes = 15 bytes
@data=split(//,$res);
if (@data != 1) {
PT_EXIT("invalid data length, ".int(@data)." instead of 1 bytes");
}
if( $data[0] ne "\xAA") {
PT_EXIT("state could not be set for device $owx_dev");
}
$thread->{pt_execute} = OWX_ASYNC_PT_Execute($master,1,$owx_dev,"\xAA\x07\x00", 3);
$thread->{TimeoutTime} = gettimeofday()+2; #TODO: implement attribute-based timeout
PT_WAIT_THREAD($thread->{pt_execute});
delete $thread->{TimeoutTime};
die $thread->{pt_execute}->PT_CAUSE() if ($thread->{pt_execute}->PT_STATE() == PT_ERROR);
$res = $thread->{pt_execute}->PT_RETVAL();
#-- family = 3A => DS2413
} elsif( $hash->{OW_FAMILY} eq "3A" ) {
#=============== set gpio values ===============================
#-- issue the match ROM command \x55 and the write gpio command
# \x5A plus the value byte and its complement
$select=sprintf("\x5A%c%c",252+$value,3-$value);
unless (OWX_ASYNC_Execute( $master, $thread, 1, $owx_dev, $select, 1)) {
PT_EXIT("device $owx_dev not accessible in writing");
}
PT_WAIT_UNTIL($thread->{ExecuteResponse});
unless ($thread->{ExecuteResponse}->{success}) {
PT_EXIT("state could not be set for device $owx_dev");
}
$res = $thread->{ExecuteResponse}->{readdata};
#-- first step
my $stat = ord(substr($res,0,1));
my $statneu = ( $stat & 159 ) | (($value<<5) & 96) ;
#-- call the second step
#-- issue the match ROM command \x55 and the write status command
# \x55 at address TA1 = \x07 TA2 = \x00
#-- reading 9 + 4 + 2 data bytes = 15 bytes
$thread->{'select'}=sprintf("\x55\x07\x00%c",$statneu);
@data=split(//,$res);
if (@data != 1) {
PT_EXIT("invalid data length, ".int(@data)." instead of 1 bytes");
}
if( $data[0] ne "\xAA") {
PT_EXIT("state could not be set for device $owx_dev");
$thread->{pt_execute} = OWX_ASYNC_PT_Execute($master,1,$owx_dev,$thread->{'select'}, 2);
$thread->{TimeoutTime} = gettimeofday()+2; #TODO: implement attribute-based timeout
PT_WAIT_THREAD($thread->{pt_execute});
delete $thread->{TimeoutTime};
die $thread->{pt_execute}->PT_CAUSE() if ($thread->{pt_execute}->PT_STATE() == PT_ERROR);
$res = $thread->{pt_execute}->PT_RETVAL();
my $command = $thread->{'select'};
#-- second step from above
@data=split(//,$res);
if( int(@data) != 2){
PT_EXIT("state could not be set for device $owx_dev");
}
if (OWX_CRC16($command,$data[0],$data[1]) == 0) {
PT_EXIT("invalid CRC");
}
#-- put into local buffer
$hash->{owg_val}->[0] = $value % 2;
$hash->{owg_vax}->[0] = $value % 2;
$hash->{owg_val}->[1] = int($value / 2);
$hash->{owg_vax}->[1] = int($value / 2);
#-- family = 29 => DS2408
} elsif( $hash->{OW_FAMILY} eq "29" ) {
#=============== set gpio values ===============================
#-- issue the match ROM command \x55 and the write gpio command
# \x5A plus the value byte and its complement
$select=sprintf("\x5A%c%c",$value,255-$value);
$thread->{pt_execute} = OWX_ASYNC_PT_Execute($master,1,$owx_dev,$select, 1);
$thread->{TimeoutTime} = gettimeofday()+2; #TODO: implement attribute-based timeout
PT_WAIT_THREAD($thread->{pt_execute});
delete $thread->{TimeoutTime};
die $thread->{pt_execute}->PT_CAUSE() if ($thread->{pt_execute}->PT_STATE() == PT_ERROR);
$res = $thread->{pt_execute}->PT_RETVAL();
@data=split(//,$res);
if (@data != 1) {
PT_EXIT("invalid data length, ".int(@data)." instead of 1 bytes");
}
if( $data[0] ne "\xAA") {
PT_EXIT("state could not be set for device $owx_dev");
}
#-- family = 3A => DS2413
} elsif( $hash->{OW_FAMILY} eq "3A" ) {
#=============== set gpio values ===============================
#-- issue the match ROM command \x55 and the write gpio command
# \x5A plus the value byte and its complement
$select=sprintf("\x5A%c%c",252+$value,3-$value);
$thread->{pt_execute} = OWX_ASYNC_PT_Execute($master,1,$owx_dev,$select, 1);
$thread->{TimeoutTime} = gettimeofday()+2; #TODO: implement attribute-based timeout
PT_WAIT_THREAD($thread->{pt_execute});
delete $thread->{TimeoutTime};
die $thread->{pt_execute}->PT_CAUSE() if ($thread->{pt_execute}->PT_STATE() == PT_ERROR);
$res = $thread->{pt_execute}->PT_RETVAL();
@data=split(//,$res);
if (@data != 1) {
PT_EXIT("invalid data length, ".int(@data)." instead of 1 bytes");
}
if( $data[0] ne "\xAA") {
PT_EXIT("state could not be set for device $owx_dev");
}
} else {
PT_EXIT("unknown device family $hash->{OW_FAMILY}\n");
}
} else {
PT_EXIT("unknown device family $hash->{OW_FAMILY}\n");
}
PT_END;
PT_END;
});
}
sub OWXSWITCH_PT_SetOutput($$$) {
my ($thread,$hash,$fnd,$nval) = @_;
my ($ret,$value);
PT_BEGIN($thread);
my ($hash,$fnd,$nval) = @_;
$thread->{task} = PT_THREAD(\&OWXSWITCH_PT_GetState);
PT_WAIT_THREAD($thread->{task},$hash);
$ret = $thread->{task}->PT_RETVAL();
if ($ret) {
PT_EXIT($ret);
}
$value = 0;
#-- vax or val ?
for (my $i=0;$i<$cnumber{$attr{$hash->{NAME}}{"model"}};$i++){
$value += ($hash->{owg_vax}->[$i]<<$i)
if( $i != $fnd );
$value += ($nval<<$i)
if( $i == $fnd );
}
$thread->{value} = $value;
$thread->{task} = PT_THREAD(\&OWXSWITCH_PT_SetState);
PT_WAIT_THREAD($thread->{task},$hash,$thread->{value});
$ret = $thread->{task}->PT_RETVAL();
if ($ret) {
PT_EXIT($ret);
}
PT_END;
return PT_THREAD(sub {
my ($thread) = @_;
my ($ret,$value);
PT_BEGIN($thread);
$thread->{task} = OWXSWITCH_PT_GetState($hash);
PT_WAIT_THREAD($thread->{task});
$ret = $thread->{task}->PT_RETVAL();
if ($ret) {
PT_EXIT($ret);
}
$value = 0;
#-- vax or val ?
for (my $i=0;$i<$cnumber{$attr{$hash->{NAME}}{"model"}};$i++){
$value += ($hash->{owg_vax}->[$i]<<$i)
if( $i != $fnd );
$value += ($nval<<$i)
if( $i == $fnd );
}
$thread->{value} = $value;
$thread->{task} = OWXSWITCH_PT_SetState($hash,$thread->{value});
PT_WAIT_THREAD($thread->{task});
$ret = $thread->{task}->PT_RETVAL();
if ($ret) {
PT_EXIT($ret);
}
PT_END;
});
}
1;

306
fhem/FHEM/21_OWTHERM.pm Executable file → Normal file
View File

@ -70,7 +70,7 @@ package main;
use vars qw{%attr %defs %modules $readingFnAttributes $init_done};
use strict;
use warnings;
use Time::HiRes qw( gettimeofday tv_interval usleep );
use Time::HiRes qw( gettimeofday );
#add FHEM/lib to @INC if it's not allready included. Should rather be in fhem.pl than here though...
BEGIN {
@ -86,7 +86,7 @@ no warnings 'deprecated';
sub Log3($$$);
sub AttrVal($$$);
my $owx_version="5.20";
my $owx_version="5.21";
my %gets = (
"id" => "",
@ -138,6 +138,8 @@ sub OWTHERM_Initialize ($) {
$hash->{UndefFn} = "OWTHERM_Undef";
$hash->{GetFn} = "OWTHERM_Get";
$hash->{SetFn} = "OWTHERM_Set";
$hash->{NotifyFn}= "OWTHERM_Notify";
$hash->{InitFn} = "OWTHERM_Init";
$hash->{AttrFn} = "OWTHERM_Attr";
$hash->{AttrList}= "IODev model:DS1820,DS18B20,DS1822 loglevel:0,1,2,3,4,5 ".
"stateAL stateAH ".
@ -253,13 +255,33 @@ sub OWTHERM_Define ($$) {
#--
readingsSingleUpdate($hash,"state","defined",1);
Log3 $name, 3, "OWTHERM: Device $name defined.";
#-- Start timer for updates
InternalTimer(time()+10, "OWTHERM_GetValues", $hash, 0);
$hash->{NOTIFYDEV} = "global";
if ($init_done) {
OWTHERM_Init($hash);
}
return undef;
}
sub OWTHERM_Notify ($$) {
my ($hash,$dev) = @_;
if( grep(m/^(INITIALIZED|REREADCFG)$/, @{$dev->{CHANGED}}) ) {
OWTHERM_Init($hash);
} elsif( grep(m/^SAVE$/, @{$dev->{CHANGED}}) ) {
}
}
sub OWTHERM_Init ($) {
my ($hash)=@_;
#-- Start timer for updates
RemoveInternalTimer($hash);
InternalTimer(gettimeofday()+10, "OWTHERM_GetValues", $hash, 0);
#--
readingsSingleUpdate($hash,"state","Initialized",1);
return undef;
}
#######################################################################################
#
# OWTHERM_Attr - Set one attribute value for device
@ -307,6 +329,9 @@ sub OWTHERM_Attr(@) {
AssignIoPort($hash,$value);
if( defined($hash->{IODev}) ) {
$hash->{ASYNC} = $hash->{IODev}->{TYPE} eq "OWX_ASYNC" ? 1 : 0;
if ($init_done) {
OWTHERM_Init($hash);
}
}
last;
};
@ -425,6 +450,8 @@ sub OWTHERM_Get($@) {
return "$name.id => $value";
}
#-- hash of the busmaster
my $master = $hash->{IODev};
#-- Get other values according to interface type
my $interface= $hash->{IODev}->{TYPE};
@ -432,11 +459,17 @@ sub OWTHERM_Get($@) {
if($a[1] eq "present" ) {
#-- OWX interface
if( $interface =~ /^OWX/ ){
#-- hash of the busmaster
my $master = $hash->{IODev};
#-- asynchronous mode
if( $hash->{ASYNC} ){
$value = OWX_ASYNC_Verify($master,$hash->{ROM_ID});
my ($task,$task_state);
eval {
$task = OWX_ASYNC_PT_Verify($hash);
OWX_ASYNC_Schedule($hash,$task);
$task_state = OWX_ASYNC_RunToCompletion($master,$task);
};
return GP_Catch($@) if $@;
return $task->PT_CAUSE() if ($task_state == PT_ERROR or $task_state == PT_CANCELED);
return "$name.present => ".ReadingsVal($name,"present","unknown");
} else {
$value = OWX_Verify($master,$hash->{ROM_ID});
}
@ -463,12 +496,13 @@ sub OWTHERM_Get($@) {
#-- not different from getting all values ..
$ret = OWXTHERM_GetValues($hash);
}elsif( $interface eq "OWX_ASYNC" ){
#TODO use OWX_ASYNC_Schedule instead
my $task = PT_THREAD(\&OWXTHERM_PT_GetValues);
my ($task,$task_state);
eval {
while ($task->PT_SCHEDULE($hash)) { OWX_ASYNC_Poll($hash->{IODev}); };
$task = OWXTHERM_PT_GetValues($hash);
OWX_ASYNC_Schedule($hash,$task);
$task_state = OWX_ASYNC_RunToCompletion($master,$task);
};
$ret = ($@) ? GP_Catch($@) : $task->PT_RETVAL();
$ret = ($@) ? GP_Catch($@) : ($task_state == PT_ERROR or $task_state == PT_CANCELED) ? $task->PT_CAUSE() : $task->PT_RETVAL();
#-- OWFS interface
}elsif( $interface eq "OWServer" ){
$ret = OWFSTHERM_GetValues($hash);
@ -531,7 +565,7 @@ sub OWTHERM_GetValues($@) {
#-- skip, if the conversion is driven by master
unless ( defined($attr{$name}{tempConv}) && ( $attr{$name}{tempConv} eq "onkick") ){
eval {
OWX_ASYNC_Schedule( $hash, PT_THREAD(\&OWXTHERM_PT_GetValues),$hash );
OWX_ASYNC_Schedule( $hash, OWXTHERM_PT_GetValues($hash) );
};
$ret = GP_Catch($@) if $@;
}
@ -566,7 +600,8 @@ sub OWTHERM_InitializeDevice($) {
my ($hash) = @_;
my $name = $hash->{NAME};
my $interface = $hash->{IODev}->{TYPE};
my $master = $hash->{IODev};
my $interface = $master->{TYPE};
my @a = ($name,"",0);
my ($unit,$offset,$factor,$abbr,$value,$ret);
@ -633,12 +668,13 @@ sub OWTHERM_InitializeDevice($) {
if( $interface eq "OWX" ){
$ret = OWXTHERM_SetValues($hash,$args);
}elsif( $interface eq "OWX_ASYNC" ){
#TODO use OWX_ASYNC_Schedule instead
my $task = PT_THREAD(\&OWXTHERM_PT_SetValues);
my ($task,$task_state);
eval {
while ($task->PT_SCHEDULE($hash,$args)) { OWX_ASYNC_Poll($hash->{IODev}); };
$task = OWXTHERM_PT_SetValues($hash,$args);
OWX_ASYNC_Schedule($hash,$task);
$task_state = OWX_ASYNC_RunToCompletion($master,$task);
};
$ret = ($@) ? GP_Catch($@) : $task->PT_RETVAL();
$ret = ($@) ? GP_Catch($@) : ($task_state == PT_ERROR or $task_state == PT_CANCELED) ? $task->PT_CAUSE() : $task->PT_RETVAL();
#-- OWFS interface
}elsif( $interface eq "OWServer" ){
$ret = OWFSTHERM_SetValues($hash,$args);
@ -732,7 +768,7 @@ sub OWTHERM_Set($@) {
}elsif( $interface eq "OWX_ASYNC" ){
$args->{format} = 1;
eval {
OWX_ASYNC_Schedule( $hash, PT_THREAD(\&OWXTHERM_PT_SetValues),$hash,$args );
OWX_ASYNC_Schedule( $hash, OWXTHERM_PT_SetValues($hash,$args) );
};
$ret = GP_Catch($@) if $@;
#-- OWFS interface
@ -876,12 +912,9 @@ sub OWFSTHERM_SetValues($$) {
#
########################################################################################
sub OWXTHERM_BinValues($$$$$$$$) {
my ($hash, $context, $success, $reset, $owx_dev, $command, $numread, $res) = @_;
sub OWXTHERM_BinValues($$$$$$) {
my ($hash, $reset, $owx_dev, $command, $numread, $res) = @_;
#-- always check for success, unused are reset, numread
return unless ($success and ($context =~ /.*reading.*/));
#Log3 $name, 1,"OWXTHERM_BinValues context = $context";
my ($i,$j,$k,@data,$ow_thn,$ow_tln);
@ -889,17 +922,15 @@ sub OWXTHERM_BinValues($$$$$$$$) {
#Log3 $name, 1,"OWXTHERM: data length from reading device is ".length($res)." bytes";
#-- process results
if( $res eq 0 ){
return "$owx_dev not accessible in 2nd step";
}
die "$owx_dev not accessible in 2nd step" unless ( defined $res and $res ne 0 );
#-- process results
@data=split(//,$res);
return "invalid data length, ".int(@data)." instead of 9 bytes"
die "invalid data length, ".int(@data)." instead of 9 bytes"
if (@data != 9);
return "invalid data"
die "invalid data"
if (ord($data[7])<=0);
return "invalid CRC"
die "invalid CRC"
if (OWX_CRC8(substr($res,0,8),$data[8])==0);
#-- this must be different for the different device types
@ -948,7 +979,7 @@ sub OWXTHERM_BinValues($$$$$$$$) {
$ow_tln = ord($data[3]) > 127 ? 128-ord($data[3]) : ord($data[3]);
} else {
return "OWXTHERM: Unknown device family $hash->{OW_FAMILY}\n";
die "OWXTHERM: Unknown device family $hash->{OW_FAMILY}\n";
}
#-- process alarm settings
@ -984,15 +1015,12 @@ sub OWXTHERM_GetValues($) {
my $master = $hash->{IODev};
my $name = $hash->{NAME};
#-- reset presence
$hash->{PRESENT} = 0;
#-- check, if the conversion has been called before for all sensors
if( defined($attr{$name}{tempConv}) && ( $attr{$name}{tempConv} eq "onkick") ){
$con=0;
}
}
#-- if the conversion has not been called before
#-- if the conversion has not been called before
if( $con==1 ){
#-- issue the match ROM command \x55 and the start conversion command \x44
OWX_Reset($master);
@ -1011,8 +1039,11 @@ sub OWXTHERM_GetValues($) {
if( $res eq 0 );
return "$owx_dev has returned invalid data"
if( length($res)!=19);
return OWXTHERM_BinValues($hash,"ds182x.reading",1,undef,$owx_dev,undef,undef,substr($res,10,9));
}
eval {
OWXTHERM_BinValues($hash,undef,$owx_dev,undef,undef,substr($res,10,9));
};
return $@;
}
#######################################################################################
#
@ -1039,13 +1070,13 @@ sub OWXTHERM_SetValues($$) {
#-- $owg_tl and $owg_th are preset and may be changed here
foreach my $key (keys %$args) {
$hash->{owg_tl} = $args->{$key} if( lc($key) eq "templow");
$hash->{owg_th} = $args->{$key} if( lc($key) eq "temphigh");
$hash->{owg_cf} = $args->{$key} if( lc($key) eq "resolution");
$hash->{owg_tl} = $args->{$key} if( lc($key) eq "templow");
$hash->{owg_th} = $args->{$key} if( lc($key) eq "temphigh");
$hash->{owg_cf} = $args->{$key} if( lc($key) eq "resolution");
}
#-- put into 2's complement formed (signed byte)
my $tlp = $hash->{owg_tl} < 0 ? 128 - $hash->{owg_tl} : $hash->{owg_tl};
my $tlp = $hash->{owg_tl} < 0 ? 128 - $hash->{owg_tl} : $hash->{owg_tl};
my $thp = $hash->{owg_th} < 0 ? 128 - $hash->{owg_th} : $hash->{owg_th};
#-- resolution is defined in bits 5+6 of configuration register
my $cfg = defined $hash->{owg_cf} ? (($hash->{owg_cf}-9) << 5) | 0x1f : 0x7f;
@ -1056,14 +1087,14 @@ sub OWXTHERM_SetValues($$) {
#
# so far writing the EEPROM does not work properly.
# 1. \x48 directly appended to the write scratchpad command => command ok, no effect on EEPROM
# 2. \x48 appended to match ROM => command not ok.
# 2. \x48 appended to match ROM => command not ok.
# 3. \x48 sent by WriteBytePower after match ROM => command ok, no effect on EEPROM
my $select=sprintf("\x4E%c%c%c",$thp,$tlp,$cfg);
my $select=sprintf("\x4E%c%c%c",$thp,$tlp,$cfg);
OWX_Reset($master);
my $res=OWX_Complex($master,$owx_dev,$select,3);
if( $res eq 0 ){
return "OWXTHERM: Device $owx_dev not accessible";
return "OWXTHERM: Device $owx_dev not accessible";
}
return undef;
@ -1079,55 +1110,52 @@ sub OWXTHERM_SetValues($$) {
sub OWXTHERM_PT_GetValues($@) {
my ($thread,$hash) = @_;
my ($hash) = @_;
#-- For default, perform the conversion now
my $con=1;
#-- ID of the device
my $owx_dev = $hash->{ROM_ID};
#-- hash of the busmaster
my $master = $hash->{IODev};
my $name = $hash->{NAME};
PT_BEGIN($thread);
return PT_THREAD(sub {
my ($thread) = @_;
#-- For default, perform the conversion now
my $con=1;
#-- reset presence
$hash->{PRESENT} = 0;
#-- check, if the conversion has been called before for all sensors
if( defined($attr{$name}{tempConv}) && ( $attr{$name}{tempConv} eq "onkick") ){
$con=0;
}
#-- ID of the device
my $owx_dev = $hash->{ROM_ID};
#-- if the conversion has not been called before
if( $con==1 ){
#-- issue the match ROM command \x55 and the start conversion command \x44
unless (OWX_ASYNC_Execute($master,$thread,1,$owx_dev,"\x44",0)) {
PT_EXIT("$owx_dev not accessible for convert");
#-- hash of the busmaster
my $master = $hash->{IODev};
my $name = $hash->{NAME};
PT_BEGIN($thread);
#-- check, if the conversion has been called before for all sensors
if( defined($attr{$name}{tempConv}) && ( $attr{$name}{tempConv} eq "onkick") ){
$con=0;
}
#-- if the conversion has not been called before
if( $con==1 ){
#-- issue the match ROM command \x55 and the start conversion command \x44
my $now = gettimeofday();
my $delay = $convtimes{AttrVal($name,"resolution",12)};
$thread->{ExecuteTime} = $now + $delay*0.001;
$thread->{pt_execute} = OWX_ASYNC_PT_Execute($master,1,$owx_dev,"\x44",0);
$thread->{TimeoutTime} = gettimeofday()+2; #TODO: implement attribute-based timeout
PT_WAIT_THREAD($thread->{pt_execute});
delete $thread->{TimeoutTime};
die $thread->{pt_execute}->PT_CAUSE() if ($thread->{pt_execute}->PT_STATE() == PT_ERROR);
PT_YIELD_UNTIL(gettimeofday() >= $thread->{ExecuteTime});
delete $thread->{ExecuteTime};
}
my $now = gettimeofday();
my $delay = $convtimes{AttrVal($name,"resolution",12)};
$thread->{ExecuteTime} = $now + $delay*0.001;
PT_YIELD_UNTIL(defined $thread->{ExecuteResponse} and (gettimeofday() >= $thread->{ExecuteTime}));
}
#-- NOW ask the specific device
#-- issue the match ROM command \x55 and the read scratchpad command \xBE
#-- reading 9 + 1 + 8 data bytes and 1 CRC byte = 19 bytes
unless (OWX_ASYNC_Execute($master,$thread,1,$owx_dev,"\xBE",9)) {
PT_EXIT("$owx_dev not accessible in reading");
}
PT_WAIT_UNTIL(defined $thread->{ExecuteResponse});
my $response = $thread->{ExecuteResponse};
unless ($response->{success}) {
PT_EXIT("$owx_dev read not successful");
}
my $res = OWXTHERM_BinValues($hash,"ds182x.reading",1,1,$owx_dev,undef,$response->{numread},$response->{readdata});
if ($res) {
PT_EXIT($res);
}
PT_END;
#-- NOW ask the specific device
#-- issue the match ROM command \x55 and the read scratchpad command \xBE
#-- reading 9 + 1 + 8 data bytes and 1 CRC byte = 19 bytes
$thread->{pt_execute} = OWX_ASYNC_PT_Execute($master,1,$owx_dev,"\xBE",9);
$thread->{TimeoutTime} = gettimeofday()+2; #TODO: implement attribute-based timeout
PT_WAIT_THREAD($thread->{pt_execute});
delete $thread->{TimeoutTime};
die $thread->{pt_execute}->PT_CAUSE() if ($thread->{pt_execute}->PT_STATE() == PT_ERROR);
OWXTHERM_BinValues($hash,1,$owx_dev,undef,9,$thread->{pt_execute}->PT_RETVAL());
PT_END;
});
}
#######################################################################################
@ -1140,57 +1168,61 @@ sub OWXTHERM_PT_GetValues($@) {
########################################################################################
sub OWXTHERM_PT_SetValues($$) {
my ($thread, $hash, $args) = @_;
my ($i,$j,$k);
my ($hash,$args) = @_;
my $name = $hash->{NAME};
#-- ID of the device
my $owx_dev = $hash->{ROM_ID};
#-- hash of the busmaster
my $master = $hash->{IODev};
return PT_THREAD( sub {
my ($thread) = @_;
PT_BEGIN($thread);
unless (defined $args->{resolution} or defined $args->{tempLow} or defined $args->{tempHigh}) {
PT_EXIT;
}
#-- $owg_tl and $owg_th are preset and may be changed here
foreach my $key (keys %$args) {
$hash->{owg_tl} = $args->{$key} if( lc($key) eq "templow");
$hash->{owg_th} = $args->{$key} if( lc($key) eq "temphigh");
$hash->{owg_cf} = $args->{$key} if( lc($key) eq "resolution");
}
my ($i,$j,$k);
#-- put into 2's complement formed (signed byte)
my $tlp = $hash->{owg_tl} < 0 ? 128 - $hash->{owg_tl} : $hash->{owg_tl};
my $thp = $hash->{owg_th} < 0 ? 128 - $hash->{owg_th} : $hash->{owg_th};
#-- resolution is defined in bits 5+6 of configuration register
my $cfg = defined $hash->{owg_cf} ? (($hash->{owg_cf}-9) << 5) | 0x1f : 0x7f;
my $name = $hash->{NAME};
#-- issue the match ROM command \x55 and the write scratchpad command \x4E,
# followed by 3 bytes of data (alarm_temp_high, alarm_temp_low, config)
# config-byte of 0x7F means 12 bit resolution (750ms convert time)
#
# so far writing the EEPROM does not work properly.
# 1. \x48 directly appended to the write scratchpad command => command ok, no effect on EEPROM
# 2. \x48 appended to match ROM => command not ok.
# 3. \x48 sent by WriteBytePower after match ROM => command ok, no effect on EEPROM
my $select=sprintf("\x4E%c%c%c",$thp,$tlp,$cfg);
unless (OWX_ASYNC_Execute($master,$thread,1,$owx_dev,$select,3)) {
PT_EXIT("OWXTHERM: Device $owx_dev not accessible");
}
PT_WAIT_UNTIL(defined $thread->{ExecuteResponse});
#-- process results
$hash->{PRESENT} = 1;
if ($args->{format}) {
OWTHERM_FormatValues($hash);
}
PT_END;
#-- ID of the device
my $owx_dev = $hash->{ROM_ID};
#-- hash of the busmaster
my $master = $hash->{IODev};
PT_BEGIN($thread);
unless (defined $args->{resolution} or defined $args->{tempLow} or defined $args->{tempHigh}) {
PT_EXIT;
}
#-- $owg_tl and $owg_th are preset and may be changed here
foreach my $key (keys %$args) {
$hash->{owg_tl} = $args->{$key} if( lc($key) eq "templow");
$hash->{owg_th} = $args->{$key} if( lc($key) eq "temphigh");
$hash->{owg_cf} = $args->{$key} if( lc($key) eq "resolution");
}
#-- put into 2's complement formed (signed byte)
my $tlp = $hash->{owg_tl} < 0 ? 128 - $hash->{owg_tl} : $hash->{owg_tl};
my $thp = $hash->{owg_th} < 0 ? 128 - $hash->{owg_th} : $hash->{owg_th};
#-- resolution is defined in bits 5+6 of configuration register
my $cfg = defined $hash->{owg_cf} ? (($hash->{owg_cf}-9) << 5) | 0x1f : 0x7f;
#-- issue the match ROM command \x55 and the write scratchpad command \x4E,
# followed by 3 bytes of data (alarm_temp_high, alarm_temp_low, config)
# config-byte of 0x7F means 12 bit resolution (750ms convert time)
#
# so far writing the EEPROM does not work properly.
# 1. \x48 directly appended to the write scratchpad command => command ok, no effect on EEPROM
# 2. \x48 appended to match ROM => command not ok.
# 3. \x48 sent by WriteBytePower after match ROM => command ok, no effect on EEPROM
my $select=sprintf("\x4E%c%c%c",$thp,$tlp,$cfg);
$thread->{pt_execute} = OWX_ASYNC_PT_Execute($master,1,$owx_dev,$select,3);
PT_WAIT_THREAD($thread->{pt_execute});
die $thread->{pt_execute}->PT_CAUSE() if ($thread->{pt_execute}->PT_STATE() == PT_ERROR);
#-- process results
$hash->{PRESENT} = 1;
if ($args->{format}) {
OWTHERM_FormatValues($hash);
}
PT_END;
});
}
1;

6
fhem/FHEM/GPUtils.pm
View File

@ -32,14 +32,14 @@ sub GP_Catch($) {
return undef;
}
sub GP_ForallClients($$$)
sub GP_ForallClients($$@)
{
my ($hash,$fn,$args) = @_;
my ($hash,$fn,@args) = @_;
foreach my $d ( sort keys %main::defs ) {
if ( defined( $main::defs{$d} )
&& defined( $main::defs{$d}{IODev} )
&& $main::defs{$d}{IODev} == $hash ) {
&$fn($main::defs{$d},$args);
&$fn($main::defs{$d},@args);
}
}
return undef;

186
fhem/FHEM/OWX_Executor.pm
View File

@ -1,186 +0,0 @@
##############################################
# $Id$
##############################################
package OWX_Executor;
use strict;
use warnings;
use constant {
DISCOVER => 1,
ALARMS => 2,
VERIFY => 3,
EXECUTE => 4,
EXIT => 5,
LOG => 6
};
sub new() {
my $class = shift;
my $self = {};
$self->{worker} = OWX_Worker->new($self);
return bless $self,$class;
};
sub discover($) {
my ($self,$hash) = @_;
if($self->{worker}->submit( { command => DISCOVER }, $hash )) {
$self->poll($hash);
return 1;
}
return undef;
}
sub alarms($) {
my ($self,$hash) = @_;
if($self->{worker}->submit( { command => ALARMS }, $hash )) {
$self->poll($hash);
return 1;
}
return undef;
}
sub verify($$) {
my ($self,$hash,$device) = @_;
if($self->{worker}->submit( { command => VERIFY, address => $device }, $hash )) {
$self->poll($hash);
return 1;
}
return undef;
}
sub execute($$$$$$$) {
my ( $self, $hash, $context, $reset, $owx_dev, $data, $numread ) = @_;
if($self->{worker}->submit( {
command => EXECUTE,
context => $context,
reset => $reset,
address => $owx_dev,
writedata => $data,
numread => $numread
}, $hash )) {
$self->poll($hash);
return 1;
}
return undef;
};
sub exit($) {
my ( $self,$hash ) = @_;
if($self->{worker}->submit( { command => EXIT }, $hash )) {
$self->poll($hash);
return 1;
}
return undef;
}
sub poll($) {
my ( $self,$hash ) = @_;
$self->read();
$self->{worker}->PT_SCHEDULE($hash);
}
# start of worker code
package OWX_Worker;
use Time::HiRes qw( gettimeofday tv_interval usleep );
use ProtoThreads;
no warnings 'deprecated';
use vars qw/@ISA/;
@ISA='ProtoThreads';
sub new($) {
my ($class,$owx) = @_;
my $worker = PT_THREAD(\&pt_main);
$worker->{commands} = [];
$worker->{delayed} = {};
$worker->{owx} = $owx;
return bless $worker,$class;
}
sub submit($$) {
my ($self,$command,$hash) = @_;
push @{$self->{commands}}, $command;
$self->PT_SCHEDULE($hash);
return 1;
}
sub pt_main($) {
my ( $self, $hash ) = @_;
my $item = $self->{item};
PT_BEGIN($self);
PT_WAIT_UNTIL($item = $self->nextItem($hash));
$self->{item} = $item;
REQUEST_HANDLER: {
my $command = $item->{command};
$command eq OWX_Executor::DISCOVER and do {
PT_WAIT_THREAD($self->{owx}->{pt_discover},$self->{owx});
my $devices = $self->{owx}->{pt_discover}->PT_RETVAL();
if (defined $devices) {
main::OWX_ASYNC_AfterSearch($hash,$devices);
}
PT_EXIT;
};
$command eq OWX_Executor::ALARMS and do {
PT_WAIT_THREAD($self->{owx}->{pt_alarms},$self->{owx});
my $devices = $self->{owx}->{pt_alarms}->PT_RETVAL();
if (defined $devices) {
main::OWX_ASYNC_AfterAlarms($hash,$devices);
}
PT_EXIT;
};
$command eq OWX_Executor::VERIFY and do {
PT_WAIT_THREAD($self->{owx}->{pt_verify},$self->{owx},$item->{address});
my $devices = $self->{owx}->{pt_verify}->PT_RETVAL();
if (defined $devices) {
main::OWX_ASYNC_AfterVerify($hash,$devices);
}
PT_EXIT;
};
$command eq OWX_Executor::EXECUTE and do {
PT_WAIT_THREAD($self->{owx}->{pt_execute},$self->{owx},$hash,$item->{context},$item->{reset},$item->{address},$item->{writedata},$item->{numread});
my $res = $self->{owx}->{pt_execute}->PT_RETVAL();
unless (defined $res) {
main::OWX_ASYNC_AfterExecute($hash,$item->{context},undef,$item->{reset},$item->{address},$item->{writedata},$item->{numread},undef);
PT_EXIT;
}
my $writelen = defined $item->{writedata} ? split (//,$item->{writedata}) : 0;
my @result = split (//, $res);
my $readdata = 9+$writelen < @result ? substr($res,9+$writelen) : "";
main::OWX_ASYNC_AfterExecute($hash,$item->{context},1,$item->{reset},$item->{address},$item->{writedata},$item->{numread},$readdata);
PT_EXIT;
};
$command eq OWX_Executor::EXIT and do {
main::OWX_ASYNC_Disconnected($hash);
PT_EXIT;
};
main::Log3($hash->{NAME},3,"OWX_Executor: unexpected command: "+$command);
};
PT_END;
};
sub nextItem($) {
my ( $self,$hash ) = @_;
my $item = shift @{$self->{commands}};
if ($item) {
if($item->{context}) {
main::Log3 $hash->{NAME},5,"OWX_Executor: item $item->{context} for ".(defined $item->{address} ? $item->{address} : "---")." eligible to run";
} else {
main::Log3 $hash->{NAME},5,"OWX_Executor: command $item->{command} eligible to run";
}
}
return $item;
}
1;

212
fhem/FHEM/OWX_FRM.pm
View File

@ -36,7 +36,9 @@ BEGIN {
};
use Device::Firmata::Constants qw/ :all /;
use Time::HiRes qw(gettimeofday tv_interval);
use Time::HiRes qw( gettimeofday );
use ProtoThreads;
no warnings 'deprecated';
sub new() {
my ($class) = @_;
@ -103,41 +105,27 @@ sub FRM_OWX_observer
my $command = $data->{command};
COMMAND_HANDLER: {
$command eq "READ_REPLY" and do {
my $id = $data->{id};
my $request = ( defined $id ) ? $self->{requests}->{$id} : undef;
unless ( defined $request ) {
last unless ( defined $data->{device} );
my $owx_device = FRM_OWX_firmata_to_device( $data->{device} );
my %requests = %{ $self->{requests} };
foreach my $key ( keys %requests ) {
if ( $requests{$key}->{device} eq $owx_device ) {
$request = $requests{$key};
$id = $key;
last;
};
};
};
last unless ( defined $request );
my $owx_data = pack "C*", @{ $data->{data} };
my $owx_device = $request->{device};
my $context = $request->{context};
my $reqcommand = $request->{command};
my $writedata = pack "C*", @{ $reqcommand->{'write'} } if ( defined $reqcommand->{'write'} );
main::OWX_ASYNC_AfterExecute( $self->{hash}, $context, 1, $reqcommand->{'reset'}, $owx_device, $writedata, $reqcommand->{'read'}, $owx_data);
delete $self->{requests}->{$id};
$self->{responses}->{$data->{id}} = $data->{data}; # // $data->{device} // "defaultid"}
main::Log3 ($self->{name},5,"FRM_OWX_observer: READ_REPLY $data->{id}: ".join " ",map sprintf("%02X",$_),@{$data->{data}}) if $self->{debug};
last;
};
( $command eq "SEARCH_REPLY" or $command eq "SEARCH_ALARMS_REPLY" ) and do {
my @owx_devices = ();
foreach my $device ( @{ $data->{devices} } ) {
push @owx_devices, FRM_OWX_firmata_to_device($device);
push @owx_devices, firmata_to_device($device);
};
if ( $command eq "SEARCH_REPLY" ) {
$self->{devs} = \@owx_devices;
main::OWX_ASYNC_AfterSearch( $self->{hash}, \@owx_devices );
main::Log3 ($self->{name},5,"FRM_OWX_observer: SEARCH_REPLY: ".join ",",@owx_devices) if $self->{debug};
$self->{devs_timestamp} = gettimeofday();
#TODO avoid OWX_ASYNC_AfterSearch to be called twice
main::OWX_ASYNC_AfterSearch($self->{hash},\@owx_devices);
} else {
$self->{alarmdevs} = \@owx_devices;
main::OWX_ASYNC_AfterAlarms( $self->{hash}, \@owx_devices );
main::Log3 ($self->{name},5,"FRM_OWX_observer: SEARCH_ALARMS_REPLY: ".join ",",@owx_devices) if $self->{debug};
$self->{alarmdevs_timestamp} = gettimeofday();
#TODO avoid OWX_ASYNC_AfterAlarms to be called twice
main::OWX_ASYNC_AfterAlarms($self->{hash},\@owx_devices);
};
last;
};
@ -147,7 +135,7 @@ COMMAND_HANDLER: {
########### functions implementing interface to OWX ##########
sub FRM_OWX_device_to_firmata
sub device_to_firmata
{
my @device;
foreach my $hbyte ( unpack "A2xA2A2A2A2A2A2xA2", shift ) {
@ -160,7 +148,7 @@ sub FRM_OWX_device_to_firmata
}
}
sub FRM_OWX_firmata_to_device
sub firmata_to_device
{
my $device = shift;
return sprintf( "%02X.%02X%02X%02X%02X%02X%02X.%02X", $device->{family}, @{ $device->{identity} }, $device->{crc} );
@ -168,82 +156,114 @@ sub FRM_OWX_firmata_to_device
########################################################################################
#
# asynchronous methods search, alarms and execute
# factory methods for protothreads running discover, search, alarms and execute
#
########################################################################################
sub discover($) {
my ( $self, $hash ) = @_;
my $success = undef;
eval {
if ( my $firmata = main::FRM_Client_FirmataDevice($hash) and my $pin = $self->{pin} ) {
$firmata->onewire_search($pin);
$success = 1;
};
};
if ($@) {
main::Log( 5, $@ );
$self->exit($hash);
};
return $success;
};
########################################################################################
#
# Discover - Find devices on the 1-Wire bus
#
# Parameter hash = hash of bus master
#
# Return 1, if alarmed devices found, 0 otherwise.
#
########################################################################################
sub alarms($) {
my ( $self, $hash ) = @_;
my $success = undef;
eval {
if ( my $firmata = main::FRM_Client_FirmataDevice($hash) and my $pin = $self->{pin} ) {
$firmata->onewire_search_alarms($pin);
$success = 1;
};
};
if ($@) {
$self->exit($hash);
};
return $success;
};
sub get_pt_discover() {
my ($self) = @_;
return PT_THREAD(sub {
my ($thread) = @_;
PT_BEGIN($thread);
delete $self->{devs};
main::FRM_Client_FirmataDevice($self->{hash})->onewire_search($self->{pin});
PT_WAIT_UNTIL(defined $self->{devs});
PT_EXIT($self->{devs});
PT_END;
});
}
sub execute($$$$$$) {
my ( $self, $hash, $context, $reset, $owx_dev, $data, $numread ) = @_;
########################################################################################
#
# Alarms - Find devices on the 1-Wire bus, which have the alarm flag set
#
# Return number of alarmed devices
#
########################################################################################
my $success = undef;
sub get_pt_alarms() {
my ($self) = @_;
return PT_THREAD(sub {
my ($thread) = @_;
PT_BEGIN($thread);
delete $self->{alarmdevs};
main::FRM_Client_FirmataDevice($self->{hash})->onewire_search_alarms($self->{pin});
PT_WAIT_UNTIL(defined $self->{alarmdevs});
PT_EXIT($self->{alarmdevs});
PT_END;
});
}
eval {
if ( my $firmata = main::FRM_Client_FirmataDevice($hash) and my $pin = $self->{pin} ) {
my @data = unpack "C*", $data if defined $data;
my $id = $self->{id} if ($numread);
sub get_pt_verify($) {
my ($self,$dev) = @_;
return PT_THREAD(sub {
my ($thread) = @_;
PT_BEGIN($thread);
delete $self->{devs};
main::FRM_Client_FirmataDevice($self->{hash})->onewire_search($self->{pin});
PT_WAIT_UNTIL(defined $self->{devs});
PT_EXIT(scalar(grep {$dev eq $_} @{$self->{devs}}));
PT_END;
});
}
########################################################################################
#
# Complex - Send match ROM, data block and receive bytes as response
#
# Parameter hash = hash of bus master,
# owx_dev = ROM ID of device
# data = string to send
# numread = number of bytes to receive
#
# Return response, if OK
# 0 if not OK
#
########################################################################################
sub get_pt_execute($$$$) {
my ($self, $reset, $owx_dev, $writedata, $numread) = @_;
return PT_THREAD(sub {
my ($thread) = @_;
PT_BEGIN($thread);
if ( my $firmata = main::FRM_Client_FirmataDevice($self->{hash}) and my $pin = $self->{pin} ) {
my @data = unpack "C*", $writedata if defined $writedata;
my $id = $self->{id};
my $ow_command = {
'reset' => $reset,
'skip' => defined($owx_dev) ? undef : 1,
'select' => defined($owx_dev) ? FRM_OWX_device_to_firmata($owx_dev) : undef,
'select' => defined($owx_dev) ? device_to_firmata($owx_dev) : undef,
'read' => $numread,
'write' => @data ? \@data : undef,
'delay' => undef,
'id' => $numread ? $id : undef
};
if ($numread) {
$owx_dev = '00.000000000000.00' unless defined $owx_dev;
$self->{requests}->{$id} = {
context => $context,
command => $ow_command,
device => $owx_dev
};
$self->{id} = ( ( $id + 1 ) & 0xFFFF );
};
main::Log3 ($self->{name},5,"FRM_OWX_Execute: $id: $owx_dev [".join(" ",(map sprintf("%02X",$_),@data))."] numread: ".(defined $numread ? $numread : 0)) if $self->{debug};
$firmata->onewire_command_series( $pin, $ow_command );
$success = 1;
if ($numread) {
$thread->{id} = $id;
$self->{id} = ( $id + 1 ) & 0xFFFF;
delete $self->{responses}->{$id};
PT_WAIT_UNTIL(defined $self->{responses}->{$thread->{id}});
my $ret = pack "C*", @{$self->{responses}->{$thread->{id}}};
delete $self->{responses}->{$thread->{id}};
PT_EXIT($ret);
};
};
};
if ($@) {
main::Log3 $hash->{NAME},1,"OWX_FRM: $@";
#$self->exit($hash);
};
unless ($numread) {
main::OWX_ASYNC_AfterExecute( $hash, $context, $success, $reset, $owx_dev, $data, $numread, "" );
main::InternalTimer(gettimeofday(), "OWX_ASYNC_RunTasks", $hash,0);
}
return $success;
PT_END;
});
};
sub exit($) {
@ -258,22 +278,4 @@ sub poll($) {
}
};
#sub printqueues($$) {
# my ($self,$hash,$calledfrom) = @_;
# my $name = $hash->{NAME};
# main::Log3 $name,5,"OWX_ASYNC all queues, called from :".$calledfrom;
# my $delayed = $self->{delayed};
#
# foreach my $address ( keys %$delayed ) {
# my $msg = $address.": until: ";
# $msg .= $delayed->{$address}->{'until'} ? $delayed->{$address}->{'until'}->[0].",".$delayed->{$address}->{'until'}->[1] : "---";
# $msg .= " items: [";
# foreach my $item (@{$delayed->{$address}->{'items'}}) {
# $msg .= $item->{context}.",";
# }
# $msg .= "]";
# main::Log3 $name,5,$msg;
# }
#}
1;

302
fhem/FHEM/OWX_SER.pm
View File

@ -29,8 +29,8 @@ use strict;
use warnings;
use vars qw/@ISA/;
@ISA='OWX_Executor';
use Time::HiRes qw( gettimeofday );
use ProtoThreads;
no warnings 'deprecated';
@ -41,34 +41,30 @@ no warnings 'deprecated';
########################################################################################
sub new() {
my $class = shift;
require "$main::attr{global}{modpath}/FHEM/OWX_Executor.pm";
my $self = OWX_Executor->new();
$self->{interface} = "serial";
#-- baud rate serial interface
$self->{baud} = 9600;
#-- 16 byte search string
$self->{search} = [0,0,0,0 ,0,0,0,0, 0,0,0,0, 0,0,0,0];
$self->{ROM_ID} = [0,0,0,0 ,0,0,0,0];
#-- search state for 1-Wire bus search
$self->{LastDiscrepancy} = 0;
$self->{LastFamilyDiscrepancy} = 0;
$self->{LastDeviceFlag} = 0;
#-- module version
$self->{version} = 4.1;
$self->{alarmdevs} = [];
$self->{devs} = [];
$self->{pt_alarms} = PT_THREAD(\&pt_alarms);
$self->{pt_discover} = PT_THREAD(\&pt_discover);
$self->{pt_verify} = PT_THREAD(\&pt_verify);
$self->{pt_execute} = PT_THREAD(\&pt_execute);
$self->{timeout} = 1.0; #default timeout 1 sec.
my $class = shift;
my $self = {
interface => "serial",
#-- baud rate serial interface
baud => 9600,
#-- 16 byte search string
search => [0,0,0,0 ,0,0,0,0, 0,0,0,0, 0,0,0,0],
ROM_ID => [0,0,0,0 ,0,0,0,0],
#-- search state for 1-Wire bus search
LastDiscrepancy => 0,
LastFamilyDiscrepancy => 0,
LastDeviceFlag => 0,
#-- module version
version => 4.1,
alarmdevs => [],
devs => [],
timeout => 1.0, #default timeout 1 sec.
};
return bless $self,$class;
}
return bless $self,$class;
sub poll($) {
my ( $self ) = @_;
$self->read();
}
########################################################################################
@ -116,21 +112,23 @@ sub Define ($$) {
#
########################################################################################
sub pt_alarms () {
my ($thread,$self) = @_;
PT_BEGIN($thread);
$self->{alarmdevs} = [];
#-- Discover all alarmed devices on the 1-Wire bus
$self->first("alarm");
do {
$self->next("alarm");
PT_WAIT_UNTIL($self->response_ready());
PT_EXIT unless $self->next_response("alarm");
} while( $self->{LastDeviceFlag}==0 );
main::Log3($self->{name},5, " Alarms = ".join(' ',@{$self->{alarmdevs}}));
PT_EXIT($self->{alarmdevs});
PT_END;
sub get_pt_alarms() {
my ($self) = @_;
return PT_THREAD(sub {
my ($thread) = @_;
PT_BEGIN($thread);
$self->{alarmdevs} = [];
#-- Discover all alarmed devices on the 1-Wire bus
$self->first("alarm");
do {
$self->next("alarm");
PT_WAIT_UNTIL($self->response_ready());
PT_EXIT unless $self->next_response("alarm");
} while( $self->{LastDeviceFlag}==0 );
main::Log3($self->{name},5, " Alarms = ".join(' ',@{$self->{alarmdevs}}));
PT_EXIT($self->{alarmdevs});
PT_END;
});
}
########################################################################################
@ -147,72 +145,84 @@ sub pt_alarms () {
#
########################################################################################
sub pt_execute($$$$$$$) {
my ($thread, $self, $hash, $context, $reset, $dev, $writedata, $numread) = @_;
PT_BEGIN($thread);
sub get_pt_execute($$$$) {
my ($self, $reset, $dev, $writedata, $numread) = @_;
return PT_THREAD(sub {
my ($thread) = @_;
PT_BEGIN($thread);
$thread->{writedata} = $writedata;
#-- get the interface
my $interface = $self->{interface};
my $hwdevice = $self->{hwdevice};
unless (defined $hwdevice) {
PT_EXIT;
}
#-- get the interface
my $interface = $self->{interface};
my $hwdevice = $self->{hwdevice};
PT_EXIT unless (defined $hwdevice);
$self->reset() if ($reset);
if (defined $writedata or $numread) {
my $select;
$self->reset() if ($reset);
#-- has match ROM part
if( $dev ) {
#-- ID of the device
my $owx_rnf = substr($dev,3,12);
my $owx_f = substr($dev,0,2);
if (defined $writedata or $numread) {
#-- 8 byte 1-Wire device address
my @rom_id =(0,0,0,0 ,0,0,0,0);
#-- from search string to byte id
$dev=~s/\.//g;
for(my $i=0;$i<8;$i++){
$rom_id[$i]=hex(substr($dev,2*$i,2));
my $select;
#-- has match ROM part
if( $dev ) {
#-- ID of the device
my $owx_rnf = substr($dev,3,12);
my $owx_f = substr($dev,0,2);
#-- 8 byte 1-Wire device address
my @rom_id =(0,0,0,0 ,0,0,0,0);
#-- from search string to byte id
$dev=~s/\.//g;
for(my $i=0;$i<8;$i++){
$rom_id[$i]=hex(substr($dev,2*$i,2));
}
$select=sprintf("\x55%c%c%c%c%c%c%c%c",@rom_id);
#-- has no match ROM part, issue skip ROM command (0xCC:)
} else {
$select="\xCC";
}
$select=sprintf("\x55%c%c%c%c%c%c%c%c",@rom_id);
#-- has no match ROM part, issue skip ROM command (0xCC:)
} else {
$select="\xCC";
}
if (defined $writedata) {
$select.=$writedata;
}
#-- has receive data part
if( $numread ) {
#$numread += length($data);
for( my $i=0;$i<$numread;$i++){
$select .= "\xFF";
};
if (defined $writedata) {
$select.=$writedata;
}
#-- has receive data part
if( $numread ) {
#$numread += length($data);
for( my $i=0;$i<$numread;$i++){
$select .= "\xFF";
};
}
#-- for debugging
if( $main::owx_async_debug > 1){
main::Log3($self->{name},5,"OWX_SER::Execute: Sending out ".unpack ("H*",$select));
}
$self->block($select);
}
PT_WAIT_UNTIL($self->response_ready());
if ($reset and !$self->reset_response()) {
PT_EXIT
}
my $res = $self->{string_in};
#-- for debugging
if( $main::owx_async_debug > 1){
main::Log3($self->{name},5,"OWX_SER::Execute: Sending out ".unpack ("H*",$select));
main::Log3($self->{name},5,"OWX_SER::Execute: Receiving ".unpack ("H*",$res));
}
$self->block($select);
}
PT_WAIT_UNTIL($self->response_ready());
PT_EXIT if ($reset and !$self->reset_response());
my $res = $self->{string_in};
#-- for debugging
if( $main::owx_async_debug > 1){
main::Log3($self->{name},5,"OWX_SER::Execute: Receiving ".unpack ("H*",$res));
}
PT_EXIT($res);
PT_END;
if (defined $res) {
my $writelen = defined $thread->{writedata} ? split (//,$thread->{writedata}) : 0;
my @result = split (//, $res);
my $readdata = 9+$writelen < @result ? substr($res,9+$writelen) : "";
PT_EXIT($readdata);
}
PT_END;
});
}
########################################################################################
@ -225,18 +235,21 @@ sub pt_execute($$$$$$$) {
#
########################################################################################
sub pt_discover($) {
my ($thread,$self) = @_;
PT_BEGIN($thread);
#-- Discover all alarmed devices on the 1-Wire bus
$self->first("discover");
do {
$self->next("discover");
PT_WAIT_UNTIL($self->response_ready());
PT_EXIT unless $self->next_response("discover");
} while( $self->{LastDeviceFlag}==0 );
PT_EXIT($self->{devs});
PT_END;
sub get_pt_discover() {
my ($self) = @_;
return PT_THREAD(sub {
my ($thread) = @_;
PT_BEGIN($thread);
#-- Discover all alarmed devices on the 1-Wire bus
$self->first("discover");
do {
$self->next("discover");
PT_WAIT_UNTIL($self->response_ready());
PT_EXIT unless $self->next_response("discover");
} while( $self->{LastDeviceFlag}==0 );
PT_EXIT($self->{devs});
PT_END;
});
}
########################################################################################
@ -382,38 +395,41 @@ sub Disconnect($) {
#
########################################################################################
sub pt_verify ($) {
my ($thread,$self,$dev) = @_;
my $i;
PT_BEGIN($thread);
#-- from search string to byte id
my $devs=$dev;
$devs=~s/\.//g;
for($i=0;$i<8;$i++){
@{$self->{ROM_ID}}[$i]=hex(substr($devs,2*$i,2));
}
#-- reset the search state
$self->{LastDiscrepancy} = 64;
$self->{LastDeviceFlag} = 0;
$self->reset();
#-- now do the search
$self->next("verify");
PT_WAIT_UNTIL($self->response_ready());
PT_EXIT unless $self->next_response("verify");
my $dev2=sprintf("%02X.%02X%02X%02X%02X%02X%02X.%02X",@{$self->{ROM_ID}});
#-- reset the search state
$self->{LastDiscrepancy} = 0;
$self->{LastDeviceFlag} = 0;
#-- check result
if ($dev eq $dev2){
PT_EXIT(1);
}else{
PT_EXIT;
}
PT_END;
}
sub get_pt_verify($) {
my ($self,$dev) = @_;
return PT_THREAD(sub {
my ($thread) = @_;
my $i;
PT_BEGIN($thread);
#-- from search string to byte id
my $devs=$dev;
$devs=~s/\.//g;
for($i=0;$i<8;$i++){
@{$self->{ROM_ID}}[$i]=hex(substr($devs,2*$i,2));
}
#-- reset the search state
$self->{LastDiscrepancy} = 64;
$self->{LastDeviceFlag} = 0;
$self->reset();
#-- now do the search
$self->next("verify");
PT_WAIT_UNTIL($self->response_ready());
PT_EXIT unless $self->next_response("verify");
my $dev2=sprintf("%02X.%02X%02X%02X%02X%02X%02X.%02X",@{$self->{ROM_ID}});
#-- reset the search state
$self->{LastDiscrepancy} = 0;
$self->{LastDeviceFlag} = 0;
#-- check result
if ($dev eq $dev2){
PT_EXIT(1);
}else{
PT_EXIT(0);
}
PT_END;
});
};
#######################################################################################
#

153
fhem/FHEM/lib/ProtoThreads.pm
View File

@ -1,4 +1,4 @@
# Perl Protothreads Version 1.01
# Perl Protothreads Version 1.04
#
# a lightwight pseudo-threading framework for perl that is
# heavily inspired by Adam Dunkels protothreads for the c-language
@ -58,16 +58,19 @@
package ProtoThreads;
use constant {
PT_WAITING => 0,
PT_EXITED => 1,
PT_ENDED => 2,
PT_YIELDED => 3,
PT_INITIAL => 0,
PT_WAITING => 1,
PT_YIELDED => 2,
PT_EXITED => 3,
PT_ENDED => 4,
PT_ERROR => 5,
PT_CANCELED => 6,
};
my $DEBUG=0;
use Exporter 'import';
@EXPORT = qw(PT_THREAD PT_WAITING PT_EXITED PT_ENDED PT_YIELDED PT_INIT PT_SCHEDULE);
@EXPORT = qw(PT_THREAD PT_INITIAL PT_WAITING PT_YIELDED PT_EXITED PT_ENDED PT_ERROR PT_CANCELED PT_INIT PT_SCHEDULE);
@EXPORT_OK = qw();
use Text::Balanced qw (
@ -77,14 +80,17 @@ use Text::Balanced qw (
sub PT_THREAD($) {
my $method = shift;
return bless({
PT_THREAD_STATE => 0,
PT_THREAD_METHOD => $method
PT_THREAD_STATE => PT_INITIAL,
PT_THREAD_POSITION => 0,
PT_THREAD_METHOD => $method
}, "ProtoThreads");
}
sub PT_INIT($) {
my $self = shift;
$self->{PT_THREAD_STATE} = 0;
$self->{PT_THREAD_POSITION} = 0;
$self->{PT_THREAD_STATE} = PT_INITIAL;
delete $self->{PT_THREAD_ERROR};
}
sub PT_SCHEDULE(@) {
@ -93,11 +99,28 @@ sub PT_SCHEDULE(@) {
return ($state == PT_WAITING or $state == PT_YIELDED);
}
sub PT_CANCEL($) {
my ($self,$cause) = @_;
$self->{PT_THREAD_POSITION} = 0;
$self->{PT_THREAD_ERROR} = $cause;
$self->{PT_THREAD_STATE} = PT_CANCELED;
}
sub PT_RETVAL() {
my $self = shift;
return $self->{PT_THREAD_RETURN};
}
sub PT_STATE() {
my $self = shift;
return $self->{PT_THREAD_STATE};
}
sub PT_CAUSE() {
my $self = shift;
return $self->{PT_THREAD_ERROR};
}
sub PT_NEXTCOMMAND($$) {
my ($code,$command) = @_;
if ($code =~ /$command\s*(?=\()/s) {
@ -121,65 +144,67 @@ FILTER_ONLY
my $code = $_;
my $counter = 1;
my ($success,$before,$arg,$after);
my ($success,$before,$arg,$after,$beforeblock);
while(1) {
my $thread = " - no PT_BEGIN before use of thread - ";
($success,$before,$arg,$after) = PT_NEXTCOMMAND($code,"PT_BEGIN");
($success,$beforeblock,$arg,$after) = PT_NEXTCOMMAND($code,"PT_BEGIN");
if ($success) {
$thread = $arg;
$code=$before."my \$PT_THREAD_STATE = eval { my \$PT_YIELD_FLAG = 1; goto ".$thread."->{PT_THREAD_STATE} if ".$thread."->{PT_THREAD_STATE};".$after;
while (1) {
($success,$before,$arg,$after) = PT_NEXTCOMMAND($code,"PT_YIELD_UNTIL");
if ($success) {
$code=$before."\$PT_YIELD_FLAG = 0; ".$thread."->{PT_THREAD_STATE} = 'PT_LABEL_$counter'; PT_LABEL_$counter: return PT_YIELDED unless (\$PT_YIELD_FLAG and ($arg));".$after;
$counter++;
next;
if ($after =~ /PT_END\s*;/s) {
my $thread = $arg;
my $block = $thread."->{PT_THREAD_STATE} = eval { my \$PT_YIELD_FLAG = 1; goto ".$thread."->{PT_THREAD_POSITION} if ".$thread."->{PT_THREAD_POSITION};".$`.$thread."->{PT_THREAD_POSITION} = 0; delete ".$thread."->{PT_THREAD_RETURN}; return PT_ENDED; }; if (\$\@) {".$thread."->{PT_THREAD_STATE} = PT_ERROR; ".$thread."->{PT_THREAD_ERROR} = \$\@; }; return ".$thread."->{PT_THREAD_STATE};";
my $afterblock = $';
while (1) {
($success,$before,$arg,$after) = PT_NEXTCOMMAND($block,"PT_YIELD_UNTIL");
if ($success) {
$block=$before."\$PT_YIELD_FLAG = 0; ".$thread."->{PT_THREAD_POSITION} = 'PT_LABEL_$counter'; PT_LABEL_$counter: return PT_YIELDED unless (\$PT_YIELD_FLAG and ($arg));".$after;
$counter++;
next;
}
if ($block =~ /PT_YIELD\s*;/s) {
$block = $`."\$PT_YIELD_FLAG = 0; ".$thread."->{PT_THREAD_POSITION} = 'PT_LABEL_$counter'; PT_LABEL_$counter: return PT_YIELDED unless \$PT_YIELD_FLAG;".$';
$counter++;
next;
}
($success,$before,$arg,$after) = PT_NEXTCOMMAND($block,"PT_WAIT_UNTIL");
if ($success) {
$block=$before.$thread."->{PT_THREAD_POSITION} = 'PT_LABEL_$counter'; PT_LABEL_$counter: return PT_WAITING unless ($arg);".$after;
$counter++;
next;
}
($success,$before,$arg,$after) = PT_NEXTCOMMAND($block,"PT_WAIT_WHILE");
if ($success) {
$block=$before.$thread."->{PT_THREAD_POSITION} = 'PT_LABEL_$counter'; PT_LABEL_$counter: return PT_WAITING if ($arg);".$after;
$counter++;
next;
}
($success,$before,$arg,$after) = PT_NEXTCOMMAND($block,"PT_WAIT_THREAD");
if ($success) {
$block=$before."PT_WAIT_WHILE(PT_SCHEDULE(".$arg."));".$after;
next;
}
($success,$before,$arg,$after) = PT_NEXTCOMMAND($block,"PT_SPAWN");
if ($success) {
$block=$before.$arg."->{PT_THREAD_POSITION} = 0; PT_WAIT_THREAD($arg);".$after;
next;
}
($success,$before,$arg,$after) = PT_NEXTCOMMAND($block,"PT_EXIT");
if ($success) {
$block=$before.$thread."->{PT_THREAD_POSITION} = 0; ".$thread."->{PT_THREAD_RETURN} = $arg; return PT_EXITED;".$after;
next;
}
if ($block =~ /PT_EXIT(\s*;|\s+)/s) {
$block = $`.$thread."->{PT_THREAD_POSITION} = 0; delete ".$thread."->{PT_THREAD_RETURN}; return PT_EXITED".$1.$';
next;
}
if ($block =~ /PT_RESTART(\s*;|\s)/s) {
$block = $`.$thread."->{PT_THREAD_POSITION} = 0; return PT_WAITING;".$1.$';
next;
}
last;
}
if ($code =~ /PT_YIELD\s*;/s) {
$code = $`."\$PT_YIELD_FLAG = 0; ".$thread."->{PT_THREAD_STATE} = 'PT_LABEL_$counter'; PT_LABEL_$counter: return PT_YIELDED unless \$PT_YIELD_FLAG;".$';
$counter++;
next;
}
($success,$before,$arg,$after) = PT_NEXTCOMMAND($code,"PT_WAIT_UNTIL");
if ($success) {
$code=$before.$thread."->{PT_THREAD_STATE} = 'PT_LABEL_$counter'; PT_LABEL_$counter: return PT_WAITING unless ($arg);".$after;
$counter++;
next;
}
($success,$before,$arg,$after) = PT_NEXTCOMMAND($code,"PT_WAIT_WHILE");
if ($success) {
$code=$before.$thread."->{PT_THREAD_STATE} = 'PT_LABEL_$counter'; PT_LABEL_$counter: return PT_WAITING if ($arg);".$after;
$counter++;
next;
}
($success,$before,$arg,$after) = PT_NEXTCOMMAND($code,"PT_WAIT_THREAD");
if ($success) {
$code=$before."PT_WAIT_WHILE(PT_SCHEDULE(".$arg."));".$after;
next;
}
($success,$before,$arg,$after) = PT_NEXTCOMMAND($code,"PT_SPAWN");
if ($success) {
$code=$before.$arg."->{PT_THREAD_STATE} = 0; PT_WAIT_THREAD($arg);".$after;
next;
}
($success,$before,$arg,$after) = PT_NEXTCOMMAND($code,"PT_EXIT");
if ($success) {
$code=$before.$thread."->{PT_THREAD_STATE} = 0; ".$thread."->{PT_THREAD_RETURN} = $arg; return PT_EXITED;".$after;
next;
}
if ($code =~ /PT_EXIT(\s*;|\s+)/s) {
$code = $`.$thread."->{PT_THREAD_STATE} = 0; delete ".$thread."->{PT_THREAD_RETURN}; return PT_EXITED".$1.$';
next;
}
if ($code =~ /PT_RESTART(\s*;|\s)/s) {
$code = $`.$thread."->{PT_THREAD_STATE} = 0; return PT_WAITING;".$1.$';
next;
}
if ($code =~ /PT_END\s*;/s) {
$code = $`.$thread."->{PT_THREAD_STATE} = 0; delete ".$thread."->{PT_THREAD_RETURN}; return PT_ENDED; }; die \$\@ if \$\@; return \$PT_THREAD_STATE;".$';
}
last;
$code = $beforeblock.$block.$afterblock;
} else {
die "PT_END expected"
}
next;
}