Perl for Domoticz

From Domoticz
Jump to: navigation, search

Introduction

Perl may or may not be natively installed in the Raspberry image from Domoticz, but it can be easily and quite extensively used with domoticz.

Please remember that unix scripts need execution rights (chmod +x) and read rights and that line-endings should be UNIX-friendly (<LF> only).

Please also remember that a script mentions the interpreter path on the very first line of the file. For Perl : #!/usr/bin/perl

Accessing device statuses in Domoticz

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;