############################################## # $Id$ # # based / modified Version 98_EGPMS2LAN from ericl # # (c) 2013, 2014 Copyright: Alex Storny (moselking at arcor dot de) # All rights reserved # # This script free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # The GNU General Public License can be found at # http://www.gnu.org/copyleft/gpl.html. # # This script is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # ################################################################ # -> Module 70_EGPM.pm (for a single Socket) needed. ################################################################ package main; use strict; use warnings; use HttpUtils; sub EGPM2LAN_Initialize($) { my ($hash) = @_; $hash->{Clients} = ":EGPM:"; $hash->{GetFn} = "EGPM2LAN_Get"; $hash->{SetFn} = "EGPM2LAN_Set"; $hash->{DefFn} = "EGPM2LAN_Define"; $hash->{AttrList} = "loglevel:0,1,2,3,4,5,6 stateDisplay:sockNumber,sockName autocreate:on,off"; } ################################### sub EGPM2LAN_Get($@) { my ($hash, @a) = @_; my $what; return "argument is missing" if(int(@a) != 2); $what = $a[1]; if($what =~ /^(state|lastcommand)$/) { if(defined($hash->{READINGS}{$what})) { return $hash->{READINGS}{$what}{VAL}; } else { return "reading not found: $what"; } } else { return "Unknown argument $what, choose one of state:noArg lastcommand:noArg".(exists($hash->{READINGS}{output})?" output:noArg":""); } } ################################### sub EGPM2LAN_Set($@) { my ($hash, @a) = @_; return "no set value specified" if(int(@a) < 2); return "Unknown argument $a[1], choose one of on:1,2,3,4,all off:1,2,3,4,all toggle:1,2,3,4 clearreadings:noArg statusrequest:noArg" if($a[1] eq "?"); my $name = shift @a; my $setcommand = shift @a; my $params = join(" ", @a); my $logLevel = GetLogLevel($name,4); Log $logLevel, "EGPM2LAN set $name (". $hash->{IP}. ") $setcommand $params"; EGPM2LAN_Login($hash, $logLevel); if($setcommand eq "on" || $setcommand eq "off") { if($params eq "all") { #switch all Sockets; thanks to eric! for (my $count = 1; $count <= 4; $count++) { EGPM2LAN_Switch($hash, $setcommand, $count, $logLevel); } } else { #switch single Socket EGPM2LAN_Switch($hash, $setcommand, $params, $logLevel); } EGPM2LAN_Statusrequest($hash, $logLevel, 1); } elsif($setcommand eq "toggle") { my $currentstate = EGPM2LAN_Statusrequest($hash, $logLevel, 1); if(defined($currentstate)) { my @powerstates = split(",", $currentstate); my $newcommand="off"; if($powerstates[$params-1] eq "0") { $newcommand="on"; } EGPM2LAN_Switch($hash, $newcommand, $params, $logLevel); EGPM2LAN_Statusrequest($hash, $logLevel, 0); } } elsif($setcommand eq "statusrequest") { EGPM2LAN_Statusrequest($hash, $logLevel, 1); } elsif($setcommand eq "clearreadings") { delete $hash->{READINGS}; } else { return "unknown argument $setcommand, choose one of on, off, toggle, statusrequest, clearreadings"; } EGPM2LAN_Logoff($hash, $logLevel); $hash->{CHANGED}[0] = $setcommand; $hash->{READINGS}{lastcommand}{TIME} = TimeNow(); $hash->{READINGS}{lastcommand}{VAL} = $setcommand." ".$params; return undef; } ################################ sub EGPM2LAN_Switch($$$$) { my ($hash, $state, $port, $logLevel) = @_; $state = ($state eq "on" ? "1" : "0"); my $fritz = 0; #may be important for FritzBox-users my $data = "cte1=" . ($port == "1" ? $state : "") . "&cte2=" . ($port == "2" ? $state : "") . "&cte3=" . ($port == "3" ? $state : "") . "&cte4=". ($port == "4" ? $state : ""); Log $logLevel, "EGPM2LAN $data"; eval { CustomGetFileFromURL($hash ,"http://".$hash->{IP}."/",10 ,$data ,$fritz ,$logLevel); }; if ($@){ ### catch block Log $logLevel, "EGPM2LAN error: $@"; }; return 1; } ################################ sub EGPM2LAN_Login($$) { my ($hash, $logLevel) = @_; Log $logLevel,"EGPM2LAN try to Login @".$hash->{IP}; eval{ CustomGetFileFromURL($hash, "http://".$hash->{IP}."/login.html", 10, "pw=" . (defined($hash->{PASSWORD}) ? $hash->{PASSWORD} : ""), 0, $logLevel); }; if ($@){ ### catch block Log 1, "EGPM2LAN Login error: $@"; return 0; }; Log $logLevel,"EGPM2LAN Login successful!"; return 1; } ################################ sub EGPM2LAN_GetDeviceInfo($$) { my ($hash, $input) = @_; my $logLevel = GetLogLevel($hash->{NAME},4); #try to read Device Name my ($devicename) = $input =~ m/

