From c7eee17e1563e16e5427cc4a463534039df56d0f Mon Sep 17 00:00:00 2001 From: jpawlowski Date: Mon, 22 Aug 2016 08:06:24 +0000 Subject: [PATCH] 98_exportdevice.pm: add support for dependent objects git-svn-id: https://svn.fhem.de/fhem/trunk@12047 2b470e98-0d58-463d-a4d8-8e2adae1ed80 --- fhem/FHEM/98_exportdevice.pm | 187 +++++++++++++++++++++++++---------- 1 file changed, 133 insertions(+), 54 deletions(-) diff --git a/fhem/FHEM/98_exportdevice.pm b/fhem/FHEM/98_exportdevice.pm index 1688836e0..438cf290f 100755 --- a/fhem/FHEM/98_exportdevice.pm +++ b/fhem/FHEM/98_exportdevice.pm @@ -4,13 +4,15 @@ package main; use strict; use warnings; +no if $] >= 5.017011, warnings => 'experimental'; + sub CommandExportdevice($$); ######################################## sub exportdevice_Initialize($$) { my %hash = ( Fn => "CommandExportdevice", - Hlp => "[devspec] [quote]", + Hlp => "[devspec] [quote] [dependent]", ); $cmds{exportdevice} = \%hash; } @@ -18,69 +20,75 @@ sub exportdevice_Initialize($$) { ######################################## sub CommandExportdevice($$) { my ( $cl, $param ) = @_; - my @a = split( "[ \t][ \t]*", $param ); - my $quote = 0; - my $str = ""; + my @a = split( "[ \t][ \t]*", $param ); + my $quote = 0; + my $dependent = 0; + my $str = ""; - return "Usage: exportdevice [devspec] [quote]" + return "Usage: exportdevice [devspec] [quote] [dependent]" if ( $a[0] eq "?" ); + $dependent = 1 + if ( $a[0] eq "dependent" + || $a[1] eq "dependent" + || $a[1] eq "dependent" ); + $quote = 1 - if ( $a[0] eq "quote" || $a[1] eq "quote" ); + if ( $a[0] eq "quote" || $a[1] eq "quote" || $a[2] eq "quote" ); $a[0] = ".*" - if ( int(@a) < 1 || $a[0] eq "quote" ); + if ( int(@a) < 1 + || $a[0] eq "quote" + || $a[0] eq "dependent" ); my $mname = ""; - foreach my $dev ( devspec2array( $a[0], $cl ) ) { - next if ( !$defs{$dev} ); + my @objects; + foreach my $d ( devspec2array( $a[0], $cl ) ) { + next if ( !$defs{$d} || $d ~~ @objects ); - # module header (only once) - if ( $mname ne $defs{$dev}{TYPE} ) { - $mname = $defs{$dev}{TYPE}; - my $ver = fhem "version $defs{$dev}{TYPE}"; - $ver =~ s/\n+/\n# /g; - $ver =~ s/^/# /g; - $str .= "\n\n# TYPE: $defs{$dev}{TYPE}\n$ver\n\n"; + push( @objects, $d ); + + # w/ module header + if ( $mname ne $defs{$d}{TYPE} ) { + $mname = $defs{$d}{TYPE}; + $str .= CommandExportdeviceGetBlock( $d, $quote, 1 ); } - # device definition - if ( $dev ne "global" ) { - my $def = $defs{$dev}{DEF}; - if ( defined($def) ) { - if ($quote) { - $def =~ s/;/;;/g; - $def =~ s/\n/\\\n/g; + # w/o module header + else { + $str .= CommandExportdeviceGetBlock( $d, $quote ); + } + + if ($dependent) { + + # dependent objects + my $dc = 0; + foreach my $do ( CommandExportdeviceGetDependentObjects($d) ) { + next if ( !$do || $do eq $d || $do ~~ @objects ); + + push( @objects, $do ); + $dc++; + + $str .= "#+++ Dependent objects" + if $dc == 1; + + # w/ module header + if ( $mname ne $defs{$do}{TYPE} ) { + $mname = $defs{$do}{TYPE}; + my $s = CommandExportdeviceGetBlock( $do, $quote, 1 ); + $s =~ s/\n/\n /g; + $str .= $s; + } + + # w/o module header + else { + my $s = CommandExportdeviceGetBlock( $do, $quote ); + $s =~ s/\n/\n /g; + $str .= $s; } - $str .= "define $dev $defs{$dev}{TYPE} $def\n"; - } - else { - $str .= "define $dev $defs{$dev}{TYPE}\n"; } } - # device attributes - foreach my $a ( - sort { - return -1 - if ( $a eq "userattr" ); # userattr must be first - return 1 if ( $b eq "userattr" ); - return $a cmp $b; - } keys %{ $attr{$dev} } - ) - { - next - if ( $dev eq "global" - && ( $a eq "configfile" || $a eq "version" ) ); - my $val = $attr{$dev}{$a}; - if ($quote) { - $val =~ s/;/;;/g; - $val =~ s/\n/\\\n/g; - } - $str .= "attr $dev $a $val\n"; - } - - $str .= "\n"; } my $return; @@ -94,11 +102,82 @@ sub CommandExportdevice($$) { . AttrVal( "global", "version", "fhem.pl:?/?" ) . "\n# at " . TimeNow() . "\n#" - . $str + . $str . "\n\n" if ( $str ne "" ); return "No device found: $a[0]"; } +sub CommandExportdeviceGetBlock($$;$) { + my ( $d, $quote, $h ) = @_; + my $str = ""; + return if ( !$defs{$d} ); + + # module header (only once) + if ($h) { + my $ver = fhem( "version " . $defs{$d}{TYPE}, 1 ); + $ver =~ s/\n+/\n# /g; + $ver =~ s/^/# /g; + $str .= "\n\n### TYPE: $defs{$d}{TYPE}\n$ver\n\n"; + } + + # device definition + if ( $d ne "global" ) { + my $def = $defs{$d}{DEF}; + if ( defined($def) ) { + if ($quote) { + $def =~ s/;/;;/g; + $def =~ s/\n/\\\n/g; + } + $str .= "define $d $defs{$d}{TYPE} $def\n"; + } + else { + $str .= "define $d $defs{$d}{TYPE}\n"; + } + } + + # device attributes + foreach my $a ( + sort { + return -1 + if ( $a eq "userattr" ); # userattr must be first + return 1 if ( $b eq "userattr" ); + return $a cmp $b; + } keys %{ $attr{$d} } + ) + { + next + if ( $d eq "global" + && ( $a eq "configfile" || $a eq "version" ) ); + my $val = $attr{$d}{$a}; + if ($quote) { + $val =~ s/;/;;/g; + $val =~ s/\n/\\\n/g; + } + $str .= "attr $d $a $val\n"; + } + + $str .= "\n"; + + return $str; +} + +sub CommandExportdeviceGetDependentObjects($) { + my ($d) = @_; + my @dob; + + foreach my $dn ( sort keys %defs ) { + next if ( !$dn || $dn eq $d ); + my $dh = $defs{$dn}; + if ( ( $dh->{DEF} && $dh->{DEF} =~ m/\b$d\b/ ) + || ( $defs{$d}{DEF} && $defs{$d}{DEF} =~ m/\b$dn\b/ ) ) + { + push( @dob, $dn ); + } + } + + return @dob; +} + 1; =pod @@ -110,7 +189,7 @@ sub CommandExportdevice($$) {

exportdevice