############################################## # $Id$ # # 97_SprinkleControl.pm # # written by Tobias Faust 2013-10-23 # e-mail: tobias dot faust at online dot de # ############################################## package main; use strict; use warnings; use Data::Dumper; use vars qw(%gets %sets %defs %attr); sub SprinkleControl_AllocateNewThread($@); sub SprinkleControl_DeallocateThread($@); sub UpdateSprinkleControlList($$); # SetParamName -> Anzahl Paramter my %sets = ( "MaxParallel" => "1" ); # These we may get on request my %gets = ( "Threads" => "0" ); ########################## sub SprinkleControl_Initialize($) { my ($hash) = @_; require "$main::attr{global}{modpath}/FHEM/98_Sprinkle.pm"; $hash->{DefFn} = "SprinkleControl_Define"; $hash->{SetFn} = "SprinkleControl_Set"; $hash->{UndefFn} = "SprinkleControl_Undefine"; $hash->{AttrFn} = "SprinkleControl_Attr"; $hash->{AttrList} = "disable:0,1". " SprinkleControl_MaxParallel". " ".$readingFnAttributes; } ########################## # Define SprinkleControl ########################## sub SprinkleControl_Define($$) { my ($hash, $def) = @_; my $me = $hash->{NAME}; my @a = split("[ \t]+", $def); #$a[0]: Name #$a[1]: Type/Alias -> SprinkleControl if(int(@a) > 2) { my $msg = "wrong syntax: define SprinkleControl"; Log3 $hash, 2, $msg; return $msg; } if(!$attr{$me}) { #Attribute vorbelegen! Nur beim Define, kein Modify #$attr{$me}{webCmd} = "Auto:An:Aus:Toggle:Disable"; $attr{$me}{SprinkleControl_MaxParallel} = 2; } UpdateSprinkleControlList($hash, "add"); $hash->{MaxParallel} = $attr{$me}{SprinkleControl_MaxParallel}; readingsSingleUpdate($hash, "state", "0/".$attr{$me}{SprinkleControl_MaxParallel}, 1); readingsSingleUpdate($hash, "CountThreads", 0, 1); return undef; } ##################################### sub SprinkleControl_Undefine($$) { my ($hash, $arg) = @_; UpdateSprinkleControlList($hash, "del"); return undef; } ################################### # ################################### sub SprinkleControl_Attr(@) { my @a = @_; my $do = 0; my $hash = $defs{$a[1]}; my $command = $a[0]; my $setter = $a[2]; my $value = $a[3]; my $threads = ReadingsVal($hash->{NAME}, "CountThreads",0); if($setter eq "SprinkleControl_MaxParallel" && $command ne "del") { return "Max Parallel Threads isn´t numeric or not > 0" if ($value !~ m/^(\d+)$/ || $value < 0); $hash->{MaxParallel} = $value; readingsSingleUpdate($hash, "state", $threads."/".$value, 1); } elsif($setter eq "disable"){ # 1=disable; 2=enable if($command eq "set") { $do = (!defined($value) || $value) ? 1 : 2; } $do = 2 if($command eq "del"); readingsSingleUpdate($hash, "state", ($do == 1 ? "disabled" : $threads."/".$hash->{MaxParallel}), 1); } return undef; } ########################################################################### sub SprinkleControl_Set($@) { my ($hash, @a) = @_; my $me = $hash->{NAME}; return "no set argument specified" if(int(@a) < 2); my $cmd = $a[1]; # DevName my $value = $a[2]; if(!defined($sets{$cmd})) { my $r = "Unknown argument $cmd, choose one of ".join(" ",sort keys %sets); return $r; } # Abbruch falls Disabled #return undef if(IsDisabled($hash->{NAME})); # return "$cmd needs $sets{$cmd} parameter(s)" if(@a-$sets{$cmd} != 0); my $threads = ReadingsVal($me, "CountThreads",0); if($cmd eq "Disable" && !IsDisabled($me)) { $attr{$me}{disable}=1; readingsSingleUpdate($hash, "state", "disabled", 1); # Deaktivieren return undef; } elsif($cmd eq "Disable" && IsDisabled($me)) { $attr{$me}{disable}=0; my $threads = ReadingsVal($hash->{NAME}, "CountThreads",0); readingsSingleUpdate($hash, "state", $threads."/".$hash->{MaxParallel}, 1); return undef; } elsif (IsDisabled($me)) { # mache nix da disabled return undef; } elsif($cmd eq "MaxParallel") { $hash->{MaxParallel} = $value; readingsSingleUpdate($hash, "state", $threads."/".$value, 1); } return undef; } ########################################################## # Allokiert einen neuen Thread # param1 : SprinkleControlDevice # param2 : anforderndes Device # param3 : Command # param4 : Priorität # 1->Ausführung sofort ->ToDo # 2->Ausführung als nächstes, Anfang der Queue # 3->Einreihung an das Ende der Queue ########################################################## sub SprinkleControl_AllocateNewThread($@) { my ($me, $dev, $cmd, $prio) = @_; my $hash = $defs{$me}; Log3 $hash, 4, "$me: Anforderung Thread allokieren durch '$dev' mit comand '$cmd'"; return 1 if(IsDisabled($me)); my $threads = ReadingsVal($me, "CountThreads",0); my $max = $hash->{MaxParallel}; $prio = 3 if(!defined($prio)); my $present=0; $present = 1 if(defined($hash->{helper}{Queue}{$dev})); if($present == 0) { # noch nicht in der queue vorhanden Log3 $hash, 4, "$me: Füge Device '$dev' der Queue hinzu"; $hash->{helper}{Queue}{$dev}{priority} = $prio; $hash->{helper}{Queue}{$dev}{command} = $cmd; } else { Log3 $hash, 4, "$me: Device '$dev' bereits in der Queue vorhanden"; } if($present == 0 || ($present == 1 && $hash->{helper}{Queue}{$dev}{active} == 0)) { # schon in der Queue vorhanden aber in Wartestellung Log3 $hash, 4, "$me: Device '$dev' aktuell in der Queue vorhanden oder in Wartestellung, prüfe auf freien Thread"; if($threads < $max) { Log3 $hash, 4, "$me: freier Thread vorhanden, gebe Thread frei für Device '$dev' und markiere als 'active'"; $threads += 1; $hash->{helper}{Queue}{$dev}{active} = 1; readingsBeginUpdate($hash); readingsBulkUpdate($hash, "CountThreads", $threads); readingsBulkUpdate($hash, "state", $threads."/".$max); readingsEndUpdate($hash, 1); return $threads; # Rückgabe der Threadnummer } else { # abgelehnt da MAX erreicht, in queue gelegt Log3 $hash, 4, "$me: kein freier Thread vorhanden, MAXTHREADS wurde erreicht, markiere Device '$dev' in der Queue als 'inactive'"; $hash->{helper}{Queue}{$dev}{active} = 0; return undef ; } } else { # Device ist bereits in der Queue vorhanden Log3 $hash, 4, "$me: Device '$dev' bereits in der Queue vorhanden, mache nichts"; return undef; } } ############################################ # Gibt einen Thread frei # param1 : SprinkleControlDevice # param2 : abgebendes Device ############################################ sub SprinkleControl_DeallocateThread($@) { my ($me, $dev) = @_; my $hash = $defs{$me}; Log3 $hash, 4, "$me: Anforderung Thread löschen durch '$dev'"; my $threads = ReadingsVal($me, "CountThreads",0); my $max = $hash->{MaxParallel}; if(defined($hash->{helper}{Queue}{$dev})) { Log3 $hash, 4, "$me: Device '$dev' in der Queue erkannt und gelöscht. Thread freigegeben"; $threads -= 1; $threads = 0 if($threads<0); delete $hash->{helper}{Queue}{$dev}; } readingsBeginUpdate($hash); readingsBulkUpdate($hash, "CountThreads", $threads); readingsBulkUpdate($hash, "state", ($threads)."/".$max); readingsEndUpdate($hash, 1); # den nächsten wartenden Thread aus der Queue starten #my %queue = %{$hash->{helper}{Queue}}; my @queue = sort keys %{$hash->{helper}{Queue}}; for(my $i=0; $i < @queue; $i++) { my $d = $queue[$i]; Log3 $hash, 4, "$me: wartendes Device in der Queue erkannt: '$d'"; if($hash->{helper}{Queue}{$d}{active} == 0) { Log3 $hash, 4, "$me: Starte wartendes Device, rufe DoIt für Device '$d' mit Command '".$hash->{helper}{Queue}{$d}{command}."'' auf"; Sprinkle_DoIt($defs{$d}, $hash->{helper}{Queue}{$d}{command}); last; } } return 1; } ############################################ # Updatet die AttrListe im SprinkleModul ############################################ sub UpdateSprinkleControlList($$) { my ($hash, $cmd) = @_; #List verfuegbarer SprinkleControls in den SprinkleModulen aktualisieren my $attrlist = $modules{Sprinkle}{AttrList}; #Log3 $hash,3,"1. AttrList: ".$attrlist; #my $newlist = "SprinkleControl:"; my @newlist; my $newlist1 = ""; foreach my $d (sort keys %defs) { if($defs{$d}{TYPE} eq "SprinkleControl") { push(@newlist, $d) unless(defined($hash) && ($d eq $hash->{NAME}) && ($cmd eq "del")); } } if(@newlist > 0) { $newlist1 = "SprinkleControl:" . join(",", @newlist); } #if($attrlist) { #$attrlist =~ s/(SprinkleControl\:[^\ ]+)/$newlist1/i; $attrlist =~ s/SprinkleControl\:[^\ ]+/$newlist1/i; #Log3 $hash,3,"2. AttrList: ".$attrlist; $attrlist .= " ".$newlist1 if($attrlist !~ m/SprinkleControl/); #Log3 $hash,3,"3. AttrList: ".$attrlist; $modules{Sprinkle}{AttrList} = $attrlist; #} #Log3 $hash,3,"4. AttrList: ".$attrlist; } 1; =pod =begin html

Sprinkle

Set
Get
Attributes =end html =begin html_DE

Sprinkle

Set
Get
Attribute =end html_DE =cut