SubProcess: added new module for standardized support of concurrency plus educative example in contrib

git-svn-id: https://svn.fhem.de/fhem/trunk@8321 2b470e98-0d58-463d-a4d8-8e2adae1ed80

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 <http://www.gnu.org/licenses/>.
+#
+##############################################################################
+
+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;

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

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 <http://www.gnu.org/licenses/>.
+#
+################################################################################
+
+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 <name> SubProcessTester <configuration>";
+    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
+
+<a name="SubProcessTester"></a>
+<h3>SubProcessTester</h3>
+<ul>
+  <br>
+
+  <a name="SubProcessTester"></a>
+  <b>Define</b>
+  <ul>
+    <code>define &lt;name&gt; SubProcessTester &lt;config&gt;</code><br>
+    <br>
+  </ul>  
+
+</ul>
+
+
+=end html

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
+