Show Posts
16
Developers / LMCE/MisterHouse Perl Glue
« on: December 26, 2007, 08:47:38 pm »
This topic is the continuation of the "Re: LinuxMCE and Misterhouse topic started in the Users forum.
The current Perl code being debugged:
Here's some new reported functionality, and an upgrade to the original code (not the revised code version in this message) that needs to be added to the current code revision:
The current Perl code being debugged:
Code: [Select]
# Category=Pluto
#
#@ Connection with Pluto DCE Router via TCP port localhost:3450 (mh.ini -> pluto_DCE_router).
# strict Perl syntax
use strict;
# Use timer.
$restartTimer = new Timer;
if($Startup)
{
print_log "Starting connection to LMCE";
set $restartTimer 10, sub {connect_lmce;};
}
if
(
inactive_now($pluto_device_event_receiver) ||
inactive_now($pluto_device_command_sender)
)
{
print_log "Connection to LMCE terminated, restarting";
set $restartTimer 10, sub {connect_lmce;};
}
# Should parenthesize &&/|| expressions to make precedence explicit
if(new_minute 1 && !active $pluto_device_event_receiver || new_minute 1 && !active $pluto_device_command_sender)
{
print_log "Connection to LMCE still terminated, restarting";
connect_lmce();
}
#my $motion=0;
if(my($msg) = said($pluto_device_event_receiver))
{ # Process message.
print_log "Pluto Device Message received: $msg\n";
# Remove quotes before splitting on whitespace.
$msg =~ s/[\"\']//g;
#############################################################
# message Parameters as ordered fields
#############################################################
# $1 $2 $3 $4 $5 $6 $7 $8
# from to msgtype msgid p1id p1val p2id p2val
#############################################################
# Example command from orbiter
# 69 206 1 192 97 "" 98 ""
# 69 206 1 193 97 ""
# 69 205 1 184 76 "100"
# Example command from admin site
# 0 204 1 760 10 "C2" 154 "192"
# 0 204 1 760 10 "C2" 154 "193"
#############################################################
# Decode message into required and optional fields as validation.
my
(
$reqFieldsPat = '(\w+)\s+(\w+)\s+(\w+)\s+(\w+)\s+(\w+)\s+(\w+)';
$optFieldsPat = '\s*(\w*)\s*(\w*)';
);
if
(
my
(
# required fields
$deviceFrom, $deviceTo, $msgType, $msgId,
$param1Id, $param1Value,
# optional fields
$param2Id, $param2Value
)
= ($msg =~ /$reqFieldsPat$optFieldsPat/)
)
{ # Process valid message.
%msgTypes =
{
'1' => 'Command',
'2' => 'Event'
};
$msgType .=
': ' . defined($msgTypes{$msgType})?
$msgTypes{$msgType} : 'unknown type';
# Log required fields.
print_log <<EOT;
DeviceFrom: $deviceFrom
DeviceTo: $deviceTo
MsgType: $msgType
MsgId: $msgId
param1id: $param1Id
param2value: $param1Val
EOT
# Log optional fields.
if(defined($param2Id))
{
print_log "param2id: $$param2Id";
print_log 'param2value: ' .
(defined($param2Val))? $param2Val : 'undefined';
}
# Use X10 ID as target.
my($target);
my $x10_id;
%dev2x10 =
{ # device ID to X10 ID
'162' => 'A5',
'186' => 'A3',
'187' => 'B1',
'188' => 'A8',
'189' => 'B3',
'190' => 'B4',
'191' => 'A10',
'192' => 'A9',
'218' => 'A6'
}; # dev2x10
$x10_id = $dev2x10{$deviceTo};
if(defined($x10_id))
{
$target = new X10_Item($x10_id);
}
# Probably can convert arbitrary msgID / setting rules
# to %msg2Setting if they're exclusive and regular.
if($msgId eq '760' )
{ # new item in param1
$target = new X10_Item($param1Val);
}
# Execute message on target.
if($msgId eq '192' || $param2Val eq '192')
{ # ON
print_log "Turn device $x10_id ON";
set $target ON;
}
if($msgId eq '193' || $param2Val eq '193')
{ # OFF
print_log "Turn device $x10_id OFF";
set $target OFF;
}
if($msgId eq '184')
{ # in param1
print_log "Setting device $x10_id to $param1Val%";
set $target "$param1Val%";
}
} # Process message.
}
my(%motionStates) =
{
'MOTION' => '0',
'STILL' => '1'
};
my(%motionLocation2DeviceId) =
{
$Hall_Motion => '183',
$Landing_Motion => '184',
$Kitchen_Motion => '185'
};
my(@motionLocations) = keys(motionLocation2DeviceId);
foreach my($motionLocation) (@motionLocations)
{
if($state = state_now($motionLocation)
{
lmce_motion($motionStates{$state}, $motionLocation);
}
}
# subs ########################################################################
sub connect_lmce
{
print_log "Configuring sockets";
$pluto_device_event_receiver =
new Socket_Item(undef, undef, '192.168.1.1:3450','device_event_receiver','tcp','record');
$pluto_device_command_sender =
new Socket_Item(undef, undef, '192.168.1.1:3450','device_command_sender','tcp','record');
print_log "Closing sockets if any left open";
if(active_now($pluto_device_event_receiver))
{
stop($pluto_device_event_receiver);
}
if(active_now($pluto_device_command_sender))
{
stop($pluto_device_command_sender);
}
print_log "Open and setup new sockets";
start($pluto_device_event_receiver);
set $pluto_device_event_receiver "COMMAND 179";
start($pluto_device_command_sender);
set $pluto_device_command_sender "EVENT 179";
set $pluto_device_command_sender "PLAIN_TEXT";
}
sub send_pluto_message
{
my($message) = @_;
set $pluto_device_command_sender "MESSAGET " . length($message);
set $pluto_device_command_sender $message;
}
sub update_temp
{
my($sensor, $temp) = @_;
# Example message@
# 167=temp sensor ID, 2=event, 25=event ID (temp changed), 30=value, temperature (string)
# my($message) = "167 -1000 2 25 30 $random_number.2";
# Map iButtons to lmce device numbers.
my(%sensorId2LMCEDeviceId) =
{
0 => 166,
1 => 167
}
my($lmce_device) = $sensorId2LMCEDeviceId{$sensor};
my($message) = "$lmce_device -1000 2 25 30 $temp.2";
send_pluto_message($message);
print_log "Updating sensor $lmce_device $temp";
}
sub lmce_motion
{
my($motionState, $device_id) = @_;
# 6780=Detector ID, 2=event, 9=event ID (tripped), 25=tripped value, 1=value (tripped 0=OFF || 1=ON)
my($message) = "$device_id -1000 2 9 25 $motionState";
send_pluto_message($message);
}
Here's some new reported functionality, and an upgrade to the original code (not the revised code version in this message) that needs to be added to the current code revision:
By the way, I've now seen an even shorter message from the DCERouter to switch a light off:
69 218 1 193
This means we now have 3 ways the DCERouter may ask us to switch off a light:
69 218 1 193
69 218 1 193 97 ""
0 204 1 760 10 "C2" 154 "193"
God knows why!
Changes to code:Code: [Select]if ($msg =~/(\w*)\s(\w*)\s(\w*)\s(\w*)\s(\w*)\s(\w*)\s(\w*)\s(\w*)/ or $msg =~/(\w*)\s(\w*)\s(\w*)\s(\w*)\s(\w*)\s(\w*)/
or $msg =~/(\w*)\s(\w*)\s(\w*)\s(\w*)/ ) {
print_log "DeviceFrom: $1";
print_log "DeviceTo: $2";
print_log "MsgType: $3 (1=Command, 2=Event)";
print_log "MsgId: $4";
if (defined $5) { print_log "param1id: $5";}
if (defined $6) { print_log "param2value: $6";}
if (defined $7) { print_log "param2id: $7";}
if (defined $8) { print_log "param2value: $8";}
#############################################################
# $1 $2 $3 $4 $5 $6 $7 $8
# from to msgtype msgid p1id p1val p2id p2val
# Example command from orbiter
# 69 206 1 192 97 "" 98 ""
# 69 206 1 193 97 ""
# 69 205 1 184 76 "100"
# 69 218 1 193
# Example command from admin site
# 0 204 1 760 10 "C2" 154 "192"
# 0 204 1 760 10 "C2" 154 "193"
#############################################################
into volunteering to help produce new language bindings for LMCE scripting in addition to existing Ruby support: