Perl for Domoticz

From Domoticz
Jump to navigation Jump to search

Introduction

Perl may not be natively installed in the Domoticz binary, but it can be easily and extensively used with Domoticz if installed separately on your system. Please remember that on Linux, any scripts need execution rights (chmod +x) and read rights and that line-endings should be UNIX-friendly (<LF> only). Please also remember that any script should specify the correct interpreter path on the very first line of the file (shebang line). For Perl : 

#!/usr/bin/perl

You can run a perl script from the 'On Action:' or 'Off Action:' parameter of a switch. As an example: 

script://coolscript.pl 0

where 'coolscript.pl' is a perl file in the '/home/pi/domoticz/scripts' folder and the '0' (or whatever) is an example parameter that the perl script will access via its @ARGV array.

Be aware, however, that Domoticz will wait for this script to finish executing before it continues. This means that if there are any long loops with e.g. sleep statements in the perl script then your Domoticz event queue will be severely delayed. A simple way to get around this is to wrap the call to the perl script inside a bash script that uses the '&' notation to spawn off a subprocess to run the perl and return immediately.

In your scripts directory, create a file called 'exec.sh' with the following content: 

#! /bin/sh
/usr/bin/perl /home/pi/domoticz/scripts/$1.pl $2 $3 > /dev/null 2>&1 &

You can now use the following syntax to call up the actual perl script as follows: 

script://exec.sh coolscript 0

This way, control is immediately returned to Domoticz while your perl script runs in the background. It can still interact with Domoticz using JSON calls as per usual, it's just running quietly.

Accessing device statuses in Domoticz