(.+)<\/h2><\/div>/si; $hash->{DEVICENAME} = trim($devicename); #try to read Socket Names my @socketlist; while ($input =~ m/

(.+?)<\/h2>/gi) { my $socketname = trim($1); $socketname =~ s/ /_/g; #remove spaces push(@socketlist, $socketname); } #check 4 dublicate Names my %seen; foreach my $entry (@socketlist) { next unless $seen{$entry}++; Log $logLevel, "EGPM2LAN Sorry! Can't use devicenames. ".trim($entry)." is duplicated."; @socketlist = qw(Socket_1 Socket_2 Socket_3 Socket_4); } if(int(@socketlist) < 4) { @socketlist = qw(Socket_1 Socket_2 Socket_3 Socket_4); } return @socketlist; } ################################ sub EGPM2LAN_Statusrequest($$$) { my ($hash, $logLevel, $autoCr) = @_; my $name = $hash->{NAME}; my $response = CustomGetFileFromURL($hash, "http://".$hash->{IP}."/", 10, "", 0, $logLevel); #Log 1,$response; if(defined($response) && $response =~ /.,.,.,./) { my $powerstatestring = $&; Log $logLevel, "EGPM2LAN Powerstate: " . $powerstatestring; my @powerstates = split(",", $powerstatestring); if(int(@powerstates) == 4) { my $index; my $newstatestring; my @socketlist = EGPM2LAN_GetDeviceInfo($hash,$response); readingsBeginUpdate($hash); foreach my $powerstate (@powerstates) { $index++; if(length(trim($socketlist[$index-1]))==0) { $socketlist[$index-1]="Socket_".$index; } if(AttrVal($name, "stateDisplay", "sockNumber") eq "sockName") { $newstatestring .= $socketlist[$index-1].": ".($powerstates[$index-1] ? "on" : "off")." "; } else { $newstatestring .= $index.": ".($powerstates[$index-1] ? "on" : "off")." "; } #Create Socket-Object if not available my $defptr = $modules{EGPM}{defptr}{$name.$index}; if($autoCr && AttrVal($name, "autocreate", "on") eq "on" && not defined($defptr)) { if(Value("autocreate") eq "active") { Log $logLevel, "EGPM2LAN: Autocreate EGPM for Socket $index"; CommandDefine(undef, $name."_".$socketlist[$index-1]." EGPM $name $index"); } else { Log 2, "EGPM2LAN: Autocreate disabled in globals section"; $attr{$name}{autocreate} = "off"; } } #Write state 2 related Socket-Object if (defined($defptr)) { if (ReadingsVal($defptr->{NAME},"state","") ne ($powerstates[$index-1] ? "on" : "off")) { #check for chages and update -> trigger event Log $logLevel, "Update State of ".$defptr->{NAME}; readingsSingleUpdate($defptr, "state", ($powerstates[$index-1] ? "on" : "off") ,1); } $defptr->{DEVICENAME} = $hash->{DEVICENAME}; $defptr->{SOCKETNAME} = $socketlist[$index-1]; } readingsBulkUpdate($hash, $index."_".$socketlist[$index-1], ($powerstates[$index-1] ? "on" : "off")); } readingsBulkUpdate($hash, "state", $newstatestring); readingsEndUpdate($hash, 0); #everything is fine return $powerstatestring; } else { Log $logLevel, "EGPM2LAN: Failed to parse powerstate"; } } else { $hash->{STATE} = "Login failed"; Log $logLevel, "EGPM2LAN: Login failed"; } #something went wrong :-( return undef; } sub EGPM2LAN_Logoff($$) { my ($hash, $logLevel) = @_; #$quiet, $url, $timeout, $data, $noshutdown, $loglevel CustomGetFileFromURL($hash, "http://".$hash->{IP}."/login.html", 10, "", 0, $logLevel); return 1; } sub EGPM2LAN_Define($$) { my ($hash, $def) = @_; my @a = split("[ \t][ \t]*", $def); my $u = "wrong syntax: define EGPM2LAN IP Password"; return $u if(int(@a) < 2); $hash->{IP} = $a[2]; if(int(@a) == 4) { $hash->{PASSWORD} = $a[3]; } else { $hash->{PASSWORD} = ""; } my $result = EGPM2LAN_Login($hash, 3); if($result == 1) { $hash->{STATE} = "initialized"; EGPM2LAN_Statusrequest($hash, 4, 0); EGPM2LAN_Logoff($hash, 4); } return undef; } 1; =pod =begin html

EGPM2LAN

=end html =begin html_DE

EGPM2LAN

=end html_DE =cut