diff --git a/fhem/FHEM/SubProcess.pm b/fhem/FHEM/SubProcess.pm new file mode 100644 index 000000000..2808caf43 --- /dev/null +++ b/fhem/FHEM/SubProcess.pm @@ -0,0 +1,165 @@ +# $Id$ + +############################################################################## +# +# SubProcess.pm +# Copyright by Dr. Boris Neubert +# e-mail: omega at online dot de +# +# This file is part of fhem. +# +# Fhem is 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 +# (at your option) any later version. +# +# Fhem 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. +# +# You should have received a copy of the GNU General Public License +# along with fhem. If not, see . +# +############################################################################## + +package SubProcess; +use warnings; +use strict; +use POSIX ":sys_wait_h"; +use Socket; +use IO::Handle; + +# creates a new subprocess +sub new() { + my ($class, $args)= @_; + + my ($child, $parent); + socketpair($child, $parent, AF_UNIX, SOCK_STREAM, PF_UNSPEC) || return undef; # die "socketpair: $!"; + $child->autoflush(1); + $parent->autoflush(1); + + my $self= { + + onRun => $args->{onRun}, + onExit => $args->{onExit}, + timeout => $args->{timeout}, + child => $child, + parent => $parent, + + }; # we are a hash reference + + return bless($self, $class); # make $self an object of class $class + +} + +sub pid() { + + my $self= shift; + return $self->{pid}; +} + + +# check if child process is still running +sub running() { + + my $self= shift; + my $pid= $self->{pid}; + + return waitpid($pid, WNOHANG) > 0 ? 1 : 0; +} + +# waits for the child process to terminate +sub wait() { + + my $self= shift; + my $pid= $self->{pid}; + if(defined($pid)) { + main::Log3 $pid, 5, "Waiting for SubProcess $pid..."; + waitpid($pid, 0); + main::Log3 $pid, 5, "SubProcess $pid terminated..."; + } +} + +# +sub signal() { + + my ($self, $signal)= @_; + my $pid= $self->{pid}; + main::Log3 $pid, 5, "Sending signal $signal to SubProcess $pid..."; + return kill $signal, $pid; +} + +# terminates a child process (HUP) +sub terminate() { + + my $self= shift; + return $self->signal('HUP'); +} + +# terminates a child process (KILL) +sub kill() { + + my $self= shift; + return $self->signal('KILL'); +} + +sub child() { + my $self= shift; + return $self->{child}; +} + +sub parent() { + my $self= shift; + return $self->{parent}; +} + +# starts the child process +sub run() { + + my $self= shift; + + my $pid= fork; + if(!defined($pid)) { + main::Log3 undef, 2, "SubProcess: Cannot fork: $!"; + return undef; + } + + $self->{pid}= $pid; + + if(!$pid) { + # CHILD + #close(CHILD); + #main::Debug "PARENT FD= " . fileno $self->{parent}; + + # run + my $onRun= $self->{onRun}; + if(defined($onRun)) { + eval { &$onRun($self) }; + main::Log3 undef, 2, "SubProcess: onRun returned error: $@" if($@); + } + + # exit + my $onExit= $self->{onExit}; + if(defined($onExit)) { + eval { &$onExit($self) }; + main::Log3 undef, 2, "SubProcess: onExit returned error: $@" if($@); + } + + #close(PARENT); + POSIX::_exit(0); + + } else { + # PARENT + #close(PARENT); + #main::Debug "CHILD FD= " . fileno $self->{child}; + + main::Log3 $pid, 5, "SubProcess $pid created."; + + return $pid; + } + +} + + +1; diff --git a/fhem/MAINTAINER.txt b/fhem/MAINTAINER.txt index 874de9359..c4aa1b0a3 100644 --- a/fhem/MAINTAINER.txt +++ b/fhem/MAINTAINER.txt @@ -309,6 +309,7 @@ FHEM/RESIDENTStk.pm loredo http://forum.fhem.de Automatis FHEM/SetExtensions.pm rudolfkoenig http://forum.fhem.de Automatisierung FHEM/SHC_datafields.pm rr2000 http://forum.fhem.de Sonstige Systeme FHEM/SHC_parser.pm rr2000 http://forum.fhem.de Sonstige Systeme +FHEM/SubProcess.pm borisneubert http://forum.fhem.de FHEM Development FHEM/TcpServerUtils.pm rudolfkoenig http://forum.fhem.de Automatisierung FHEM/TimeSeries.pm borisneubert http://forum.fhem.de FHEM Development FHEM/lib/Device/Firmata/* ntruchsess http://forum.fhem.de Sonstige Systeme diff --git a/fhem/contrib/SubProcess/98_SubProcessTester.pm b/fhem/contrib/SubProcess/98_SubProcessTester.pm new file mode 100644 index 000000000..8060d3544 --- /dev/null +++ b/fhem/contrib/SubProcess/98_SubProcessTester.pm @@ -0,0 +1,207 @@ +# $Id: $ +################################################################ +# +# Copyright notice +# +# (c) 2015 Copyright: Dr. Boris Neubert +# e-mail: omega at online dot de +# +# This file is part of fhem. +# +# Fhem is 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 +# (at your option) any later version. +# +# Fhem 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. +# +# You should have received a copy of the GNU General Public License +# along with fhem. If not, see . +# +################################################################################ + +package main; + +use strict; +use warnings; +use SubProcess; + +##################################### +sub +SubProcessTester_Initialize($) { + my ($hash) = @_; + + my %matchlist= ( + "1:SubProcessTesterDevice" => ".*", + ); + +# Provider + $hash->{WriteFn} = "SubProcessTester_Write"; + $hash->{ReadFn} = "SubProcessTester_Read"; + $hash->{Clients} = ":VBox:"; + $hash->{MatchList} = \%matchlist; + #$hash->{ReadyFn} = "SubProcessTester_Ready"; + +# Consumer + $hash->{DefFn} = "SubProcessTester_Define"; + $hash->{UndefFn} = "SubProcessTester_Undef"; + #$hash->{ParseFn} = "SubProcessTeser_Parse"; + $hash->{ShutdownFn} = "SubProcessTester_Shutdown"; + #$hash->{ReadyFn} = "SubProcessTester_Ready"; + #$hash->{GetFn} = "SubProcessTester_Get"; + #$hash->{SetFn} = "SubProcessTester_Set"; + #$hash->{AttrFn} = "SubProcessTester_Attr"; + #$hash->{AttrList}= ""; +} + +##################################### +# +# Functions called from sub process +# +##################################### + +sub onRun($) { + my $subprocess= shift; + my $parent= $subprocess->parent(); + Log3 undef, 1, "RUN RUN RUN RUN..."; + for(my $i= 0; $i< 10; $i++) { + #Log3 undef, 1, "Step $i"; + print $parent "$i\n"; + $parent->flush(); + sleep 5; + } +} + +sub onExit() { + Log3 undef, 1, "EXITED!"; +} + +##################################### +# +# FHEM functions +# +##################################### + +sub SubProcessTester_Define($$) { + + # define mySubProcessTester SubProcessTester configuration + my ($hash, $def) = @_; + my @a = split("[ \t]+", $def); + + if(int(@a) != 2) { + my $msg = "wrong syntax: define SubProcessTester "; + Log3 $hash, 2, $msg; + return $msg; + } + + SubProcessTester_DoInit($hash); + return undef; +} + +sub SubProcessTester_Undef($$) { + my $hash= shift; + SubProcessTester_DoExit($hash); + return undef; +} + +sub SubProcessTester_Shutdown($$) { + my $hash= shift; + SubProcessTester_DoExit($hash); + return undef; +} + +##################################### + +sub SubProcessTester_DoInit($) { + my $hash = shift; + my $name= $hash->{NAME}; + + $hash->{fhem}{subprocess}= undef; + + my $subprocess= SubProcess->new( { onRun => \&onRun, onExit => \&onExit } ); + my $pid= $subprocess->run(); + return unless($pid); + + $hash->{fhem}{subprocess}= $subprocess; + $hash->{FD}= fileno $subprocess->child(); + delete($readyfnlist{"$name.$pid"}); + $selectlist{"$name.$pid"}= $hash; + + $hash->{STATE} = "Initialized"; + + return undef; +} + +sub SubProcessTester_DoExit($) { + my $hash = shift; + + my $name= $hash->{NAME}; + + my $subprocess= $hash->{fhem}{subprocess}; + return unless(defined($subprocess)); + + my $pid= $subprocess->pid(); + return unless($pid); + + $subprocess->terminate(); + $subprocess->wait(); + + delete($selectlist{"$name.$pid"}); + delete $hash->{FD}; + + $hash->{STATE} = "Finalized"; + + return undef; +} + +##################################### +# called from the global loop, when the select for hash->{FD} reports data +sub SubProcessTester_Read($) { + + my ($hash) = @_; + my $name= $hash->{NAME}; + + #Debug "$name has data to read!"; + + my $subprocess= $hash->{fhem}{subprocess}; + + my ($bytes, $result); + $bytes= sysread($subprocess->child(), $result, 1024*1024); + if(defined($bytes)) { + chomp $result; + readingsSingleUpdate($hash, "step", $result, 1); + } else { + Log3 $hash, 2, "$name: $!"; + $result= undef; + } + return $result; +} + + +############################# +1; +############################# + + +=pod +=begin html + + +

SubProcessTester

+
    +
    + + + Define +
      + define <name> SubProcessTester <config>
      +
      +
    + +
+ + +=end html diff --git a/fhem/contrib/SubProcess/conf-subprocess b/fhem/contrib/SubProcess/conf-subprocess new file mode 100644 index 000000000..5e4b1ecd5 --- /dev/null +++ b/fhem/contrib/SubProcess/conf-subprocess @@ -0,0 +1,11 @@ +attr global statefile /users/neubert/Development/Perl/fhem-data/fhem.save +attr global verbose 5 +attr global port 7072 global +attr global modpath /users/neubert/Development/Perl/fhem-code/fhem +define MyLog FileLog /users/neubert/Development/Perl/fhem-data/my.log .* +define ui FHEMWEB 8083 global +attr ui stylesheetPrefix dark +attr ui room UI + +define T SubProcessTester +