The essence of interacting with Domoticz from a perl script is by using the JSON-call possibilities (which are documented here: [[JSON]https://www.domoticz.com/wiki/Domoticz_API/JSON_URL's]. You can make these calls from perl via e.g. the CPAN modules 'LWP::UserAgent' and 'JSON::RPC::Client', while modules such as 'JSON::XS' make decoding the returned JSON easy. Here's an example of switching a light on or off from perl: 

#!/usr/bin/perl

no warnings 'uninitialized';
use LWP::UserAgent;

$url{domo} ='http://192.168.1.12:8080';

$idx =301;
$cmd ='On'; # or 'Off'

$switch_url = $url{domo}.'/json.htm?type=command&param=switchlight&idx='.$idx.'&switchcmd='.$cmd;
$ua=LWP::UserAgent->new; $ua->timeout(5); $res=$ua->put($switch_url);
unless ($res->is_success) { warn $res->status_line };

or to retrieve the status of a switch from perl: 

#!/usr/bin/perl

no warnings 'uninitialized';
use LWP::UserAgent;
use JSON::XS;

$url{domo} = 'http://192.168.1.12:8080';

$idx = 301;

$ua = LWP::UserAgent->new; $ua->timeout(5);
$retrieve = $ua->get($url{domo}.'/json.htm?type=devices&rid='.$idx);
$res = $retrieve->decoded_content;
if ($retrieve->is_success) { $jres = JSON::XS->new->allow_nonref->decode($res)  } else { warn $retrieve->status_line };
$state = $$jres{result}[0]->{Status}; # 'On', 'Off', 'Open', 'Closed', etc

An example of using JSON::RPC::Client is provided here [[LMS] https://www.domoticz.com/wiki/Logitech_Media_Server#Audio_Alerts_via_Squeezebox_Players]

Further examples

This script is the basis of interacting with Domoticz, because good practice dictates that you should test current device status before performing an action (no need to change the state to something it's already at). All the scripts below will rely on this building block.

Prerequisite

sudo apt-get install libjson-perl libdatetime-perl libwww-perl

Script example

liststatuses.pl 

 #!/usr/bin/perl
 use v5.14;
 use LWP::Simple;                # From CPAN
 use JSON qw( decode_json );     # From CPAN
 use Data::Dumper;               # Perl core module
 use strict;                     # Good practice
 use warnings;                   # Good practice
 use utf8;
 use feature     qw< unicode_strings >;
 my $IP="192.168.0.24";
 my $PORT="8080";   
 my $trendsurl = "http://$IP:$PORT/json.htm?type=devices&filter=all&used=true&order=Name"; 
 my $json = get( $trendsurl ); 
 die "Could not get $trendsurl!" unless defined $json;   
 # Decode the entire JSON 
 my $decoded = JSON->new->utf8(0)->decode( $json );
 # you'll get this (it'll print out); comment this when done.
 #print Dumper $decoded_json;
 my @results = @{ $decoded->{'result'} };
 foreach my $f ( @results ) {
   if ($f->{"SwitchType"}) {
         print $f->{"idx"} . " " . $f->{"Name"} . " " . $f->{"Status"} . "\n";
   } elsif ($f->{"Type"} eq "Group") {
        print $f->{"idx"} . " " . $f->{"Name"} . " " . $f->{"Status"} . "\n";
   } else {
         print $f->{"idx"} . " " . $f->{"Name"} . " " . $f->{"Data"} . "\n";
   }
 }

Ping several machines

I started pinging machines from LUA but it quickly appeared that it made shift the clock for time scripts in LUA because of ping timeout wait if a device was absent. Thus I removed the scripts and added a perl script run from crontab that achieves the same and keeps the LUA script time working seamlessly...

Please remember to configure the couple (idx,IP) where idx is the device number of the virtual/dummy light-switch associated.

Prerequisite

sudo apt-get install libjson-perl libdatetime-perl libwww-perl

Proposed Crontab entry

I propose to run it every 2 minutes 

*/2 * * * * /home/pi/ping_by_ip.pl 2>&1 >> /dev/null

Script example

ping_by_ip.pl 

 #!/usr/bin/perl
 use v5.14;
 use LWP::Simple;                # From CPAN
 use JSON qw( decode_json );     # From CPAN
 use Data::Dumper;               # Perl core module
 use strict;                     # Good practice
 use warnings;                   # Good practice
 use utf8;    
 use feature     qw< unicode_strings >;
 #Change settings below to your server
 my $IP="192.168.0.24";
 my $PORT="8080";
 # PUT your devices here such as it shows their idx (swichlight) and IP
 my %IP=(39=>'192.168.0.23',
        40=>'192.168.0.22',
        10=>'192.168.0.25'); 
 my $trendsurl = "http://$IP:$PORT/json.htm?type=devices&filter=all&used=true&order=Name";
 my $json = get( $trendsurl );
 die "Could not get $trendsurl!" unless defined $json;
 # Decode the entire JSON
 my $decoded = JSON->new->utf8(0)->decode( $json );
 my @results = @{ $decoded->{'result'} };
 my @tab;
 foreach my $f ( @results ) {
  if ($f->{"SwitchType"}) {
        $tab[$f->{"idx"}]=$f->{"Status"};
  }
 }       
 foreach my $k (keys %IP) {
        my $ip=$IP{$k};
        my $res=system("sudo ping $ip -w 3 2>&1 > /dev/null"); 
  #print "-->".$k." ".$res." ".$tab[$k]."\n";      
        if (($res==0)&&($tab[$k] eq 'Off')) {
                print "$k is On\n";
                `curl -s "http://192.168.0.24:8080/json.htm?type=command&param=switchlight&idx=$k&switchcmd=On"`; 
        } elsif (($res!=0)&&($tab[$k] eq 'On')) {
                print "$k is Off\n";
                `curl -s "http://192.168.0.24:8080/json.htm?type=command&param=switchlight&idx=$k&switchcmd=Off"`; 
        } else {
                print "do nothing: $k is ".$tab[$k]."\n";
        }
 }

Accessing sqlite3

Prerequisite

sudo apt-get install libdbd-sqlite3-perl libdbi-perl sqlite3

Script example

use DBI;
my $dbh = DBI->connect(          
   "dbi:SQLite:dbname=domoticz.db", 
   "",                          
   "",                          
   { RaiseError => 1 },         
) or die $DBI::errstr;
my $sth = $dbh->prepare( "SELECT * FROM DeviceStatus LIMIT 5" );  
$sth->execute();
     
my $row;
while($row = $sth->fetchrow_hashref()) {
   print "$row->{Id} $row->{HardwareId} $row->{Name}\n";
}
#$stmt = qq(INSERT INTO COMPANY (ID,NAME,AGE,ADDRESS,SALARY)
#      VALUES (3, 'Teddy', 23, 'Norway', 20000.00 ));
#$rv = $dbh->do($stmt) or die $DBI::errstr;
$sth->finish();
$dbh->disconnect();

Pachube / Cosm / Xively

Posting data to Xively can be interesting in the IoT (Internet of Things) approach, and maybe you are already doing so for some devices.

Here is a simple way that extracts all sensor values, simple or multiple, makes a bundle and senda it to Xively to create/update Channels of an existing device.

To achieve this we had to remove spaces and reserved chars, but we can post the unit type this way !

Prerequisite

sudo apt-get install libjson-perl libfile-slurp-unicode-perl libwww-perl libxml-simple-perl

Proposed Crontab entry

I propose to run it every 10 minutes 

*/10 * * * * /home/pi/cosmodom.pl 2>&1 >> /dev/null


Script example

cosmodom.pl 

 #!/usr/bin/perl
 use v5.14;
 use LWP::Simple;                # From CPAN
 use JSON ;    # From CPAN
 use File::Slurp;
 use LWP::UserAgent;
 use Crypt::SSLeay;
 use Data::Dumper;               # Perl core module
 use strict;                     # Good practice
 use warnings;                   # Good practice
 use utf8;
 use feature     qw< unicode_strings >;
 my $COSM_API_KEY = '7W0cxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx5lyS';
 my $COSM_FEED = "xxxxxx";
 my $IP=''192.168.0.24";
 my $PORT="8080";
 my $feed = { 'version' => '1.0.0', 'datastreams' => [] }; 
 # Create an HTTP client
 my $ua = LWP::UserAgent->new;
 $ua->agent('RaspberryPiDomoticz/1.0 ');
 my $trendsurl = "http://$IP:$PORT/json.htm?type=devices&filter=all&used=true&order=Name";
 my $json = get( $trendsurl );
 die "Could not get $trendsurl!" unless defined $json;
 # Decode the entire JSON
 my $decoded = JSON->new->utf8(0)->decode( $json ); 
 my @results = @{ $decoded->{'result'} };
 foreach my $f ( @results ) {
   if ($f->{"SwitchType"}) {
         #print $f->{"idx"} . " " . $f->{"Name"} . " " . $f->{"Status"} . "\n";
  } elsif ($f->{"Type"} eq "Group") {
        #print $f->{"idx"} . " " . $f->{"Name"} . " " . $f->{"Status"} . "\n";
  } else {
        my $te=$f->{"Data"};
        my $name=$f->{"Name"};
        next if $te=~/;/;
        #next if $f->{"idx"}==3;
        my @tab=split(/,/,$te);
        foreach my $tem (@tab) {
                my ($temp,$unit)=($tem=~/(\d*.?\d*)(.*)/);
                $unit=~s/\s*//;
                $temp=~s/\s*//;
                my $nam;
                if ($te=~/,/) { $nam=$name.'_'.$unit; } else {$nam=$name;}
                $nam=~s/\s/_/;
                $nam=~s/\//_/;
                $nam=~s/%/P/;
                print "$nam/$temp/$unit\n";
                push(@{$feed->{'datastreams'}}, {'id' => $nam, 'current_value' => scalar($temp), 'units' => $unit});
        }
  }
 }
 # Create a HTTP request
 my $req = HTTP::Request->new(PUT => "https://api.xively.com/v2/feeds/$COSM_FEED");
 $req->header('X-ApiKey' => $COSM_API_KEY);
 $req->content_type('application/json');
 $req->content(encode_json($feed));
 # Make the request
 my $res = $ua->request($req);
 unless ($res->is_success) {
                print STDERR $res->status_line, "\n";
                print STDERR $res->content, "\n";
 }

Sen.Se

Using: 

SendToSenSe(25.0000,1234);

GetFromSenSe(1234);

Prerequisite

sudo apt-get install libjson-perl libdatetime-perl libwww-perl

script example

 use LWP::UserAgent;
 use JSON;
 use strict;
 use warnings;
 my $ua = LWP::UserAgent->new;
 my $SENSE_API_KEY = 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX' ;
 sub SendToSenSe {
        # Get parameters
        my $value = $_[0];
        # Remove the newline....
        chomp $value;
        my $feed_id = $_[1];
        chomp $feed_id;
        my %datalist = ('feed_id' =>  $feed_id, 'value'=>  $value );
        my $json = encode_json \%datalist;
        #print $json, "\n";
        # Create a request
        my $req = HTTP::Request->new(POST => "http://api.sen.se/events/?sense_key=".$SENSE_API_KEY);
        $req->content_type('application/json');
        $req->content($json);
        # Pass request to the user agent and get a response back
        my $res = $ua->request($req);
        # Check the outcome of the response
        if ($res->is_success) {
            return $res->content, "\n";
        }
        else {
        return $res->status_line, "\n";
        }
 }
 sub GetFromSenSe {
        my $feed_id = $_[0];
        # Create the request
        my $req = HTTP::Request->new(GET => "http://api.sen.se/feeds/$feed_id/last_event/?sense_key=".$SENSE_API_KEY);
        $req->content_type('application/json');
        #$req->content($json);
        # Pass request to the user agent and get a response back
        my $res = $ua->request($req);
        # Check the outcome of the response
        if ($res->is_success) {
            return $res->content, "\n";
        }
        else {
        return $res->status_line, "\n";
        }
 }

GPIO access

Device::BCM2835

This must be done as root. To change to the root user: 

sudo su -

Supports GPIO and SPI interfaces. You must also get and install the bcm2835 library. Details and downloads from http://www.open.com.au/mikem/bcm2835 You must then get and install the Device::BCM2835 perl library from CPAN http://search.cpan.org/~mikem/Device-BCM2835-1.0/lib/Device/BCM2835.pm 

use Device::BCM2835;
use strict;
# call set_debug(1) to do a non-destructive test on non-RPi hardware
#Device::BCM2835::set_debug(1);
Device::BCM2835::init() 
 || die "Could not init library";
# Blink pin 11:
# Set RPi pin 11 to be an output
Device::BCM2835::gpio_fsel(&Device::BCM2835::RPI_GPIO_P1_11, 
                           &Device::BCM2835::BCM2835_GPIO_FSEL_OUTP);
while (1)
{
   # Turn it on
   Device::BCM2835::gpio_write(&Device::BCM2835::RPI_GPIO_P1_11, 1);
   Device::BCM2835::delay(500); # Milliseconds
   # Turn it off
   Device::BCM2835::gpio_write(&Device::BCM2835::RPI_GPIO_P1_11, 0);
   Device::BCM2835::delay(500); # Milliseconds
}

Wiring a perl script as a watchdog [http://electrorun.blogspot.fr/2013/06/using-gpio-with-raspberry-pi-and-perl.html}

HiPi

To download it (as root): 

wget http://raspberry.znix.com/hipifiles/hipi-install
perl hipi-install

More details here: [1]


Reading serial port - Arduino

Arduino reports to a ttyUSB* or ttyACM* ata 115200 bauds. The below scripts shown a simple way (tested but work in progress) to read and write to USB port.

Prerequisite

sudo apt-get install libdevice-serialport-perl libdatetime-perl

Writing to serial port

Here is a snippet to write to a USB port: 

my $msg = "$name;$value1;4;13;M\n";
my $co = $ob->write($msg);
warn "write failed\n" unless ($co);
print "$date W ($co) : $msg \n";
$ob->write_drain;


Script (Work in progress)

 #!/usr/bin/perl
 use warnings;
 use strict;
 use POSIX qw(strftime);
 use Device::SerialPort;
 use IO::Handle;
 use DateTime;
 use Scalar::Util qw(looks_like_number);
 my $ccnt;
 my $port = '/dev/ttyUSB0';
 my $conf = '~/.conf-pasha';
 my $ob = Device::SerialPort->new($port, 1) || die "Can't open $port: $ +!"; 
 my $STALL_DEFAULT = 10;
 my $timeout = $STALL_DEFAULT;
 my $arb  = $ob->can_arbitrary_baud;
 my $data = $ob->databits(8);
 my $baud = $ob->baudrate(115200);
 my $parity = $ob->parity("none");
 my $hshake = $ob->handshake("rts");
 my $stop = $ob->can_stopbits;
 my $rs = $ob->is_rs232;
 my $total = $ob->can_total_timeout;
 $ob->stopbits(1);
 $ob->buffers( 4096, 4096 );
 $ob->write_settings();
 my ($count, $string, $name, $value);
 $ob->close || warn "close failed";;
 $ob = Device::SerialPort->new($port, 1) || die "Can't open $port: $ +!";
 $ob->databits(8);
 $ob->baudrate(115200);
 $ob->parity("none");
 $ob->stopbits(1);
 $ob->buffers( 4096, 4096 );
 $ob->write_settings();
 my $sleep = 5;
 print ": write_settings() done\n: sleeping $sleep second to let arduino get ready...\n";
 sleep $sleep;
 my @vals;
 open(FIC,">>log-gw.txt")||die $!;
 print FIC "Starting\n";
 FIC->autoflush(1);
 while(1) {
        $ccnt++;
        $ob->lastline("\n");

        ($count, $string) = $ob->read(255);

        #print "$ccnt $string\n\n";
        @vals  = split("\n", $string);
        foreach (@vals) {
                $_=~ s/\t/\=/;
                $_=~ s/\r//;
                $_=~ s/\n//;
        }
        sleep(1);
 }
 close(FIC);
 $ob->write_drain;
 $ob->close;
 undef $ob;
Retrieved from "https://wiki.domoticz.com/index.php?title=Perl_for_Domoticz&oldid=14238"