LMCE/MisterHouse Perl Glue

[Matthew]

This topic is the continuation of the "Re: LinuxMCE and Misterhouse topic started in the Users forum.

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"
                #############################################################


[Matthew]

Have tested the code. Got this error:

Error in user code file /opt/misterhouse/data/mh_temp.user_code

  12/26/07 04:46:52 PM: Global symbol "%motionLocation2DeviceId" requires explicit package name at (eval 538) line 291.
BEGIN not safe after errors--compilation aborted at (eval 538) line 1134.
Line 286:  {
Line 287:          $Hall_Motion => '183',
Line 288:          $Landing_Motion => '184',
Line 289:          $Kitchen_Motion => '185'
Line 290:  };
Line 291:  my(@motionLocations) = keys(motionLocation2DeviceId);
Line 292:  my $light_states = 'on,brighten,dim,off';
Line 293:  my $state;
Line 294:  $timer_kitchen_movement = new Timer();
Line 295:  my $Kitchen_Motion_state;
Line 296:  my $Kitchen_Motion_state_now;

That's a typo on my part. Line 291 should be

Code: [Select]

my(@motionLocations) = keys(%motionLocation2DeviceId);


It might be an idea to install MH. It's all contained within a folder - no real install as such apart from the init script, so it's very quick to get running and non-invasive.

btw did you incorporate my last set of changes into the code?

I didn't include those last changes you mentioned, because I don't want to code to a moving target. Once the original code you posted is correctly converted to something maintainable, I can help upgrade it to include the new functionality. But I don't know if I'll be installing MH, because I want to use LMCE to do what MH does. However, I don't mind helping with Perl, especially as it's illustrating how MH does things, which could help illustrate how LMCE could do the same things, especially in Perl. But there is a possiblity, especially if MH is able to include other HW/systems/functions that aren't already in LMCE 0710+ (or easily added).

Merry Christmas by the way!

You too. I'm in Europe myself at the moment, so even less likely to install MH, or do much else unless some random chance pops up, until sometime in the first week of January.

[chrisbirkinshaw]

Ok, now getting:

  12/31/07 03:42:44 PM: Missing $ on loop variable at (eval 538) line 2669.
Line 2664:                  }
Line 2665:          } # Process message.
Line 2666:  }
Line 2667: 
Line 2668: 
Line 2669:  foreach my($motionLocation) (@motionLocations)
Line 2670:  {
Line 2671:          if($state = state_now($motionLocation)
Line 2672:          {
Line 2673:                  lmce_motion($motionStates{$state}, $motionLocation);
Line 2674:          }

[Matthew]

Ok, now getting:

  12/31/07 03:42:44 PM: Missing $ on loop variable at (eval 538) line 2669.
Line 2664:                  }
Line 2665:          } # Process message.
Line 2666:  }
Line 2667: 
Line 2668: 
Line 2669:  foreach my($motionLocation) (@motionLocations)
Line 2670:  {
Line 2671:          if($state = state_now($motionLocation)
Line 2672:          {
Line 2673:                  lmce_motion($motionStates{$state}, $motionLocation);
Line 2674:          }

There's clearly a close-paren missing from line 2671, which should be:

Code: [Select]

          if($state = state_now($motionLocation))

What's weird is that the code compiled for me without complaint, so there's probably an extra/missing paren later in the code, too. Also, if the code doesn't work even with that fixed line 2671, you can try to replace line 2669 with two lines:

Code: [Select]

  my($motionLocation);
  foreach $motionLocation (@motionLocations)

I'm back at my desk, so if we can flip this code back and forth a lot in the next day or so, we can put it to bed. This way of collaborating is too much trouble to keep it up much longer .

[bulek]

Hi,

just curious if anyone else is still working in Perl and LMCE ?

I'm back to this matter after a longer time....

Do we have last version of working code ?

Regards,

Bulek.

[tschak909]

I have no idea...although honestly, I find the whole idea of gluing on MisterHouse with duct tape retarded, extremely foolish, and stupid.

Why waste time doing this? Seriously? just burn the damn code. MH is a piece of shit.

-Thom

[bulek]

I have no idea...although honestly, I find the whole idea of gluing on MisterHouse with duct tape retarded, extremely foolish, and stupid.

Why waste time doing this? Seriously? just burn the damn code. MH is a piece of shit.

-Thom

Hi,

I have a different opinion - have you ever used Misterhouse ? Average Perl beginner can start contributing code. I agree it's not top of the cream but it has a fairly easy way to customize things. My intention is not to wake up Misterhouse, but PERL contributors (if you read my article I'm calling Perl and LMCE users) to maybe produce Perl connector to LMCE...

Regards,

bulek.
 

[chrisbirkinshaw]

There's no way to do this in LMCE at the moment:

1. When motion detected start a timer and turn the light on
2. When motion detected reset the timer
3. When timer expires turn off the light

Also Misterhouse provides a driver for the MR26A X10 RF receiver.

I was going to try and write this functionality in Ruby for LMCE but I have no idea where to start as I missed the GSD screencasts.

Regards,

Chris

[tschak909]

Look at the DCE command "Delay" which is part of the DCE Router.

-Thom

[bulek]

There's no way to do this in LMCE at the moment:

1. When motion detected start a timer and turn the light on
2. When motion detected reset the timer
3. When timer expires turn off the light

Also Misterhouse provides a driver for the MR26A X10 RF receiver.

I was going to try and write this functionality in Ruby for LMCE but I have no idea where to start as I missed the GSD screencasts.

Regards,

Chris

Hi,

here is a brief list ot of my memory to get you started :

- you need to start Ruby script that will register with LMCE via 2 sockets (one for sending and another for receiving):
http://wiki.linuxmce.org/index.php/Plain_Text_DCE_Messages.

Maybe you can just start ruby outside of LMCE for now. Try and learn

- then you can register message interceptor for data you would like to intercept
- then write code that will act upon...

Misterhouse would be a good start, but you mention Ruby...

I missed that first developer's session where something quite similar was demonstrated. Has anyone some more info from that first session ?

HTH,

regards,

Bulek.

[chrisbirkinshaw]

Having a ruby script outside of LMCE is no better than having a perl script outside of LMCE (i.e. Misterhouse). I want to fully integrate the automatic lighting driver as a GSD. Am I on the right track here?

Thom: from what I understand the delay command does not solve the problem, as there is no way to reset it once started. This means that my lights will turn off after a set time even if movement is still registered. They will then turn back on almost straight away, and this cycle will repeat, which would be annoying.

Regards,

Chris