commit 3048f536f3095fd67498557549234b15de68db64 Author: Marko Oldenburg Date: Thu Mar 7 19:44:14 2024 +0100 first commit diff --git a/FHEM/98_Installer.pm b/FHEM/98_Installer.pm new file mode 100644 index 0000000..ee0a1fb --- /dev/null +++ b/FHEM/98_Installer.pm @@ -0,0 +1,5598 @@ +# $Id: 98_Installer.pm 20949 2020-01-12 09:53:11Z loredo $ + +package main; +use strict; +use warnings; +use POSIX; +use FHEM::Meta; + +sub Installer_Initialize($) { + my ($modHash) = @_; + + $modHash->{SetFn} = "FHEM::Installer::Set"; + $modHash->{GetFn} = "FHEM::Installer::Get"; + $modHash->{DefFn} = "FHEM::Installer::Define"; + $modHash->{NotifyFn} = "FHEM::Installer::Notify"; + $modHash->{UndefFn} = "FHEM::Installer::Undef"; + $modHash->{AttrFn} = "FHEM::Installer::Attr"; + $modHash->{AttrList} = + "disable:1,0 " + . "disabledForIntervals " + . "installerMode:update,developer " + . "updateListReading:1,0 " + . "updatePerlDualLifeModules:0,1 " + . "updatePerlUsedModulesOnly:1,0 " + . "installPerlReinstall:0,1 " + . "installPerlNoTest:0,1 " + . "installPerlEnforced:0,1 " + . $readingFnAttributes; + + return FHEM::Meta::InitMod( __FILE__, $modHash ); +} + +# define package +package FHEM::Installer; +use strict; +use warnings; +use POSIX; +use FHEM::Meta; + +use GPUtils qw(GP_Import); +use Data::Dumper; +use Config; +use ExtUtils::Installed; + +# Run before module compilation +BEGIN { + + # Import from main:: + GP_Import( + qw( + attr + AttrVal + cmds + CommandAttr + Debug + defs + deviceEvents + devspec2array + DoTrigger + FW_webArgs + gettimeofday + init_done + InternalTimer + IsDisabled + LoadModule + Log + Log3 + maxNum + modules + packages + readingsBeginUpdate + readingsBulkUpdate + readingsBulkUpdateIfChanged + readingsEndUpdate + readingsSingleUpdate + ReadingsTimestamp + ReadingsVal + RemoveInternalTimer + TimeNow + Value + ) + ); +} + +# try to use JSON::MaybeXS wrapper +# for chance of better performance + open code +eval { + require JSON::MaybeXS; + import JSON::MaybeXS qw( decode_json encode_json ); + 1; +}; +if ($@) { + $@ = undef; + + # try to use JSON wrapper + # for chance of better performance + eval { + + # JSON preference order + local $ENV{PERL_JSON_BACKEND} = + 'Cpanel::JSON::XS,JSON::XS,JSON::PP,JSON::backportPP' + unless ( defined( $ENV{PERL_JSON_BACKEND} ) ); + + require JSON; + import JSON qw( decode_json encode_json ); + 1; + }; + + if ($@) { + $@ = undef; + + # In rare cases, Cpanel::JSON::XS may + # be installed but JSON|JSON::MaybeXS not ... + eval { + require Cpanel::JSON::XS; + import Cpanel::JSON::XS qw(decode_json encode_json); + 1; + }; + + if ($@) { + $@ = undef; + + # In rare cases, JSON::XS may + # be installed but JSON not ... + eval { + require JSON::XS; + import JSON::XS qw(decode_json encode_json); + 1; + }; + + if ($@) { + $@ = undef; + + # Fallback to built-in JSON which SHOULD + # be available since 5.014 ... + eval { + require JSON::PP; + import JSON::PP qw(decode_json encode_json); + 1; + }; + + if ($@) { + $@ = undef; + + # Fallback to JSON::backportPP in really rare cases + require JSON::backportPP; + import JSON::backportPP qw(decode_json encode_json); + 1; + } + } + } + } +} + +# Load dependent FHEM modules as packages, +# no matter if user also defined FHEM devices or not. +# We want to use their functions here :-) +#TODO let this make Meta.pm for me +#LoadModule('apt'); +#LoadModule('pypip'); +LoadModule('npmjs'); + +our %pkgStatus = (); + +sub Define($$) { + my ( $hash, $def ) = @_; + my @a = split( "[ \t][ \t]*", $def ); + + # Initialize the module and the device + return $@ unless ( FHEM::Meta::SetInternals($hash) ); + use version 0.77; our $VERSION = FHEM::Meta::Get( $hash, 'version' ); + + my $name = $a[0]; + my $host = $a[2] ? $a[2] : 'localhost'; + + Undef( $hash, undef ) if ( $hash->{OLDDEF} ); # modify + + $hash->{NOTIFYDEV} = "global,$name"; + + return "Existing instance: " + . $modules{ $hash->{TYPE} }{defptr}{localhost}{NAME} + if ( defined( $modules{ $hash->{TYPE} }{defptr}{localhost} ) ); + + $modules{ $hash->{TYPE} }{defptr}{localhost} = $hash; + + if ( $init_done && !defined( $hash->{OLDDEF} ) ) { + + # presets for FHEMWEB + $attr{$name}{alias} = 'FHEM Installer Status'; + $attr{$name}{devStateIcon} = +'.*updates.available:security@red:outdated up.to.date:security@green:outdated .*outdated.*in.progress:system_fhem_reboot@orange .*in.progress:system_fhem_update@orange warning.*:message_attention@orange error.*:message_attention@red'; + $attr{$name}{group} = 'Update'; + $attr{$name}{icon} = 'system_fhem'; + $attr{$name}{room} = 'System'; + } + + readingsSingleUpdate( $hash, "state", "initialized", 1 ) + if ( ReadingsVal( $name, 'state', 'none' ) ne 'none' ); + + return undef; +} + +sub Undef($$) { + + my ( $hash, $arg ) = @_; + + my $name = $hash->{NAME}; + + if ( exists( $hash->{".fhem"}{subprocess} ) ) { + my $subprocess = $hash->{".fhem"}{subprocess}; + $subprocess->terminate(); + $subprocess->wait(); + } + + RemoveInternalTimer($hash); + + delete( $modules{ $hash->{TYPE} }{defptr}{localhost} ); + return undef; +} + +sub Attr(@) { + + my ( $cmd, $name, $attrName, $attrVal ) = @_; + my $hash = $defs{$name}; + + if ( $attrName eq "disable" ) { + if ( $cmd eq "set" and $attrVal eq "1" ) { + RemoveInternalTimer($hash); + + readingsSingleUpdate( $hash, "state", "disabled", 1 ); + Log3 $name, 3, "Installer ($name) - disabled"; + } + + elsif ( $cmd eq "del" ) { + Log3 $name, 3, "Installer ($name) - enabled"; + } + } + + elsif ( $attrName eq "disabledForIntervals" ) { + if ( $cmd eq "set" ) { + return +"check disabledForIntervals Syntax HH:MM-HH:MM or 'HH:MM-HH:MM HH:MM-HH:MM ...'" + unless ( $attrVal =~ /^((\d{2}:\d{2})-(\d{2}:\d{2})\s?)+$/ ); + Log3 $name, 3, "Installer ($name) - disabledForIntervals"; + readingsSingleUpdate( $hash, "state", "disabled", 1 ); + } + + elsif ( $cmd eq "del" ) { + Log3 $name, 3, "Installer ($name) - enabled"; + readingsSingleUpdate( $hash, "state", "active", 1 ); + } + } + + return undef; +} + +sub Notify($$) { + + my ( $hash, $dev ) = @_; + my $name = $hash->{NAME}; + return if ( IsDisabled($name) ); + + my $devname = $dev->{NAME}; + my $devtype = $dev->{TYPE}; + my $events = deviceEvents( $dev, 1 ); + return if ( !$events ); + + Log3 $name, 5, "Installer ($name) - Notify: " . Dumper $events; + + if ( + ( + ( + grep ( /^DEFINED.$name$/, @{$events} ) + or grep ( /^DELETEATTR.$name.disable$/, @{$events} ) + or grep ( /^ATTR.$name.disable.0$/, @{$events} ) + ) + and $devname eq 'global' + and $init_done + ) + or ( + ( + grep ( /^INITIALIZED$/, @{$events} ) + or grep ( /^REREADCFG$/, @{$events} ) + or grep ( /^MODIFIED.$name$/, @{$events} ) + ) + and $devname eq 'global' + ) + ) + { + # Load metadata for all modules that are in use + FHEM::Meta::Load(); + + # restore from packageList + my $decode_json = + eval { decode_json( ReadingsVal( $name, '.packageListPerl', '' ) ) }; + unless ($@) { + $hash->{".fhem"}{installer}{cpanversions} = $decode_json->{versions} + if ( defined( $decode_json->{versions} ) ); + $hash->{".fhem"}{installer}{listedPerlPackages} = + $decode_json->{listedPerl} + if ( defined( $decode_json->{listedPerl} ) ); + $hash->{".fhem"}{installer}{outdatedPerlPackages} = + $decode_json->{outdatedPerl} + if ( defined( $decode_json->{outdatedPerl} ) ); + } + $decode_json = undef; + + # restore from installedList + $decode_json = + eval { decode_json( ReadingsVal( $name, '.installedListPerl', '' ) ) }; + unless ($@) { + $hash->{".fhem"}{installer}{installedPerlPackages} = $decode_json; + } + $decode_json = undef; + + # restore from uninstalledList + $decode_json = eval { + decode_json( ReadingsVal( $name, '.uninstalledListPerl', '' ) ); + }; + unless ($@) { + $hash->{".fhem"}{installer}{uninstalledPerlPackages} = $decode_json; + } + $decode_json = undef; + + # restore from updatedList + $decode_json = + eval { decode_json( ReadingsVal( $name, '.updatedListPerl', '' ) ) }; + unless ($@) { + $hash->{".fhem"}{installer}{updatedPerlPackages} = $decode_json; + } + $decode_json = undef; + + # Trigger update + if ( ReadingsVal( $name, 'cpanVersion', 'none' ) ne 'none' ) { + ProcessUpdateTimer($hash); + } + else { + $hash->{".fhem"}{installer}{cmd} = 'getCpanVersion'; + AsynchronousExecuteFhemCommand($hash); + } + } + + if ( + $devname eq $name + and ( grep ( /^installedPerl:.successful$/, @{$events} ) + or grep ( /^uninstalledPerl:.successful$/, @{$events} ) + or grep ( /^updatedPerl:.successful$/, @{$events} ) ) + ) + { + $hash->{".fhem"}{installer}{cmd} = 'outdatedPerl'; + AsynchronousExecuteFhemCommand($hash); + } + + return; +} + +sub Set($$@) { + + my ( $hash, $name, @aa ) = @_; + + my ( $cmd, @args ) = @aa; + my $ret; + + my $updatePerlDualLifeModules = + AttrVal( $name, 'updatePerlDualLifeModules', 0 ); + my $updatePerlUsedModulesOnly = + AttrVal( $name, 'updatePerlUsedModulesOnly', 1 ); + + # outdatedPerl + if ( lc($cmd) eq 'outdatedperl' ) { + $hash->{".fhem"}{installer}{cmd} = $cmd; + } + + # statusRequest + elsif ( lc($cmd) eq 'statusrequest' ) { + $hash->{".fhem"}{installer}{cmd} = 'getCpanVersion'; + } + + # update + elsif ( lc($cmd) eq 'updateperl' ) { + return "Please run outdatedPerl check first" + unless ( + defined( $hash->{".fhem"}{installer}{outdatedPerlPackages} ) ); + my $update; + + # generate explicit list for packages to update + if ( @args == 0 + || lc( $args[0] ) eq 'all' ) + { + undef @args; + foreach ( + keys %{ $hash->{".fhem"}{installer}{outdatedPerlPackages} } ) + { + next if ( $_ eq 'undefined' ); + if ( $updatePerlDualLifeModules + || !FHEM::Meta::ModuleIsPerlCore($_) ) + { + push @args, + $_ . '@' + . $hash->{".fhem"}{installer}{outdatedPerlPackages}{$_} + {latest} + if ( !$updatePerlUsedModulesOnly + || defined( $FHEM::Meta::dependents{pkgs}{$_} ) ); + } + } + } + + foreach my $pkgfull (@args) { + next + unless ( + $pkgfull =~ + /^(?:@([\w-]+)\/)?([\w\-\:]+)(?:@([\d\.=<>]+|latest))?$/ + && defined( + $hash->{".fhem"}{installer}{outdatedPerlPackages}{$2} + ) + ); + + $update .= " " if ($update); + $update .= $2 . ( $3 && $3 ne 'latest' ? '@' . $3 : '' ); + } + + return "Everything is up-to-date already" + unless ($update); + + $hash->{".fhem"}{installer}{cmd} = "installPerl " . $update; + $ret = "Update started in background"; + } + + # installPerl + elsif ( lc($cmd) eq 'installperl' ) { + return "usage: $cmd " if ( @args < 1 ); + $hash->{".fhem"}{installer}{cmd} = 'installPerl ' . join( " ", @args ); + $ret = "Installation started in background"; + } + + # uninstallPerl + elsif ( lc($cmd) eq 'uninstallperl' ) { + return "usage: $cmd " if ( @args < 1 ); + return "cpanminus cannot be uninstalled from here" + if ( + grep ( +m/^(?:@([\w-]+)\/)?(?:App::)?(cpanm(?:inus)?)(?:@([\d\.=<>]+|latest))?$/i, + @args ) + ); + return "cpan-outdated cannot be uninstalled from here" + if ( + grep ( +m/^(?:@([\w-]+)\/)?(?:App::)?(cpan\-?outdated)(?:@([\d\.=<>]+|latest))?$/i, + @args ) + ); + $hash->{".fhem"}{installer}{cmd} = + 'uninstallPerl ' . join( " ", @args ); + $ret = "Deinstallation started in background"; + } + + # return Usage: + else { + my $list = ''; + + if ( !defined( $hash->{".fhem"}{installer}{cpanversions} ) ) { + $list = "installPerl:App::cpanminus statusRequest:noArg"; + } + elsif ( + !defined( $hash->{".fhem"}{installer}{cpanversions}{cpanoutdated} ) + ) + { + $list = "installPerl:App::cpanoutdated statusRequest:noArg"; + } + else { + $list = "outdatedPerl:noArg"; + $list .= " installPerl"; + $list .= " uninstallPerl"; + + if ( defined( $hash->{".fhem"}{installer}{outdatedPerlPackages} ) + and scalar + keys %{ $hash->{".fhem"}{installer}{outdatedPerlPackages} } > + 0 ) + { + my $update; + + foreach ( + sort + keys %{ $hash->{".fhem"}{installer}{outdatedPerlPackages} } + ) + { + if ( + ( + $updatePerlDualLifeModules + || !FHEM::Meta::ModuleIsPerlCore($_) + ) + && ( !$updatePerlUsedModulesOnly + || defined( $FHEM::Meta::dependents{pkgs}{$_} ) ) + ) + { + $update .= "," if ($update); + $update .= $_; + } + } + $list .= " updatePerl:all,$update" if ($update); + } + } + + return "Unknown argument $cmd, choose one of $list"; + } + + AsynchronousExecuteFhemCommand($hash); + + return $ret if ($ret); + return undef; +} + +#TODO +# - filter out FHEM command modules from FHEMWEB view (+attribute) -> difficult as not pre-loaded +sub Get($$@) { + + my ( $hash, $name, @aa ) = @_; + + my ( $cmd, @args ) = @aa; + + my $updatePerlDualLifeModules = + AttrVal( $name, 'updatePerlDualLifeModules', 0 ); + my $updatePerlUsedModulesOnly = + AttrVal( $name, 'updatePerlUsedModulesOnly', 1 ); + + if ( lc($cmd) eq 'showoutdatedperllist' ) { + return "usage: $cmd" if ( @args != 0 ); + + my $ret = CreateOutdatedPerlList( $hash, $cmd ); + return $ret; + + } + elsif ( lc($cmd) eq 'showinstalledperllist' ) { + return "usage: $cmd" if ( @args != 0 ); + + my $ret = CreateInstalledPerlList( $hash, $cmd ); + return $ret; + + } + elsif ( lc($cmd) eq 'checkprereqs' ) { + my $ret = CreatePrereqsList( $hash, $cmd, @args ); + return $ret; + } + elsif ( lc($cmd) eq 'search' ) { + my $ret = CreateSearchList( $hash, $cmd, @args ); + return $ret; + } + elsif ( lc($cmd) eq 'showmoduleinfo' ) { + return "usage: $cmd MODULE" if ( @args != 1 ); + + my $ret = CreateMetadataList( $hash, $cmd, $args[0] ); + return $ret; + } + elsif ( lc($cmd) eq 'showpackageinfo' ) { + return "usage: $cmd PACKAGE" if ( @args != 1 ); + + my $ret = CreateMetadataList( $hash, $cmd, $args[0] ); + return $ret; + } + elsif ( lc($cmd) eq 'zzgetmodulemeta.json' ) { + return "usage: $cmd MODULE" if ( @args != 1 ); + + my $ret = CreateRawMetaJson( $hash, $cmd, $args[0] ); + return $ret; + } + elsif ( lc($cmd) eq 'zzgetpackagemeta.json' ) { + return "usage: $cmd PACKAGE" if ( @args != 1 ); + + my $ret = CreateRawMetaJson( $hash, $cmd, $args[0] ); + return $ret; + } + elsif ( lc($cmd) eq 'showerrorlist' ) { + return "usage: $cmd" if ( @args != 0 ); + + my $ret = CreateErrorList($hash); + return $ret; + } + else { + my $installerMode = AttrVal( $name, 'installerMode', 'update' ); + my @fhemModules; + foreach ( sort { "\L$a" cmp "\L$b" } keys %modules ) { + next if ( $_ eq 'Global' ); + push @fhemModules, $_ + if ( $installerMode ne 'update' + || defined( $modules{$_}{LOADED} ) ); + } + + my $list = + 'search' . ' showModuleInfo:FHEM,' . join( ',', @fhemModules ); + + if ( $installerMode eq 'developer' ) { + my @fhemPackages; + foreach ( sort { "\L$a" cmp "\L$b" } keys %packages ) { + push @fhemPackages, $_; + } + + $list .= + ' showPackageInfo:' + . join( ',', @fhemPackages ) + . ' zzGetModuleMETA.json:FHEM,' + . join( ',', @fhemModules ) + . ' zzGetPackageMETA.json:' + . join( ',', @fhemPackages ); + } + + $list .= " checkPrereqs"; + if ( $installerMode eq 'install' ) { + my $dh; + my $dir = $attr{global}{modpath}; + if ( opendir( $dh, $dir ) ) { + my $counter = 0; + foreach my $fn ( + grep { $_ ne "." && $_ ne ".." && !-d $_ && $_ =~ /\.cfg$/ } + readdir($dh) + ) + { + $list .= ':' unless ($counter); + $list .= ',' if ($counter); + $list .= $fn; + $counter++; + } + closedir($dh); + } + } + elsif ( $installerMode eq 'update' ) { + $list .= ':noArg'; + } + + my $counter = 0; + if ( defined( $hash->{".fhem"}{installer}{outdatedPerlPackages} ) ) { + foreach ( + keys %{ $hash->{".fhem"}{installer}{outdatedPerlPackages} } ) + { + $counter++ + if ( + ( + $updatePerlDualLifeModules + || !FHEM::Meta::ModuleIsPerlCore($_) + ) + && ( !$updatePerlUsedModulesOnly + || defined( $FHEM::Meta::dependents{pkgs}{$_} ) ) + ); + } + } + + $list .= " showOutdatedPerlList:noArg" + if ($counter); + $list .= " showInstalledPerlList:noArg" + if ( defined( $hash->{".fhem"}{installer}{listedPerlPackages} ) + and scalar + keys %{ $hash->{".fhem"}{installer}{listedPerlPackages} } > 0 ); + $list .= " showErrorList:noArg" + if ( defined( $hash->{".fhem"}{installer}{errors} ) + and scalar @{ $hash->{".fhem"}{installer}{errors} } > 0 ); + + return "Unknown argument $cmd, choose one of $list"; + } +} + +sub Event ($$) { + my $hash = shift; + my $event = shift; + my $name = $hash->{NAME}; + + return + unless ( defined( $hash->{".fhem"}{installer}{cmd} ) + && $hash->{".fhem"}{installer}{cmd} =~ + m/^(install|uninstall|update)(?: (.+))/i ); + + my $cmd = $1; + my $pkgs = $2; + + my $list; + + foreach my $package ( split / /, $pkgs ) { + next + unless ( $package =~ + /^(?:@([\w-]+)\/)?([\w\-\:]+)(?:@([\d\.=<>]+|latest))?$/ ); + $list .= " " if ($list); + $list .= $2; + } + + DoModuleTrigger( $hash, uc($event) . uc($cmd) . " $name $list" ); +} + +sub DoModuleTrigger($$@) { + my ( $hash, $eventString, $noreplace, $TYPE ) = @_; + $hash = $defs{$hash} unless ( ref($hash) ); + $noreplace = 1 unless ( defined($noreplace) ); + $TYPE = $hash->{TYPE} unless ( defined($TYPE) ); + + return '' + unless ( defined($TYPE) + && defined( $modules{$TYPE} ) + && defined($eventString) + && $eventString =~ + m/^([A-Za-z\d._]+)(?:\s+([A-Za-z\d._]+)(?:\s+(.+))?)?$/ ); + + my $event = $1; + my $dev = $2; + + return "DoModuleTrigger() can only handle module related events" + if ( ( $hash->{NAME} && $hash->{NAME} eq "global" ) + || $dev eq "global" ); + + # This is a global event on module level + return DoTrigger( "global", "$TYPE:$eventString", $noreplace ) + unless ( $event =~ +/^INITIALIZED|INITIALIZING|MODIFIED|DELETED|BEGIN(?:UPDATE|INSTALL|UNINSTALL)|END(?:UPDATE|INSTALL|UNINSTALL)$/ + ); + + # This is a global event on module level and in device context + return "$event: missing device name" + if ( !defined($dev) || $dev eq '' ); + + return DoTrigger( "global", "$TYPE:$eventString", $noreplace ); +} + +################################### +sub ProcessUpdateTimer($) { + my $hash = shift; + my $name = $hash->{NAME}; + + RemoveInternalTimer($hash); + InternalTimer( + gettimeofday() + 14400, + "FHEM::Installer::ProcessUpdateTimer", + $hash, 0 + ); + Log3 $name, 4, "Installer ($name) - stateRequestTimer: Call Request Timer"; + + unless ( IsDisabled($name) ) { + if ( exists( $hash->{".fhem"}{subprocess} ) ) { + Log3 $name, 2, + "Installer ($name) - update in progress, process aborted."; + return 0; + } + + readingsSingleUpdate( $hash, "state", "ready", 1 ) + if ( ReadingsVal( $name, 'state', 'none' ) eq 'none' + or ReadingsVal( $name, 'state', 'none' ) eq 'initialized' ); + + if ( + __ToDay() ne ( + split( + ' ', + ReadingsTimestamp( $name, 'outdatedPerl', '1970-01-01' ) + ) + )[0] + or ReadingsVal( $name, 'state', '' ) eq 'disabled' + ) + { + $hash->{".fhem"}{installer}{cmd} = 'outdatedPerl'; + AsynchronousExecuteFhemCommand($hash); + } + } +} + +sub CleanSubprocess($) { + + my $hash = shift; + + my $name = $hash->{NAME}; + + delete( $hash->{".fhem"}{subprocess} ); + Log3 $name, 4, "Installer ($name) - clean Subprocess"; +} + +use constant POLLINTERVAL => 1; + +sub AsynchronousExecuteFhemCommand($) { + + require "SubProcess.pm"; + my ($hash) = shift; + + my $name = $hash->{NAME}; + + my $subprocess = SubProcess->new( { onRun => \&OnRun } ); + $subprocess->{installer} = $hash->{".fhem"}{installer}; + $subprocess->{installer}{debug} = + ( AttrVal( $name, 'verbose', 0 ) > 3 ? 1 : 0 ); + $subprocess->{installer}{installPerlReinstall} = + AttrVal( $name, 'installPerlReinstall', 0 ) ? '--reinstall ' : ''; + $subprocess->{installer}{installPerlNoTest} = + AttrVal( $name, 'installPerlNoTest', 0 ) ? '--notest ' : ''; + $subprocess->{installer}{installPerlEnforced} = + AttrVal( $name, 'installPerlEnforced', 0 ) ? '--force ' : ''; + + my $pid = $subprocess->run(); + + readingsSingleUpdate( $hash, 'state', + 'command \'' . $hash->{".fhem"}{installer}{cmd} . '\' in progress', 1 ); + + if ( !defined($pid) ) { + Log3 $name, 1, + "Installer ($name) - Cannot execute command asynchronously"; + + CleanSubprocess($hash); + readingsSingleUpdate( $hash, 'state', + 'Cannot execute command asynchronously', 1 ); + return undef; + } + + Event( $hash, "BEGIN" ); + Log3 $name, 4, + "Installer ($name) - execute command asynchronously (PID= $pid)"; + + $hash->{".fhem"}{subprocess} = $subprocess; + + InternalTimer( gettimeofday() + POLLINTERVAL, + "FHEM::Installer::PollChild", $hash, 0 ); + Log3 $hash, 4, "Installer ($name) - control passed back to main loop."; +} + +sub PollChild($) { + + my $hash = shift; + + my $name = $hash->{NAME}; + + if ( !exists( $hash->{".fhem"}{subprocess} ) + || !ref( $hash->{".fhem"}{subprocess} ) + || ref( $hash->{".fhem"}{subprocess} ) ne 'SubProcess' ) + { + my $emsg = + defined( $hash->{".fhem"}{subprocess} ) + && $hash->{".fhem"}{subprocess}{lasterror} ne '' + ? '{"error":"' . $hash->{".fhem"}{subprocess}{lasterror} . '"}' + : '{"error":"Child process suddenly ended"}'; + Log3 $name, 5, "Installer ($name) - $emsg"; + CleanSubprocess($hash); + PreProcessing( $hash, $emsg ); + return; + } + + my $subprocess = $hash->{".fhem"}{subprocess}; + my $json = $subprocess->readFromChild(); + + if ( !defined($json) ) { + Log3 $name, 5, + "Installer ($name) - still waiting (" + . $subprocess->{lasterror} . ")."; + InternalTimer( gettimeofday() + POLLINTERVAL, + "FHEM::Installer::PollChild", $hash, 0 ); + return; + } + else { + Log3 $name, 4, + "Installer ($name) - got result from asynchronous parsing."; + $subprocess->wait(); + Log3 $name, 4, "Installer ($name) - asynchronous finished."; + + CleanSubprocess($hash); + PreProcessing( $hash, $json ); + } +} + +###################################### +# Begin Childprocess +###################################### + +sub OnRun() { + my $subprocess = shift; + my $response = ExecuteFhemCommand( $subprocess->{installer} ); + + my $json = eval { encode_json($response) }; + if ($@) { + Log3 'Installer OnRun', 3, "Installer - JSON error: $@"; + $json = "{\"jsonerror\":\"$@\"}"; + } + + $subprocess->writeToParent($json); +} + +sub ExecuteFhemCommand($) { + + my $cmd = shift; + + my $installer = {}; + $installer->{debug} = $cmd->{debug}; + my $locale = 'LC_ALL=C'; + my $sudo = $locale . ' sudo -n '; + my $sudoH = $locale . ' sudo -H -n '; + + $installer->{cpanversions} = +'echo n | TEST=$(which cpanm) || echo "sh: command not found: cpanm"; which cpanm >/dev/null 2>&1 && sh -c "' + . $sudoH + . ' $(which cpanm) --version 2>&1" 2>&1'; + $installer->{installperl} = + 'echo n | sh -c "' + . $sudoH + . ' $(which cpanm) --quiet ' + . $cmd->{installPerlReinstall} + . $cmd->{installPerlNoTest} + . $cmd->{installPerlEnforced} + . '%PACKAGES%" 2>&1'; + $installer->{uninstallperl} = + 'echo n | sh -c "' + . $sudoH + . ' $(which cpanm) -U --quiet --force %PACKAGES%" 2>&1'; + $installer->{outdatedperl} = + 'echo n | ' + . 'sh -c "' + . $sudoH + . ' $(which cpanm) --version 2>&1" 2>&1 && ' . 'L1=$(' + . ' cpan-outdated --verbose 2>&1) && ' + . '[ "$L1" != "" ] && [ "$L1" != "\n" ] && echo "@Outdated:\n$L1"; '; + + my $response; + + if ( $cmd->{cmd} =~ /^installperl (.+)/i ) { + + if ( not defined( $cmd->{cpanversions} ) + or not defined( $cmd->{cpanversions}{cpanminus} ) ) + { + if ( $1 =~ /App::cpanminus/i ) { + $installer->{installperl} = +'sh -c "( curl -fsSL https://git.io/cpanm 2>/dev/null || wget -qO- https://git.io/cpanm 2>/dev/null ) | ' + . $sudoH + . '$(which perl) - App::cpanminus >/dev/null 2>&1" 2>&1 ' + . '&& TEST=$(which cpanm) || echo "sh: command not found: cpanm"; which cpanm >/dev/null 2>&1 && sh -c "' + . $sudoH + . ' $(which cpanm) --quiet App::cpanoutdated" 2>&1'; + } + } + else { + my @packages = ''; + foreach my $package ( split / /, $1 ) { + next + unless ( $package =~ + /^(?:@([\w-]+)\/)?([\w\-\:]+)(?:@([\d\.=<>]+|latest))?$/ ); + push @packages, $2 . ( $3 && $3 ne 'latest' ? '@' . $3 : '' ); + } + my $pkglist = join( ' ', @packages ); + return unless ( $pkglist ne '' ); + $installer->{installperl} =~ s/%PACKAGES%/$pkglist/gi; + } + print qq($installer->{installperl}\n) + if ( $installer->{debug} == 1 ); + $response = CpanInstall($installer); + } + elsif ( $cmd->{cmd} =~ /^uninstallperl (.+)/i ) { + my @packages = ''; + foreach my $package ( split / /, $1 ) { + next + unless ( $package =~ + /^(?:@([\w-]+)\/)?([\w\-\:]+)(?:@([\d\.=<>]+|latest))?$/ ); + push @packages, $2; + } + my $pkglist = join( ' ', @packages ); + return unless ( $pkglist ne '' ); + $installer->{uninstallperl} =~ s/%PACKAGES%/$pkglist/gi; + print qq($installer->{uninstallperl}\n) + if ( $installer->{debug} == 1 ); + $response = CpanUninstall($installer); + } + elsif ( lc( $cmd->{cmd} ) eq 'outdatedperl' ) { + print qq($installer->{outdatedperl}\n) + if ( $installer->{debug} == 1 ); + $response = CpanOutdated($installer); + } + elsif ( lc( $cmd->{cmd} ) eq 'getcpanversion' ) { + print qq($installer->{cpanversions}\n) + if ( $installer->{debug} == 1 ); + $response = GetCpanVersion($installer); + } + + return $response; +} + +sub GetCpanVersion($) { + my $cmd = shift; + my $h = {}; + local $ENV{PATH} = __GetExtendedEnvPath(); + my $p = `$cmd->{cpanversions}`; + + my $found = 0; + my $isConfig = 0; + my $isEnv = 0; + my $isInc = 0; + + if ( $p && $p ne '' ) { + foreach my $line ( split /\n/, $p ) { + chomp($line); + print qq($line\n) if ( $cmd->{debug} == 1 ); + + if ( $line =~ +/^cpanm (?:\([A-za-z:]+\) )?version (\d+\.\d+) (\([\w\/\.\-]+\)).*/i + ) + { + $h->{versions}{cpanminus} = $1; + $found = 1; + } + elsif ( $line =~ /^perl version (\d+\.\d+) (\([\w\/\.\-]+\)).*/i ) { + $h->{versions}{perl} = $1; + } + elsif ( $line =~ /^\s+\%Config:.*$/i ) { + $isConfig = 1; + } + elsif ( $line =~ /^\s+\%ENV:.*$/i ) { + $isConfig = 0; + $isEnv = 1; + } + elsif ( $line =~ /^\s+\@INC:.*$/i ) { + $isConfig = 0; + $isEnv = 0; + $isInc = 1; + } + elsif ($isConfig) { + $line =~ s/^\s+//g; + my @splitted = split( /=/, $line, 2 ); + $h->{versions}{Config}{ $splitted[0] } = $splitted[1]; + } + elsif ($isEnv) { + $line =~ s/^\s+//g; + my @splitted = split( /=/, $line, 2 ); + $h->{versions}{ENV}{ $splitted[0] } = $splitted[1]; + } + elsif ($isInc) { + $line =~ s/^\s+//g; + push @{ $h->{versions}{INC} }, $line + unless ( $line =~ /^.+=.+$/i ); + } + + # error + elsif ( !$found ) { + my $error = {}; + + if ( $line =~ + m/(?:(\w+?): )?(?:(\w+? \d+): )?(\w+?): [^:]*?not.found$/i + or $line =~ +m/(?:(\w+?): )?(?:(\w+? \d+): )?\w+?: [^:]*?not.found: (\S+)$/i + or $line =~ +m/(?:(\w+?): )?(?:(\w+? \d+): )?(\w+?): [^:]*?No.such.file.or.directory$/i + ) + { + $error->{code} = "E404"; + $error->{summary} = "Not Found - $3 is not installed"; + $error->{detail} = $line; + } + elsif ( $line =~ m/^sudo: /i ) { + my $error = {}; + my $runningUser = getpwuid($<); + my $cpanmbin = `which cpanm`; + my $perlbin = `which perl`; + $cpanmbin =~ s/\n//g; + $perlbin =~ s/\n//g; + $error->{code} = "E403"; + $error->{summary} = + "Forbidden - " . "passwordless sudo permissions required"; + $error->{detail} = + $line + . "

" + . "You may add the following lines to /etc/sudoers.d/$runningUser:\n" + . "
"
+                      . "  $runningUser ALL=(ALL) NOPASSWD:SETENV: "
+                      . $cpanmbin . " *"
+                      . "\n  $runningUser ALL=(ALL) NOPASSWD:SETENV: "
+                      . $perlbin
+                      . ' - App\:\:cpanminus'
+                      . "
"; + push @{ $h->{error} }, $error; + last; + } + else { + $error->{code} = "E501"; + $error->{summary} = "Parsing error"; + $error->{detail} = $p; + } + + push @{ $h->{error} }, $error; + last; + } + } + } + else { + my $error; + $error->{code} = "E500"; + $error->{summary} = "Unknown error - Missing command output"; + $error->{detail} = $p; + push @{ $h->{error} }, $error; + } + + # check for cpan-outdated + my $cpanoutdated = `which cpan-outdated`; + $h->{versions}{cpanoutdated} = 0 + if ( $cpanoutdated =~ /^\/.+/ ); + + return $h; +} + +sub CpanInstall($) { + my $cmd = shift; + my $h = {}; + local $ENV{PATH} = __GetExtendedEnvPath(); + eval { + umask 0022; + 1; + }; + my $p = `$cmd->{installperl}`; + + if ( $p && $p ne '' ) { + $h->{success} = 0; + + foreach my $line ( split /\n/, $p ) { + chomp($line); + print qq($line\n) if ( $cmd->{debug} == 1 ); + + if ( $line =~ + /^Successfully\s+(\S+)\s+([\S]+)-(\d+(?:\.\d+(?:_\d+)?)?).*$/i ) + { + my $r = $1; + my $m = $2; + my $v = $3; + $m =~ s/-/::/g; + $h->{installed}{$m}{result} = $r; + $h->{installed}{$m}{version} = $v; + $h->{success}++; + } + + elsif ( $line =~ + /^(\S+)\s+is\s+up\s+to\s+date.*\((\d+(?:\.\d+(?:_\d+)?)?)\).*$/i + ) + { + my $m = $1; + my $v = $2; + $h->{installed}{$m}{result} = 'existing'; + $h->{installed}{$m}{version} = $v; + $h->{success}++; + } + + elsif ( $line =~ /^(\d+)\s+(\S+)\s+(\S+)$/i ) { + + # ignore total result + } + + elsif ( $line =~ /^\!\s+(.+)$/i ) { + my $error = {}; + my $sum = $1; + $error->{code} = "E500"; + $error->{code} = "E404" if ( $sum =~ /^Couldn't find.*/i ); + $error->{summary} = $sum; + push @{ $h->{error} }, $error; + } + + elsif ( $line =~ + m/(?:(\w+?): )?(?:(\w+? \d+): )?(\w+?): [^:]*?not.found$/i + or $line =~ + m/(?:(\w+?): )?(?:(\w+? \d+): )?\w+?: [^:]*?not.found: (\S+)$/i + or $line =~ +m/(?:(\w+?): )?(?:(\w+? \d+): )?(\w+?): [^:]*?No.such.file.or.directory$/i + ) + { + my $error = {}; + $error->{code} = "E404"; + $error->{summary} = "Not Found - $3 is not installed"; + $error->{detail} = $line; + push @{ $h->{error} }, $error; + last; + } + + elsif ( $line =~ m/^curl:.*Failed writing body.*$/i ) { + my $error = {}; + my $runningUser = getpwuid($<); + my $cpanmbin = `which cpanm`; + my $perlbin = `which perl`; + $cpanmbin =~ s/\n//g; + $perlbin =~ s/\n//g; + $error->{code} = "E403"; + $error->{summary} = + "Forbidden - " . "passwordless sudo permissions required"; + $error->{detail} = + $line + . "

" + . "You may add the following lines to /etc/sudoers.d/$runningUser:\n" + . "
"
+                  . "  $runningUser ALL=(ALL) NOPASSWD:SETENV: "
+                  . $perlbin
+                  . ' - App\:\:cpanminus'
+                  . "
"; + push @{ $h->{error} }, $error; + last; + } + + elsif ( $line =~ m/^sudo: /i ) { + my $error = {}; + my $runningUser = getpwuid($<); + my $cpanmbin = `which cpanm`; + $cpanmbin =~ s/\n//g; + $error->{code} = "E403"; + $error->{summary} = + "Forbidden - " . "passwordless sudo permissions required"; + $error->{detail} = + $line + . "

" + . "You may add the following lines to /etc/sudoers.d/$runningUser:\n" + . "
"
+                  . "  $runningUser ALL=(ALL) NOPASSWD:SETENV: "
+                  . $cpanmbin . " *"
+                  . "
"; + push @{ $h->{error} }, $error; + last; + } + + else { + my $error = {}; + $error->{code} = "E501"; + $error->{summary} = "Parsing error"; + $error->{detail} = $line; + push @{ $h->{error} }, $error; + } + } + } + else { + my $error = {}; + $error->{code} = "E500"; + $error->{summary} = "Unknown error - Missing command output"; + $error->{detail} = $p; + push @{ $h->{error} }, $error; + } + + return $h; +} + +sub CpanUninstall($) { + my $cmd = shift; + my $h = {}; + local $ENV{PATH} = __GetExtendedEnvPath(); + my $p = `$cmd->{uninstallperl}`; + + if ( $p && $p ne '' ) { + $h->{success} = 0; + + foreach my $line ( split /\n/, $p ) { + chomp($line); + print qq($line\n) if ( $cmd->{debug} == 1 ); + next if ( $line eq '' ); + + if ( $line =~ /^Successfully\s+(\S+)\s+([\S]+).*$/i ) { + $h->{uninstalled}{$2}{result} = $1; + $h->{success}++; + } + + elsif ( $line =~ /^\!\s(\S+)\s+is\s+not\s+found.*$/i ) { + $h->{uninstalled}{$1}{result} = 'not installed'; + $h->{success}++; + } + + elsif ( $line =~ /^\!\s+(.+)$/i ) { + my $error = {}; + $error->{code} = "E500"; + $error->{summary} = $1; + push @{ $h->{error} }, $error; + } + + elsif ( $line =~ + m/(?:(\w+?): )?(?:(\w+? \d+): )?(\w+?): [^:]*?not.found$/i + or $line =~ + m/(?:(\w+?): )?(?:(\w+? \d+): )?\w+?: [^:]*?not.found: (\S+)$/i + or $line =~ +m/(?:(\w+?): )?(?:(\w+? \d+): )?(\w+?): [^:]*?No.such.file.or.directory$/i + ) + { + my $error = {}; + $error->{code} = "E404"; + $error->{summary} = "Not Found - $3 is not installed"; + $error->{detail} = $line; + push @{ $h->{error} }, $error; + last; + } + + elsif ( $line =~ m/^sudo: /i ) { + my $error = {}; + my $runningUser = getpwuid($<); + my $cpanmbin = `which cpanm`; + $cpanmbin =~ s/\n//g; + $error->{code} = "E403"; + $error->{summary} = + "Forbidden - " . "passwordless sudo permissions required"; + $error->{detail} = + $line + . "

" + . "You may add the following lines to /etc/sudoers.d/$runningUser:\n" + . "
"
+                  . "  $runningUser ALL=(ALL) NOPASSWD:SETENV: "
+                  . $cpanmbin . " *"
+                  . "
"; + push @{ $h->{error} }, $error; + last; + } + + elsif ( $line =~ m/^\s+.*$/ ) { + + # ignore lines that begin with spaces or are empty + } + + else { + my $error = {}; + $error->{code} = "E501"; + $error->{summary} = "Parsing error"; + $error->{detail} = $line; + push @{ $h->{error} }, $error; + } + } + } + else { + my $error = {}; + $error->{code} = "E500"; + $error->{summary} = "Unknown error - Missing command output"; + $error->{detail} = $p; + push @{ $h->{error} }, $error; + } + + return $h; +} + +sub CpanOutdated($) { + my $cmd = shift; + my $h = {}; + local $ENV{PATH} = __GetExtendedEnvPath(); + my $p = `$cmd->{outdatedperl}`; + + my $found = 0; + my $isConfig = 0; + my $isEnv = 0; + my $isInc = 0; + my $isOutdated = 0; + + if ( $p && $p ne '' ) { + foreach my $line ( split /\n/, $p ) { + chomp($line); + print qq($line\n) if ( $cmd->{debug} == 1 ); + + if ( $line =~ +/^cpanm (?:\([A-za-z:]+\) )?version (\d+\.\d+) (\([\w\/\.\-]+\)).*/i + ) + { + $h->{versions}{cpanminus} = $1; + $found = 1; + } + elsif ( $line =~ /^perl version (\d+\.\d+) (\([\w\/\.\-]+\)).*/i ) { + $h->{versions}{perl} = $1; + } + elsif ( $line =~ /^\s+\%Config:.*$/i ) { + $isConfig = 1; + } + elsif ( $line =~ /^\s+\%ENV:.*$/i ) { + $isConfig = 0; + $isEnv = 1; + } + elsif ( $line =~ /^\s+\@INC:.*$/i ) { + $isConfig = 0; + $isEnv = 0; + $isInc = 1; + } + elsif ( $line =~ /^\@Outdated:.*$/i ) { + $isConfig = 0; + $isEnv = 0; + $isInc = 0; + $isOutdated = 1; + } + elsif ($isConfig) { + $line =~ s/^\s+//g; + my @splitted = split( /=/, $line, 2 ); + $h->{versions}{Config}{ $splitted[0] } = $splitted[1]; + } + elsif ($isEnv) { + $line =~ s/^\s+//g; + my @splitted = split( /=/, $line, 2 ); + $h->{versions}{ENV}{ $splitted[0] } = $splitted[1]; + } + elsif ($isInc) { + $line =~ s/^\s+//g; + push @{ $h->{versions}{INC} }, $line; + } + elsif ($isOutdated) { + if ( $line =~ +/^([\w\:]+)\s+(\d+.\d+(?:_\d+)?)\s+(\d+.\d+(?:_\d+)?)\s+(\S+)$/ + ) + { + $h->{outdatedPerl}{$1}{current} = $2; + $h->{outdatedPerl}{$1}{latest} = $3; + } + else { + $found = 0; + } + } + + # error + if ( !$found ) { + my $error = {}; + my $runningUser = getpwuid($<); + if ( $line =~ + m/(?:(\w+?): )?(?:(\w+? \d+): )?(\w+?): [^:]*?not.found$/i + or $line =~ +m/(?:(\w+?): )?(?:(\w+? \d+): )?\w+?: [^:]*?not.found: (\S+)$/i + or $line =~ +m/(?:(\w+?): )?(?:(\w+? \d+): )?(\w+?): [^:]*?No.such.file.or.directory$/i + ) + { + $error->{code} = "E404"; + $error->{summary} = "Not Found - $3 is not installed"; + $error->{detail} = $line; + } + else { + $error->{code} = "E501"; + $error->{summary} = "Parsing error"; + $error->{detail} = $p; + } + push @{ $h->{error} }, $error; + last; + } + } + } + else { + my $error = {}; + $error->{code} = "E500"; + $error->{summary} = "Unknown error - Missing command output"; + $error->{detail} = $p; + push @{ $h->{error} }, $error; + } + + # check for cpan-outdated + my $cpanoutdated = `which cpan-outdated`; + $h->{versions}{cpanoutdated} = 0 + if ( $cpanoutdated =~ /^\/.+/ ); + + my ($ExtUtilsInstalled) = ExtUtils::Installed->new(); + my (@modules) = $ExtUtilsInstalled->modules(); + + foreach (@modules) { + next if ( $_ eq 'CPAN::outdated' ); + + my ($missing) = $ExtUtilsInstalled->validate($_); + my $version = $ExtUtilsInstalled->version($_); + $h->{listedPerl}{$_}{missing} = $missing if ($missing); + eval { + $h->{listedPerl}{$_}{version} = version->parse($version)->numify; + 1; + }; + if ($@) { + $h->{listedPerl}{$_}{version} = 0; + $@ = undef; + } + } + + return $h; +} + +#################################################### +# End Childprocess +#################################################### + +sub PreProcessing($$) { + + my ( $hash, $json ) = @_; + + my $name = $hash->{NAME}; + + my $decode_json = eval { decode_json($json) }; + if ($@) { + Log3 $name, 2, "Installer ($name) - JSON error: $@"; + return; + } + + Log3 $hash, 4, "Installer ($name) - JSON: $json"; + + if ( defined( $decode_json->{versions} ) + && defined( $decode_json->{versions}{cpanminus} ) ) + { + $hash->{".fhem"}{installer}{cpanversions} = + $decode_json->{versions}; + } + + # safe result in hidden reading + # to restore module state after reboot + if ( $hash->{".fhem"}{installer}{cmd} eq 'outdatedPerl' ) { + delete $hash->{".fhem"}{installer}{outdatedPerlPackages}; + $hash->{".fhem"}{installer}{outdatedPerlPackages} = + $decode_json->{outdatedPerl} + if ( defined( $decode_json->{outdatedPerl} ) ); + delete $hash->{".fhem"}{installer}{listedPerlPackages}; + $hash->{".fhem"}{installer}{listedPerlPackages} = + $decode_json->{listedPerl} + if ( defined( $decode_json->{listedPerl} ) ); + readingsSingleUpdate( $hash, '.packageListPerl', $json, 0 ); + } + elsif ( $hash->{".fhem"}{installer}{cmd} =~ /^install/ ) { + delete $hash->{".fhem"}{installer}{installedPerlPackages}; + $hash->{".fhem"}{installer}{installedPerlPackages} = $decode_json; + readingsSingleUpdate( $hash, '.installedListPerl', $json, 0 ); + } + elsif ( $hash->{".fhem"}{installer}{cmd} =~ /^uninstall/ ) { + delete $hash->{".fhem"}{installer}{uninstalledPerlPackages}; + $hash->{".fhem"}{installer}{uninstalledPerlPackages} = $decode_json; + readingsSingleUpdate( $hash, '.uninstalledListPerl', $json, 0 ); + } + elsif ( $hash->{".fhem"}{installer}{cmd} =~ /^update/ ) { + delete $hash->{".fhem"}{installer}{updatedPerlPackages}; + $hash->{".fhem"}{installer}{updatedPerlPackages} = $decode_json; + readingsSingleUpdate( $hash, '.updatedListPerl', $json, 0 ); + } + + if ( defined( $decode_json->{warning} ) + or defined( $decode_json->{error} ) ) + { + $hash->{".fhem"}{installer}{'warnings'} = $decode_json->{warning} + if ( defined( $decode_json->{warning} ) ); + $hash->{".fhem"}{installer}{errors} = $decode_json->{error} + if ( defined( $decode_json->{error} ) ); + } + else { + delete $hash->{".fhem"}{installer}{'warnings'}; + delete $hash->{".fhem"}{installer}{errors}; + } + + WriteReadings( $hash, $decode_json ); +} + +sub WriteReadings($$) { + + my ( $hash, $decode_json ) = @_; + + my $name = $hash->{NAME}; + my $updatePerlDualLifeModules = + AttrVal( $name, 'updatePerlDualLifeModules', 0 ); + my $updatePerlUsedModulesOnly = + AttrVal( $name, 'updatePerlUsedModulesOnly', 1 ); + + Log3 $hash, 4, "Installer ($name) - Write Readings"; + Log3 $hash, 5, "Installer ($name) - " . Dumper $decode_json; + + readingsBeginUpdate($hash); + + if ( $hash->{".fhem"}{installer}{cmd} eq 'outdatedPerl' ) { + readingsBulkUpdate( + $hash, + 'outdatedPerl', + ( + defined( $decode_json->{listedPerl} ) + ? 'check completed' + : 'check failed' + ) + ); + $hash->{helper}{lastSync} = __ToDay(); + } + + my $counter = 0; + if ( $hash->{".fhem"}{installer}{cmd} eq 'outdatedPerl' ) { + foreach ( keys %{ $decode_json->{outdatedPerl} } ) { + $counter++ + if ( + ( + $updatePerlDualLifeModules + || !FHEM::Meta::ModuleIsPerlCore($_) + ) + && ( !$updatePerlUsedModulesOnly + || defined( $FHEM::Meta::dependents{pkgs}{$_} ) ) + ); + } + readingsBulkUpdateIfChanged( $hash, 'updatesAvailablePerl', $counter ); + } + readingsBulkUpdateIfChanged( + $hash, + 'updateListAsJSON', + eval { + encode_json( $hash->{".fhem"}{installer}{outdatedPerlPackages} ); + } + ) if ( AttrVal( $name, 'updateListReading', 'none' ) ne 'none' ); + + my $result = 'successful'; + $result = 'error' if ( defined( $hash->{".fhem"}{installer}{errors} ) ); + $result = 'warning' + if ( defined( $hash->{".fhem"}{installer}{'warnings'} ) ); + + readingsBulkUpdate( $hash, 'installedPerl', $result ) + if ( $hash->{".fhem"}{installer}{cmd} =~ /^installperl /i ); + readingsBulkUpdate( $hash, 'uninstalledPerl', $result ) + if ( $hash->{".fhem"}{installer}{cmd} =~ /^uninstallperl /i ); + readingsBulkUpdate( $hash, 'updatedPerl', $result ) + if ( $hash->{".fhem"}{installer}{cmd} =~ /^updateperl /i ); + + readingsBulkUpdateIfChanged( $hash, "cpanminusVersion", + $decode_json->{versions}{cpanminus} ) + if ( defined( $decode_json->{versions} ) + && defined( $decode_json->{versions}{cpanminus} ) ); + + readingsBulkUpdateIfChanged( $hash, "perlVersion", + $decode_json->{versions}{perl} ) + if ( defined( $decode_json->{versions} ) + && defined( $decode_json->{versions}{perl} ) ); + + if ( defined( $decode_json->{error} ) ) { + readingsBulkUpdate( $hash, 'state', + 'error \'' . $hash->{".fhem"}{installer}{cmd} . '\'' ); + } + elsif ( defined( $decode_json->{warning} ) ) { + readingsBulkUpdate( $hash, 'state', + 'warning \'' . $hash->{".fhem"}{installer}{cmd} . '\'' ); + } + else { + if ( defined( $hash->{".fhem"}{installer}{outdatedPerlPackages} ) ) { + foreach ( + keys %{ $hash->{".fhem"}{installer}{outdatedPerlPackages} } ) + { + $counter++ + if ( + ( + $updatePerlDualLifeModules + || !FHEM::Meta::ModuleIsPerlCore($_) + ) + && ( !$updatePerlUsedModulesOnly + || defined( $FHEM::Meta::dependents{pkgs}{$_} ) ) + ); + } + } + + readingsBulkUpdate( + $hash, 'state', + ( + $counter + ? 'updates available' + : 'up to date' + ) + ); + } + + Event( $hash, "FINISH" ); + readingsEndUpdate( $hash, 1 ); + + ProcessUpdateTimer($hash) + if ( $hash->{".fhem"}{installer}{cmd} eq 'getCpanVersion' + && !defined( $decode_json->{error} ) ); +} + +sub CreateErrorList($) { + my $hash = shift; + my @ret; + my $errors; + my $html = + defined( $hash->{CL} ) && $hash->{CL}{TYPE} eq "FHEMWEB" ? 1 : 0; + $errors = $hash->{".fhem"}{installer}{errors}; + + # disable automatic links to FHEM devices + delete $FW_webArgs{addLinks}; + + my $header = ''; + my $footer = ''; + if ($html) { + $header = ''; + $footer = ''; + } + + my $blockOpen = ''; + my $tTitleOpen = ''; + my $tTitleClose = ''; + my $tOpen = ''; + my $tCOpen = ''; + my $tCClose = ''; + my $tHOpen = ''; + my $tHClose = ''; + my $tBOpen = ''; + my $tBClose = ''; + my $tFOpen = ''; + my $tFClose = ''; + my $trOpen = ''; + my $trOpenEven = ''; + my $trOpenOdd = ''; + my $thOpen = ''; + my $thOpen2 = ''; + my $thOpen3 = ''; + my $tdOpen = ''; + my $tdOpen2 = ''; + my $tdOpen3 = ''; + my $strongOpen = ''; + my $strongClose = ''; + my $tdClose = "\t\t\t"; + my $thClose = "\t\t\t"; + my $trClose = ''; + my $tClose = ''; + my $blockClose = ''; + my $colorRed = ''; + my $colorGreen = ''; + my $colorClose = ''; + + if ($html) { + $blockOpen = '
'; + $tTitleOpen = ''; + $tTitleClose = ''; + $tOpen = ''; + $tCOpen = ''; + $tHOpen = ''; + $tHClose = ''; + $tBOpen = ''; + $tBClose = ''; + $tFOpen = ''; + $tFClose = ''; + $trOpen = ''; + $trOpenEven = ''; + $trOpenOdd = ''; + $thOpen = ''; + $thClose = ''; + $trClose = ''; + $tClose = '
'; + $tCClose = '
'; + $thOpen2 = + ''; + $thOpen3 = + ''; + $tdOpen = ''; + $tdOpen2 = ''; + $tdOpen3 = ''; + $strongOpen = ''; + $strongClose = ''; + $tdClose = '
'; + $blockClose = '
'; + $colorRed = ''; + $colorGreen = ''; + $colorClose = ''; + } + + my $space = $html ? ' ' : ' '; + my $lb = $html ? '
' : "\n"; + my $lang = lc( + AttrVal( + $hash->{NAME}, 'language', + AttrVal( 'global', 'language', 'EN' ) + ) + ); + + my $FW_CSRF = ( + defined( $defs{ $hash->{CL}{SNAME} }{CSRFTOKEN} ) + ? '&fwcsrf=' . $defs{ $hash->{CL}{SNAME} }{CSRFTOKEN} + : '' + ); + + if ( ref($errors) eq "ARRAY" && scalar @{$errors} > 0 ) { + push @ret, + $blockOpen + . $tOpen + . $tCOpen + . 'Error List' + . $tCClose + . $tHOpen + . $trOpen; + + push @ret, $thOpen . 'No.' . $thClose; + push @ret, $thOpen . 'Error Code' . $thClose; + push @ret, $thOpen . 'Description' . $thClose; + push @ret, $trClose . $tHClose; + + my $linecount = 1; + foreach my $error ( sort { "\L$a" cmp "\L$b" } @{$errors} ) { + my $l = $linecount % 2 == 0 ? $trOpenEven : $trOpenOdd; + + $l .= $tdOpen . $linecount . $tdClose; + $l .= $tdOpen . $error->{code} . $tdClose; + $l .= + $tdOpen + . $error->{summary} + . ( + defined( $error->{detail} ) + && $error->{detail} ne '' + ? $lb + . $lb + . $strongOpen + . 'Detail:' + . $strongClose + . $lb + . $error->{detail} + : '' + ) . $tdClose; + $l .= $trClose; + + push @ret, $l; + $linecount++; + } + + push @ret, $tClose . $blockClose; + } + else { + push @ret, 'No errors occured during last command.'; + } + + return $header . join( "\n", @ret ) . $footer; +} + +sub CreateInstalledPerlList($$) { + my ( $hash, $getCmd ) = @_; + my @ret; + my $packages; + my $html = + defined( $hash->{CL} ) && $hash->{CL}{TYPE} eq "FHEMWEB" ? 1 : 0; + $packages = $hash->{".fhem"}{installer}{listedPerlPackages}; + + # disable automatic links to FHEM devices + delete $FW_webArgs{addLinks}; + + my $header = ''; + my $footer = ''; + if ($html) { + $header = ''; + $footer = ''; + } + + my $blockOpen = ''; + my $tTitleOpen = ''; + my $tTitleClose = ''; + my $tOpen = ''; + my $tCOpen = ''; + my $tCClose = ''; + my $tHOpen = ''; + my $tHClose = ''; + my $tBOpen = ''; + my $tBClose = ''; + my $tFOpen = ''; + my $tFClose = ''; + my $trOpen = ''; + my $trOpenEven = ''; + my $trOpenOdd = ''; + my $thOpen = ''; + my $thOpen2 = ''; + my $thOpen3 = ''; + my $tdOpen = ''; + my $tdOpen2 = ''; + my $tdOpen3 = ''; + my $strongOpen = ''; + my $strongClose = ''; + my $tdClose = "\t\t\t"; + my $thClose = "\t\t\t"; + my $trClose = ''; + my $tClose = ''; + my $blockClose = ''; + my $colorRed = ''; + my $colorGreen = ''; + my $colorClose = ''; + + if ($html) { + $blockOpen = '
'; + $tTitleOpen = ''; + $tTitleClose = ''; + $tOpen = ''; + $tCOpen = ''; + $tHOpen = ''; + $tHClose = ''; + $tBOpen = ''; + $tBClose = ''; + $tFOpen = ''; + $tFClose = ''; + $trOpen = ''; + $trOpenEven = ''; + $trOpenOdd = ''; + $thOpen = ''; + $thClose = ''; + $trClose = ''; + $tClose = '
'; + $tCClose = '
'; + $thOpen2 = + ''; + $thOpen3 = + ''; + $tdOpen = ''; + $tdOpen2 = ''; + $tdOpen3 = ''; + $strongOpen = ''; + $strongClose = ''; + $tdClose = '
'; + $blockClose = '
'; + $colorRed = ''; + $colorGreen = ''; + $colorClose = ''; + } + + my $space = $html ? ' ' : ' '; + my $lb = $html ? '
' : "\n"; + my $lang = lc( + AttrVal( + $hash->{NAME}, 'language', + AttrVal( 'global', 'language', 'EN' ) + ) + ); + + my $FW_CSRF = ( + defined( $defs{ $hash->{CL}{SNAME} }{CSRFTOKEN} ) + ? '&fwcsrf=' . $defs{ $hash->{CL}{SNAME} }{CSRFTOKEN} + : '' + ); + + if ( ref($packages) eq "HASH" && scalar keys %{$packages} > 0 ) { + push @ret, + $blockOpen + . $tOpen + . $tCOpen + . 'Installed Perl Packages' + . $tCClose + . $tHOpen + . $trOpen; + + push @ret, $thOpen . 'Name' . $thClose; + push @ret, $thOpen . 'Version' . $thClose; + push @ret, $trClose . $tHClose; + + my $linecount = 1; + foreach my $package ( sort { "\L$a" cmp "\L$b" } keys %{$packages} ) { + next if ( $package eq "undefined" ); + + my $l = $linecount % 2 == 0 ? $trOpenEven : $trOpenOdd; + + $l .= $tdOpen . $package . $tdClose; + $l .= $tdOpen + . ( + defined( $packages->{$package}{version} ) + && $packages->{$package}{version} + ? $packages->{$package}{version} + : '?' + ) . $tdClose; + $l .= $trClose; + + push @ret, $l; + $linecount++; + } + + push @ret, $tClose . $blockClose; + } + else { + push @ret, 'No installed Perl packages found.'; + } + + return $header . join( "\n", @ret ) . $footer; +} + +sub CreateOutdatedPerlList($$) { + my ( $hash, $getCmd ) = @_; + my @ret; + my $packages; + my $html = + defined( $hash->{CL} ) && $hash->{CL}{TYPE} eq "FHEMWEB" ? 1 : 0; + $packages = $hash->{".fhem"}{installer}{outdatedPerlPackages}; + + # disable automatic links to FHEM devices + delete $FW_webArgs{addLinks}; + + my $header = ''; + my $footer = ''; + if ($html) { + $header = ''; + $footer = ''; + } + + my $blockOpen = ''; + my $tTitleOpen = ''; + my $tTitleClose = ''; + my $tOpen = ''; + my $tCOpen = ''; + my $tCClose = ''; + my $tHOpen = ''; + my $tHClose = ''; + my $tBOpen = ''; + my $tBClose = ''; + my $tFOpen = ''; + my $tFClose = ''; + my $trOpen = ''; + my $trOpenEven = ''; + my $trOpenOdd = ''; + my $thOpen = ''; + my $thOpen2 = ''; + my $thOpen3 = ''; + my $tdOpen = ''; + my $tdOpen2 = ''; + my $tdOpen3 = ''; + my $strongOpen = ''; + my $strongClose = ''; + my $tdClose = "\t\t\t"; + my $thClose = "\t\t\t"; + my $trClose = ''; + my $tClose = ''; + my $blockClose = ''; + my $colorRed = ''; + my $colorGreen = ''; + my $colorClose = ''; + + if ($html) { + $blockOpen = '
'; + $tTitleOpen = ''; + $tTitleClose = ''; + $tOpen = ''; + $tCOpen = ''; + $tHOpen = ''; + $tHClose = ''; + $tBOpen = ''; + $tBClose = ''; + $tFOpen = ''; + $tFClose = ''; + $trOpen = ''; + $trOpenEven = ''; + $trOpenOdd = ''; + $thOpen = ''; + $thClose = ''; + $trClose = ''; + $tClose = '
'; + $tCClose = '
'; + $thOpen2 = + ''; + $thOpen3 = + ''; + $tdOpen = ''; + $tdOpen2 = ''; + $tdOpen3 = ''; + $strongOpen = ''; + $strongClose = ''; + $tdClose = '
'; + $blockClose = '
'; + $colorRed = ''; + $colorGreen = ''; + $colorClose = ''; + } + + my $space = $html ? ' ' : ' '; + my $lb = $html ? '
' : "\n"; + my $lang = lc( + AttrVal( + $hash->{NAME}, 'language', + AttrVal( 'global', 'language', 'EN' ) + ) + ); + + my $FW_CSRF = ( + defined( $defs{ $hash->{CL}{SNAME} }{CSRFTOKEN} ) + ? '&fwcsrf=' . $defs{ $hash->{CL}{SNAME} }{CSRFTOKEN} + : '' + ); + + if ( ref($packages) eq "HASH" ) { + my $updatePerlDualLifeModules = + AttrVal( $hash->{NAME}, 'updatePerlDualLifeModules', 0 ); + my $updatePerlUsedModulesOnly = + AttrVal( $hash->{NAME}, 'updatePerlUsedModulesOnly', 1 ); + + my $counter = 0; + foreach ( keys %{$packages} ) { + $counter++ + if ( + ( + $updatePerlDualLifeModules + || !FHEM::Meta::ModuleIsPerlCore($_) + ) + && ( !$updatePerlUsedModulesOnly + || defined( $FHEM::Meta::dependents{pkgs}{$_} ) ) + ); + } + + if ($counter) { + push @ret, + $blockOpen + . $tOpen + . $tCOpen + . 'Outdated Perl Packages' + . $tCClose + . $tHOpen + . $trOpen; + + push @ret, $thOpen . 'Name' . $thClose; + push @ret, $thOpen . 'Current Version' . $thClose; + push @ret, $thOpen . 'Latest Version' . $thClose; + push @ret, $trClose . $tHClose; + + my $linecount = 1; + foreach my $package ( sort { "\L$a" cmp "\L$b" } keys %{$packages} ) + { + next if ( $package eq "undefined" ); + next + if ( + ( + !$updatePerlDualLifeModules + && FHEM::Meta::ModuleIsPerlCore($package) + ) + || ( $updatePerlUsedModulesOnly + && !defined( $FHEM::Meta::dependents{pkgs}{$package} ) ) + ); + + my $l = $linecount % 2 == 0 ? $trOpenEven : $trOpenOdd; + $l .= $tdOpen . $package . $tdClose; + $l .= $tdOpen + . ( + defined( $packages->{$package}{current} ) + ? $packages->{$package}{current} + : '?' + ) . $tdClose; + $l .= $tdOpen + . ( + defined( $packages->{$package}{latest} ) + ? $packages->{$package}{latest} + : '?' + ) . $tdClose; + $l .= $trClose; + + push @ret, $l; + $linecount++; + } + } + else { + push @ret, 'No outdated Perl packages found.' + + } + } + + return $header . join( "\n", @ret ) . $footer; +} + +sub CreatePrereqsList { + my $hash = shift; + my $getCmd = shift; + my $cfgfile = shift; + my $mode = + ( $cfgfile && $cfgfile eq '1' ? 'all' : ( $cfgfile ? 'file' : 'live' ) ); + $mode = 'list' if ( $cfgfile && defined( $modules{$cfgfile} ) ); + + my @defined; + if ( $mode eq 'live' || $mode eq 'all' ) { + foreach ( keys %modules ) { + next + unless ( $mode eq 'all' || defined( $modules{$_}{LOADED} ) ); + push @defined, $_; + } + } + elsif ( $mode eq 'file' ) { + @defined = __GetDefinedModulesFromFile($cfgfile); + return + 'File ' + . $cfgfile + . ' does not seem to contain any FHEM device configuration' + unless ( @defined > 0 ); + } + elsif ( $mode eq 'list' ) { + @defined = @_; + unshift @defined, $cfgfile; + } + + # disable automatic links to FHEM devices + delete $FW_webArgs{addLinks}; + + my @ret; + my $html = + defined( $hash->{CL} ) && $hash->{CL}{TYPE} eq "FHEMWEB" ? 1 : 0; + + my $header = ''; + my $footer = ''; + if ($html) { + $header = ''; + $footer = ''; + } + + my $blockOpen = ''; + my $tTitleOpen = ''; + my $tTitleClose = ''; + my $tOpen = ''; + my $tCOpen = ''; + my $tCClose = ''; + my $tHOpen = ''; + my $tHClose = ''; + my $tBOpen = ''; + my $tBClose = ''; + my $tFOpen = ''; + my $tFClose = ''; + my $trOpen = ''; + my $trOpenEven = ''; + my $trOpenOdd = ''; + my $thOpen = ''; + my $thOpen2 = ''; + my $thOpen3 = ''; + my $tdOpen = ''; + my $tdOpen1 = ''; + my $tdOpen2 = ''; + my $tdOpen3 = ''; + my $tdOpen4 = ''; + my $strongOpen = ''; + my $strongClose = ''; + my $tdClose = "\t\t\t"; + my $thClose = "\t\t\t"; + my $trClose = ''; + my $tClose = ''; + my $blockClose = ''; + my $colorRed = ''; + my $colorGreen = ''; + my $colorClose = ''; + + if ($html) { + $blockOpen = '
'; + $tTitleOpen = ''; + $tTitleClose = ''; + $tOpen = ''; + $tCOpen = ''; + $tHOpen = ''; + $tHClose = ''; + $tBOpen = ''; + $tBClose = ''; + $tFOpen = ''; + $tFClose = ''; + $trOpen = ''; + $trOpenEven = ''; + $trOpenOdd = ''; + $thOpen = ''; + $thClose = ''; + $trClose = ''; + $tClose = '
'; + $tCClose = '
'; + $thOpen2 = + ''; + $thOpen3 = + ''; + $tdOpen = ''; + $tdOpen1 = ''; + $tdOpen2 = ''; + $tdOpen3 = ''; + $tdOpen4 = ''; + $strongOpen = ''; + $strongClose = ''; + $tdClose = '
'; + $blockClose = '
'; + $colorRed = ''; + $colorGreen = ''; + $colorClose = ''; + } + + my $space = $html ? ' ' : ' '; + my $lb = $html ? '
' : "\n"; + my $lang = lc( + AttrVal( + $hash->{NAME}, 'language', + AttrVal( 'global', 'language', 'EN' ) + ) + ); + + my $FW_CSRF = ( + defined( $defs{ $hash->{CL}{SNAME} }{CSRFTOKEN} ) + ? '&fwcsrf=' . $defs{ $hash->{CL}{SNAME} }{CSRFTOKEN} + : '' + ); + + ######## + # Getting Perl prereqs + LoadInstallStatusPerl( $defined[0] eq '1' ? 1 : \@defined ); + + my $found = 0; + my $foundRequired = 0; + my $foundRecommended = 0; + my $foundSuggested = 0; + my $foundRequiredPerl = 0; + my $foundRecommendedPerl = 0; + my $foundSuggestedPerl = 0; + my $foundRequiredNodejs = 0; + my $foundRecommendedNodejs = 0; + my $foundSuggestedNodejs = 0; + my $foundRequiredPython = 0; + my $foundRecommendedPython = 0; + my $foundSuggestedPython = 0; + + # Display prereqs + foreach my $mAttr (qw(required recommended suggested)) { + foreach my $area (qw(Perl Node.js Python)) { + next + unless ( defined( $pkgStatus{$mAttr} ) + && defined( $pkgStatus{$mAttr}{$area} ) + && keys %{ $pkgStatus{$mAttr}{$area} } > 0 ); + + my $linecount = 1; + my $importance = ucfirst($mAttr); + + foreach my $item ( + sort { "\L$a" cmp "\L$b" } + keys %{ $pkgStatus{$mAttr}{$area} } + ) + { + my $linkmod = ''; + my $inScope = 0; + foreach my $modName ( sort { "\L$a" cmp "\L$b" } + @{ $pkgStatus{$mAttr}{$area}{$item}{modules} } ) + { + # check if this package is used by any + # module that is in install scope + if ( grep ( /^$modName$/, @defined ) ) { + $inScope = 1; + } + + $linkmod .= ', ' unless ( $linkmod eq '' ); + if ($html) { + $linkmod .= + '' + . ( $modName eq 'Global' ? 'FHEM' : $modName ) + . ''; + } + else { + $linkmod .= + ( $modName eq 'Global' ? 'FHEM' : $modName ); + } + } + next unless ($inScope); + + $found++; + $foundRequired++ if ( $mAttr eq 'required' ); + $foundRecommended++ if ( $mAttr eq 'recommended' ); + $foundSuggested++ if ( $mAttr eq 'suggested' ); + $foundRequiredPerl++ + if ( $area eq 'Perl' && $mAttr eq 'required' ); + $foundRecommendedPerl++ + if ( $area eq 'Perl' && $mAttr eq 'recommended' ); + $foundSuggestedPerl++ + if ( $area eq 'Perl' && $mAttr eq 'suggested' ); + $foundRequiredNodejs++ + if ( $area eq 'Node.js' && $mAttr eq 'required' ); + $foundRecommendedNodejs++ + if ( $area eq 'Node.js' && $mAttr eq 'recommended' ); + $foundSuggestedNodejs++ + if ( $area eq 'Node.js' && $mAttr eq 'suggested' ); + $foundRequiredPython++ + if ( $area eq 'Python' && $mAttr eq 'required' ); + $foundRecommendedPython++ + if ( $area eq 'Python' && $mAttr eq 'recommended' ); + $foundSuggestedPython++ + if ( $area eq 'Python' && $mAttr eq 'suggested' ); + + my $l = $linecount % 2 == 0 ? $trOpenEven : $trOpenOdd; + + my $linkitem = $item; + $linkitem = + '' + . $item . '' + if ($html); + + my $action = + '
Install
'; + + $l .= + $tdOpen + . $linkitem + . ( + $pkgStatus{$mAttr}{$area}{$item}{status} eq 'outdated' + ? ' (wanted version: ' + . $pkgStatus{$mAttr}{$area}{$item}{version} . ')' + : '' + ) . $tdClose; + $l .= $tdOpen . $area . $tdClose; + $l .= $tdOpen . $linkmod . $tdClose; + $l .= $tdOpen . $action . $tdClose if ($html); + $l .= $trClose; + + if ( $linecount == 1 ) { + push @ret, + $trOpen + . $tdOpen + . ( + $html + ? '' + : '' + ) + . $blockOpen + . $tOpen + . $tCOpen + . $importance + . $tCClose; + + push @ret, $tHOpen . $trOpen; + push @ret, $thOpen . 'Item' . $thClose; + push @ret, $thOpen . 'Type' . $thClose; + push @ret, $thOpen . 'Used by' . $thClose; + push @ret, $thOpen . 'Action' . $thClose if ($html); + push @ret, $trClose . $tHClose . $tBOpen; + } + + push @ret, $l; + $linecount++; + } + + if ( $linecount > 1 ) { + + my $action = + '
Install ' + . $mAttr . ' ' + . ucfirst($area) + . '
'; + push @ret, + ( $linecount % 2 == 0 ? $trOpenEven : $trOpenOdd ) + . $tdOpen3 + . $tdClose + . $tdOpen1 + . $action + . $tdClose + . $trClose + if ($html); + + push @ret, $tBClose; + + my $descr = + 'Required dependencies ' + . $strongOpen . 'must' + . $strongClose + . ' be installed for the listed FHEM modules to work.'; + $descr = + 'Recommended dependencies are ' + . $strongOpen + . 'strongly encouraged' + . $strongClose + . ' and should be installed for full functionality of the listed FHEM modules, except in resource constrained environments.' + if ( $importance eq 'Recommended' ); + $descr = + 'Suggested dependencies are ' + . $strongOpen + . 'optional' + . $strongClose + . ', but are suggested for enhanced operation of the listed FHEM modules.' + if ( $importance eq 'Suggested' ); + + push @ret, + $tFOpen . ( $html ? $tdOpen4 : $tdOpen3 ) . $descr . $tFClose; + push @ret, $tClose . $blockClose . $tdClose . $trClose; + } + } + } + + if ($found) { + push @ret, $tBClose; + + if ( defined( $pkgStatus{Perl}{analyzed} ) ) { + push @ret, + $tFOpen + . $trOpen + . $tdOpen + . $strongOpen . 'Hint:' + . $strongClose + . ' Some of the FHEM modules in use do not provide Perl prerequisites from its metadata.' + . $lb; + + if ( $pkgStatus{Perl}{analyzed} == 1 ) { + push @ret, +'This check is based on automatic source code analysis and can be incorrect.' + . ' Suggested Perl items may still be required if the module author had decided to implement some own dependency and/or error handling like returning an informative message instead of the original Perl error message.'; + } + elsif ( $pkgStatus{Perl}{analyzed} == 2 ) { + push @ret, + 'This check may be incomplete until you ' + . ( + $html + ? 'click here to install Perl::PrereqScanner::NotQuiteLite ' + : 'install Perl::PrereqScanner::NotQuiteLite ' + ) . 'for automatic source code analysis.'; + } + + push @ret, $tdClose . $trClose . $tFClose; + } + + unshift @ret, $lb . $lb . $tdClose . $trClose; + + unshift @ret, + $lb + . $space + . $space + . ( $html ? '' : '' ) + . $foundSuggested + . ' suggested ' + . ( $foundSuggested > 1 ? 'items' : 'item' ) + . ( $html ? '' : '' ) + if ($foundSuggested); + unshift @ret, + $lb + . $space + . $space + . ( $html ? '' : '' ) + . $foundRecommended + . ' recommended ' + . ( $foundRecommended > 1 ? 'items' : 'item' ) + . ( $html ? '' : '' ) + if ($foundRecommended); + unshift @ret, + $lb + . $space + . $space + . ( $html ? '' : '' ) + . $foundRequired + . ' required ' + . ( $foundRequired > 1 ? 'items' : 'item' ) + . ( $html ? '' : '' ) + if ($foundRequired); + unshift @ret, + $found + . ' total missing ' + . ( $found > 1 ? 'prerequisites:' : 'prerequisite:' ); + + unshift @ret, $blockOpen . $blockClose; + unshift @ret, $tBOpen . $trOpen . $tdOpen; + } + else { + my @hooray = ( + 'hooray', 'hurray', 'phew', 'woop woop', + 'woopee', 'wow', 'yay', 'yippie', + ); + my $x = 0 + int( rand( scalar @hooray + 1 - 0 ) ); + unshift @ret, + $tBOpen + . $trOpen + . $tdOpen + . $lb + . ucfirst( $hooray[$x] ) + . '! All prerequisites are met.' + . ( $html ? ' 🥳' : '' ) + . $lb + . $lb + . $tdClose + . $trClose + . $tBClose; + } + + push @ret, $tClose . $blockClose; + + unshift @ret, + $blockOpen + . $blockClose + . ( $html ? '' : '' ) + . $blockOpen + . $tTitleOpen + . ( $mode eq 'live' ? 'Live ' : '' ) + . 'System Prerequisites Check' + . $tTitleClose + . $tOpen; + + return $header . join( "\n", @ret ) . $footer; +} + +sub CreateSearchList ($$@) { + my $hash = shift; + my $getCmd = shift; + my $search = join( '\s*', @_ ); + $search = '.+' unless ($search); + + # disable automatic links to FHEM devices + delete $FW_webArgs{addLinks}; + + my @ret; + my $html = + defined( $hash->{CL} ) && $hash->{CL}{TYPE} eq "FHEMWEB" ? 1 : 0; + + my $FW_CSRF = ( + defined( $defs{ $hash->{CL}{SNAME} }{CSRFTOKEN} ) + ? '&fwcsrf=' . $defs{ $hash->{CL}{SNAME} }{CSRFTOKEN} + : '' + ); + my $FW_CSRF_input = + defined( $defs{ $hash->{CL}{SNAME} }{CSRFTOKEN} ) + ? '' + : ''; + + my $header = ''; + my $footer = ''; + if ($html) { + $header = ''; + $footer = ''; + } + + my $blockOpen = ''; + my $tTitleOpen = ''; + my $tTitleClose = ''; + my $tOpen = ''; + my $tCOpen = ''; + my $tCClose = ''; + my $tHOpen = ''; + my $tHClose = ''; + my $tBOpen = ''; + my $tBClose = ''; + my $tFOpen = ''; + my $tFClose = ''; + my $trOpen = ''; + my $trOpenEven = ''; + my $trOpenOdd = ''; + my $thOpen = ''; + my $thOpen2 = ''; + my $thOpen3 = ''; + my $tdOpen = ''; + my $tdOpen2 = ''; + my $tdOpen3 = ''; + my $strongOpen = ''; + my $strongClose = ''; + my $tdClose = "\t\t\t"; + my $thClose = "\t\t\t"; + my $trClose = ''; + my $tClose = ''; + my $blockClose = ''; + my $colorRed = ''; + my $colorGreen = ''; + my $colorClose = ''; + + if ($html) { + $blockOpen = '
'; + $tTitleOpen = ''; + $tTitleClose = ''; + $tOpen = ''; + $tCOpen = ''; + $tHOpen = ''; + $tHClose = ''; + $tBOpen = ''; + $tBClose = ''; + $tFOpen = ''; + $tFClose = ''; + $trOpen = ''; + $trOpenEven = ''; + $trOpenOdd = ''; + $thOpen = ''; + $thClose = ''; + $trClose = ''; + $tClose = '
'; + $tCClose = '
'; + $thOpen2 = + ''; + $thOpen3 = + ''; + $tdOpen = ''; + $tdOpen2 = ''; + $tdOpen3 = ''; + $strongOpen = ''; + $strongClose = ''; + $tdClose = '
'; + $blockClose = '
'; + $colorRed = ''; + $colorGreen = ''; + $colorClose = ''; + } + + my $space = $html ? ' ' : ' '; + my $lb = $html ? '
' : "\n"; + my $lang = lc( + AttrVal( + $hash->{NAME}, 'language', + AttrVal( 'global', 'language', 'EN' ) + ) + ); + + # Add search input + $header .= + '
' + . '
' + . $FW_CSRF_input + . '' + . '' + . '' + . '
' + . '
← back to FHEM Installer
' + . '
'; + + my $found = 0; + + # search for matching device + my $foundDevices = 0; + my $linecount = 1; + foreach my $device ( sort { "\L$a" cmp "\L$b" } keys %defs ) { + next + unless ( defined( $defs{$device}{TYPE} ) + && !defined( $defs{$device}{TEMPORARY} ) + && defined( $modules{ $defs{$device}{TYPE} } ) ); + + if ( $device =~ m/^.*$search.*$/i ) { + unless ($foundDevices) { + push @ret, + ( $html ? '' : '' ) + . $blockOpen + . $tOpen + . $tCOpen + . 'Devices' + . $tCClose + . $tHOpen + . $trOpen; + + push @ret, $thOpen . 'Device Name' . $thClose; + push @ret, $thOpen . 'Device Type' . $thClose; + push @ret, $thOpen . 'Device State' . $thClose; + push @ret, $trClose . $tHClose; + } + $found++; + $foundDevices++; + + my $l = $linecount % 2 == 0 ? $trOpenEven : $trOpenOdd; + + FHEM::Meta::Load( $defs{$device}{TYPE} ); + + my $linkDev = $device; + $linkDev = + '' + . $device . '' + if ($html); + + my $linkMod = $defs{$device}{TYPE}; + $linkMod = + '' + . $defs{$device}{TYPE} . '' + if ($html); + + $l .= $tdOpen . $linkDev . $tdClose; + $l .= $tdOpen . $linkMod . $tdClose; + $l .= $tdOpen + . ( + defined( $defs{$device}{STATE} ) + ? $defs{$device}{STATE} + : '' + ) . $tdClose; + + $l .= $trClose; + + push @ret, $l; + $linecount++; + } + } + push @ret, $tClose . $blockClose if ($foundDevices); + + # search for matching module + my $foundModules = 0; + $linecount = 1; + foreach my $module ( sort { "\L$a" cmp "\L$b" } keys %modules ) { + if ( $module =~ m/^.*$search.*$/i ) { + unless ($foundModules) { + push @ret, + ( $html ? '' : '' ) + . $blockOpen + . $tOpen + . $tCOpen + . 'Modules' + . $tCClose + . $tHOpen + . $trOpen; + + push @ret, $thOpen . 'Module Name' . $thClose; + push @ret, $thOpen . 'Abstract' . $thClose; + push @ret, $trClose . $tHClose; + } + $found++; + $foundModules++; + + my $l = $linecount % 2 == 0 ? $trOpenEven : $trOpenOdd; + + FHEM::Meta::Load($module); + + my $abstract = ''; + $abstract = $modules{$module}{META}{abstract} + if ( defined( $modules{$module}{META} ) + && defined( $modules{$module}{META}{abstract} ) ); + + my $link = $module; + $link = + '' + . $module . '' + if ($html); + + $l .= $tdOpen . $link . $tdClose; + $l .= $tdOpen . ( $abstract eq 'n/a' ? '' : $abstract ) . $tdClose; + + $l .= $trClose; + + push @ret, $l; + $linecount++; + } + } + push @ret, $tClose . $blockClose if ($foundModules); + + # search for matching module + my $foundPackages = 0; + $linecount = 1; + foreach my $package ( sort { "\L$a" cmp "\L$b" } keys %packages ) { + if ( $package =~ m/^.*$search.*$/i ) { + unless ($foundPackages) { + push @ret, + ( $html ? '' : '' ) + . $blockOpen + . $tOpen + . $tCOpen + . 'Packages' + . $tCClose + . $tHOpen + . $trOpen; + + push @ret, $thOpen . 'Package Name' . $thClose; + push @ret, $thOpen . 'Abstract' . $thClose; + push @ret, $trClose . $tHClose; + } + $found++; + $foundPackages++; + + my $l = $linecount % 2 == 0 ? $trOpenEven : $trOpenOdd; + + FHEM::Meta::Load($package); + + my $abstract = ''; + $abstract = $packages{$package}{META}{abstract} + if ( defined( $packages{$package}{META} ) + && defined( $packages{$package}{META}{abstract} ) ); + + my $link = $package; + $link = + '' + . $package . '' + if ($html); + + $l .= $tdOpen . $link . $tdClose; + $l .= $tdOpen . ( $abstract eq 'n/a' ? '' : $abstract ) . $tdClose; + + $l .= $trClose; + + push @ret, $l; + $linecount++; + } + } + push @ret, $tClose . $blockClose if ($foundPackages); + + # search for matching keyword + my $foundKeywords = 0; + $linecount = 1; + foreach + my $keyword ( sort { "\L$a" cmp "\L$b" } keys %FHEM::Meta::keywords ) + { + if ( $keyword =~ m/^.*$search.*$/i ) { + push @ret, '' + unless ($foundKeywords); + $found++; + $foundKeywords++; + + my $descr = FHEM::Meta::GetKeywordDesc( $keyword, $lang ); + + push @ret, $blockOpen . $tOpen; + + if ($html) { + push @ret, + '# ' + . $keyword + . $tCClose; + } + else { + push @ret, '# ' . $keyword; + } + + my @mAttrs = qw( + modules + packages + ); + + push @ret, $tHOpen . $trOpen; + + push @ret, $thOpen . 'Name' . $thClose; + + push @ret, $thOpen . 'Type' . $thClose; + + push @ret, $thOpen . 'Abstract' . $thClose; + + push @ret, $trClose . $tHClose; + + foreach my $mAttr (@mAttrs) { + next + unless ( defined( $FHEM::Meta::keywords{$keyword}{$mAttr} ) + && @{ $FHEM::Meta::keywords{$keyword}{$mAttr} } > 0 ); + + foreach my $item ( sort { "\L$a" cmp "\L$b" } + @{ $FHEM::Meta::keywords{$keyword}{$mAttr} } ) + { + my $l = $linecount % 2 == 0 ? $trOpenEven : $trOpenOdd; + + my $type = $mAttr; + $type = 'Module' if ( $mAttr eq 'modules' ); + $type = 'Package' if ( $mAttr eq 'packages' ); + + FHEM::Meta::Load($item); + + my $abstract = ''; + $abstract = $modules{$item}{META}{abstract} + if ( defined( $modules{$item} ) + && defined( $modules{$item}{META} ) + && defined( $modules{$item}{META}{abstract} ) ); + + my $link = $item; + $link = + '' + . $item . '' + if ($html); + + $l .= $tdOpen . $link . $tdClose; + $l .= $tdOpen . $type . $tdClose; + $l .= + $tdOpen + . ( $abstract eq 'n/a' ? '' : $abstract ) + . $tdClose; + + $l .= $trClose; + + push @ret, $l; + $linecount++; + } + } + + push @ret, $tClose . $blockClose; + } + } + + # search for matching maintainer + my $foundMaintainers = 0; + $linecount = 1; + foreach my $maintainer ( + sort { "\L$a" cmp "\L$b" } + keys %FHEM::Meta::maintainers + ) + { + if ( $maintainer =~ m/^.*$search.*$/i ) { + unless ($foundMaintainers) { + push @ret, + $blockOpen + . $tOpen + . $tCOpen + . ( $html ? '' : '' ) + . 'Authors & Maintainers' + . $tCClose + . $tHOpen + . $trOpen; + + push @ret, $thOpen . 'Name' . $thClose; + push @ret, $thOpen . 'Modules' . $thClose; + push @ret, $thOpen . 'Packages' . $thClose; + push @ret, $trClose . $tHClose; + } + $found++; + $foundMaintainers++; + + my $l = $linecount % 2 == 0 ? $trOpenEven : $trOpenOdd; + + my $mods = ''; + if ( defined( $FHEM::Meta::maintainers{$maintainer}{modules} ) ) { + my $counter = 0; + foreach my $mod ( sort { "\L$a" cmp "\L$b" } + @{ $FHEM::Meta::maintainers{$maintainer}{modules} } ) + { + if ($html) { + $mods .= '
' if ($counter); + $mods .= + '' + . $mod . ''; + } + else { + $mods .= "\n" unless ($counter); + $mods .= $mod; + } + $counter++; + } + } + my $pkgs = ''; + if ( defined( $FHEM::Meta::maintainers{$maintainer}{packages} ) ) { + my $counter = 0; + foreach my $pkg ( sort { "\L$a" cmp "\L$b" } + @{ $FHEM::Meta::maintainers{$maintainer}{packages} } ) + { + if ($html) { + $pkgs .= '
' if ($counter); + $pkgs .= + '' + . $pkg . ''; + } + else { + $pkgs .= "\n" unless ($counter); + $pkgs .= $pkg; + } + $counter++; + } + } + + $l .= $tdOpen . $maintainer . $tdClose; + $l .= $tdOpen . $mods . $tdClose; + $l .= $tdOpen . $pkgs . $tdClose; + + $l .= $trClose; + + push @ret, $l; + $linecount++; + } + } + push @ret, $tClose . $blockClose if ($foundMaintainers); + + # search for matching Perl package + my $foundPerl = 0; + $linecount = 1; + foreach my $dependent ( + sort { "\L$a" cmp "\L$b" } + keys %{ $FHEM::Meta::dependents{pkgs} } + ) + { + next if ( FHEM::Meta::ModuleIsPerlCore($dependent) ); + next if ( FHEM::Meta::ModuleIsInternal($dependent) ); + + if ( $dependent =~ m/^.*$search.*$/i ) { + unless ($foundPerl) { + push @ret, + $blockOpen + . $tOpen + . $tCOpen + . ( $html ? '' : '' ) + . 'Perl Packages' + . $tCClose + . $tHOpen + . $trOpen; + + push @ret, $thOpen . 'Name' . $thClose; + push @ret, $thOpen . 'Referenced from' . $thClose; + push @ret, $trClose . $tHClose; + } + $found++; + $foundPerl++; + + my $l = $linecount % 2 == 0 ? $trOpenEven : $trOpenOdd; + + my $references = ''; + my $counter = 0; + foreach my $pkgReq (qw(requires recommends suggests)) { + next + unless ( + defined( + $FHEM::Meta::dependents{pkgs}{$dependent}{$pkgReq} + ) + ); + + foreach my $mod ( sort { "\L$a" cmp "\L$b" } + @{ $FHEM::Meta::dependents{pkgs}{$dependent}{$pkgReq} } ) + { + if ($html) { + $references .= '
' if ($counter); + $references .= + '' + . $mod . ''; + } + else { + $references .= "\n" unless ($counter); + $references .= $mod; + } + $counter++; + } + } + + $l .= $tdOpen . $dependent . $tdClose; + $l .= $tdOpen . $references . $tdClose; + + $l .= $trClose; + + push @ret, $l; + $linecount++; + } + } + push @ret, $tClose . $blockClose if ($foundPerl); + + #TODO works only if fhem.pl patch was accepted: + # https://forum.fhem.de/index.php/topic,98937.0.html + if ( defined( $hash->{CL} ) + && defined( $hash->{CL}{'.iDefCmdMethod'} ) + && $hash->{CL}{'.iDefCmdMethod'} eq 'always' ) + { + my $cmdO = $hash->{CL}{'.iDefCmdOrigin'}; + + if ( defined( $cmds{$cmdO} ) + && defined( $hash->{CL}{'.iDefCmdOverwrite'} ) + && $hash->{CL}{'.iDefCmdOverwrite'} ) + { + my $cmd = $search; + $cmd =~ s/^$cmdO//; + $cmd = $cmdO . '!' . ( $cmd && $cmd ne '' ? ' ' . $cmd : '' ); + + unshift @ret, + $lb + . $lb + . 'Did you mean to run command ' + . $cmdO + . ' instead?'; + } + + delete $hash->{CL}{'.iDefCmdOrigin'}; + delete $hash->{CL}{'.iDefCmdMethod'}; + delete $hash->{CL}{'.iDefCmdOverwrite'}; + } + + if ($found) { + unshift @ret, + $lb + . $space + . $space + . ( $html ? '' : '' ) + . $foundPerl . ' ' + . ( $foundPerl > 1 ? 'Perl packages' : 'Perl package' ) + . ( $html ? '' : '' ) + if ($foundPerl); + unshift @ret, + $lb + . $space + . $space + . ( $html ? '' : '' ) + . $foundMaintainers . ' ' + . ( $foundMaintainers > 1 ? 'authors' : 'author' ) + . ( $html ? '' : '' ) + if ($foundMaintainers); + unshift @ret, + $lb + . $space + . $space + . ( $html ? '' : '' ) + . $foundKeywords . ' ' + . ( $foundKeywords > 1 ? 'keywords' : 'keyword' ) + . ( $html ? '' : '' ) + if ($foundKeywords); + unshift @ret, + $lb + . $space + . $space + . ( $html ? '' : '' ) + . $foundPackages . ' ' + . ( $foundPackages > 1 ? 'packages' : 'package' ) + . ( $html ? '' : '' ) + if ($foundPackages); + unshift @ret, + $lb + . $space + . $space + . ( $html ? '' : '' ) + . $foundModules . ' ' + . ( $foundModules > 1 ? 'modules' : 'module' ) + . ( $html ? '' : '' ) + if ($foundModules); + unshift @ret, + $lb + . $space + . $space + . ( $html ? '' : '' ) + . $foundDevices . ' ' + . ( $foundDevices > 1 ? 'devices' : 'device' ) + . ( $html ? '' : '' ) + if ($foundDevices); + unshift @ret, + $found . ' total search ' . ( $found > 1 ? 'results:' : 'result:' ); + } + else { + unshift @ret, + $tOpen + . $trOpenOdd + . $tdOpen + . 'Nothing found' + . $tdClose + . $trClose + . $tClose + . $lb + . $lb; + } + + push @ret, $tdClose . $trClose . $tClose . $blockClose; + + unshift @ret, + $blockOpen + . $blockClose + . ( $html ? '' : '' ) + . $blockOpen + . $tTitleOpen + . 'Search Result' + . $tTitleClose + . $tOpen + . $trOpen + . $tdOpen + . $blockOpen + . $blockClose; + + return $header . join( "\n", @ret ) . $footer; +} + +#TODO +# - show master/slave dependencies +# - show parent/child dependencies +# - show other dependant/related modules +# - fill empty keywords +# - Get Community Support URL from MAINTAINERS.txt +sub CreateMetadataList ($$$) { + my ( $hash, $getCmd, $modName ) = @_; + $modName = 'Global' if ( uc($modName) eq 'FHEM' ); + my $modType = lc($getCmd) eq 'showmoduleinfo' ? 'module' : 'package'; + + # disable automatic links to FHEM devices + delete $FW_webArgs{addLinks}; + + return 'Unknown module ' . $modName + if ( $modType eq 'module' && !defined( $modules{$modName} ) ); + + FHEM::Meta::Load($modName); + + return 'Unknown package ' . $modName + if ( $modType eq 'package' + && !defined( $packages{$modName} ) ); + + return 'No metadata found about module ' + . $modName + if ( + $modType eq 'module' + && ( !defined( $modules{$modName}{META} ) + || scalar keys %{ $modules{$modName}{META} } == 0 ) + ); + + return 'No metadata found about package ' + . $modName + if ( + $modType eq 'package' + && ( !defined( $packages{$modName}{META} ) + || scalar keys %{ $packages{$modName}{META} } == 0 ) + ); + + my $modMeta = + $modType eq 'module' + ? $modules{$modName}{META} + : $packages{$modName}{META}; + my @ret; + my $html = + defined( $hash->{CL} ) && $hash->{CL}{TYPE} eq "FHEMWEB" ? 1 : 0; + + my $header = ''; + my $footer = ''; + if ($html) { + $header = +'
← back to FHEM Installer
'; + $footer = ''; + } + + my $blockOpen = ''; + my $tTitleOpen = ''; + my $tTitleClose = ''; + my $tOpen = ''; + my $tCOpen = ''; + my $tCClose = ''; + my $tHOpen = ''; + my $tHClose = ''; + my $tBOpen = ''; + my $tBClose = ''; + my $tFOpen = ''; + my $tFClose = ''; + my $trOpen = ''; + my $trOpenEven = ''; + my $trOpenOdd = ''; + my $thOpen = ''; + my $thOpen2 = ''; + my $thOpen3 = ''; + my $tdOpen = ''; + my $tdOpen2 = ''; + my $tdOpen3 = ''; + my $tdOpen4 = ''; + my $strongOpen = ''; + my $strongClose = ''; + my $tdClose = "\t\t\t"; + my $thClose = "\t\t\t"; + my $trClose = ''; + my $tClose = ''; + my $blockClose = ''; + my $colorRed = ''; + my $colorGreen = ''; + my $colorClose = ''; + + if ($html) { + $blockOpen = '
'; + $tTitleOpen = ''; + $tTitleClose = ''; + $tOpen = ''; + $tCOpen = ''; + $tHOpen = ''; + $tHClose = ''; + $tBOpen = ''; + $tBClose = ''; + $tFOpen = ''; + $tFClose = ''; + $trOpen = ''; + $trOpenEven = ''; + $trOpenOdd = ''; + $thOpen = ''; + $thClose = ''; + $trClose = ''; + $tClose = '
'; + $tCClose = '
'; + $thOpen2 = + ''; + $thOpen3 = + ''; + $tdOpen = ''; + $tdOpen2 = ''; + $tdOpen3 = ''; + $tdOpen4 = ''; + $strongOpen = ''; + $strongClose = ''; + $tdClose = '
'; + $blockClose = '
'; + $colorRed = ''; + $colorGreen = ''; + $colorClose = ''; + } + + my @mAttrs = qw( + name + abstract + keywords + version + release_date + release_status + author + copyright + privacy + homepage + wiki + command_reference + community_support + commercial_support + bugtracker + version_control + license + description + ); + + my $space = $html ? ' ' : ' '; + my $lb = $html ? '
' : "\n"; + my $lang = lc( + AttrVal( + $hash->{NAME}, 'language', + AttrVal( 'global', 'language', 'EN' ) + ) + ); + my $FW_CSRF = ( + defined( $defs{ $hash->{CL}{SNAME} }{CSRFTOKEN} ) + ? '&fwcsrf=' . $defs{ $hash->{CL}{SNAME} }{CSRFTOKEN} + : '' + ); + + push @ret, + $blockOpen + . $tTitleOpen + . ucfirst($modType) + . ' Information' + . $tTitleClose + . $tOpen; + + my $linecount = 1; + foreach my $mAttr (@mAttrs) { + next + if ( + $mAttr eq 'release_status' + && ( !defined( $modMeta->{release_status} ) + || $modMeta->{release_status} eq 'stable' ) + ); + next + if ( + $mAttr eq 'abstract' + && ( !defined( $modMeta->{abstract} ) + || $modMeta->{abstract} eq 'n/a' + || $modMeta->{abstract} eq '' ) + ); + next + if ( + $mAttr eq 'description' + && ( !defined( $modMeta->{description} ) + || $modMeta->{description} eq 'n/a' + || $modMeta->{description} eq '' ) + ); + next + if ( + $mAttr eq 'bugtracker' + && ( !defined( $modMeta->{resources} ) + || !defined( $modMeta->{resources}{bugtracker} ) ) + ); + next + if ( + $mAttr eq 'homepage' + && ( !defined( $modMeta->{resources} ) + || !defined( $modMeta->{resources}{homepage} ) ) + ); + next + if ( + $mAttr eq 'copyright' + && ( !defined( $modMeta->{resources} ) + || !defined( $modMeta->{resources}{x_copyright} ) ) + ); + next + if ( + $mAttr eq 'privacy' + && ( !defined( $modMeta->{resources} ) + || !defined( $modMeta->{resources}{x_privacy} ) ) + ); + next + if ( + $mAttr eq 'wiki' + && ( !defined( $modMeta->{resources} ) + || !defined( $modMeta->{resources}{x_wiki} ) ) + ); + next + if ( + $mAttr eq 'community_support' + && ( !defined( $modMeta->{resources} ) + || !defined( $modMeta->{resources}{x_support_community} ) ) + ); + next + if ( + $mAttr eq 'commercial_support' + && ( !defined( $modMeta->{resources} ) + || !defined( $modMeta->{resources}{x_support_commercial} ) ) + ); + next + if ( + $mAttr eq 'keywords' + && ( !defined( $modMeta->{keywords} ) + || !@{ $modMeta->{keywords} } ) + ); + next + if ( $mAttr eq 'version' + && ( !defined( $modMeta->{version} ) ) ); + next + if ( + $mAttr eq 'version_control' + && ( !defined( $modMeta->{resources} ) + || !defined( $modMeta->{resources}{repository} ) ) + ); + next + if ( + $mAttr eq 'release_date' + && ( !defined( $modMeta->{x_release_date} ) + && !defined( $modMeta->{x_vcs} ) ) + ); + next + if ( $mAttr eq 'command_reference' + && $modType eq 'package' ); + + my $l = $linecount % 2 == 0 ? $trOpenEven : $trOpenOdd; + my $mAttrName = $mAttr; + $mAttrName =~ s/_/$space/g; + $mAttrName =~ s/([\w'&]+)/\u\L$1/g; + + my $webname = + AttrVal( $hash->{CL}{SNAME}, 'webname', 'fhem' ); + + $l .= $thOpen . $mAttrName . $thClose; + + # these attributes do not exist under that name in META.json + if ( !defined( $modMeta->{$mAttr} ) ) { + $l .= $tdOpen; + + if ( $mAttr eq 'release_date' ) { + if ( defined( $modMeta->{x_release_date} ) ) { + $l .= $modMeta->{x_release_date}; + } + elsif ( defined( $modMeta->{x_vcs} ) ) { + $l .= $modMeta->{x_vcs}[7]; + } + } + + elsif ( $mAttr eq 'copyright' ) { + my $copyName = '© '; + my $copyEmail = + defined( $modMeta->{resources}{x_copyright}{mailto} ) + ? $modMeta->{resources}{x_copyright}{mailto} + : ''; + my $copyWeb; + my $copyNameContact; + + $copyName .= $modMeta->{x_vcs}[8] . ' ' + if ( defined( $modMeta->{x_vcs} ) ); + $copyName .= + $modMeta->{resources}{x_copyright}{title}; + + if ( defined( $modMeta->{resources} ) + && defined( $modMeta->{resources}{x_copyright} ) + && defined( $modMeta->{resources}{x_copyright}{web} ) ) + { + $copyWeb = $modMeta->{resources}{x_copyright}{web}; + } + + if ( $html && $copyWeb ) { + $copyNameContact = + '' + . $copyName . ''; + } + elsif ( $html && $copyEmail ) { + $copyNameContact = + '' + . $copyName . ''; + } + + $l .= $copyNameContact ? $copyNameContact : $copyName; + } + + elsif ( $mAttr eq 'privacy' ) { + my $title = + defined( $modMeta->{resources}{x_privacy}{title} ) + ? $modMeta->{resources}{x_privacy}{title} + : $modMeta->{resources}{x_privacy}{web}; + + $l .= + '' + . $title . ''; + } + + elsif ($mAttr eq 'homepage' + && defined( $modMeta->{resources} ) + && defined( $modMeta->{resources}{homepage} ) ) + { + my $title = + defined( $modMeta->{resources}{x_homepage_title} ) + ? $modMeta->{resources}{x_homepage_title} + : ( + $modMeta->{resources}{homepage} =~ m/^.+:\/\/([^\/]+).*/ + ? $1 + : $modMeta->{resources}{homepage} + ); + + $l .= + '' + . $title . ''; + } + + elsif ( $mAttr eq 'command_reference' ) { + if ( defined( $hash->{CL} ) + && defined( $hash->{CL}{TYPE} ) + && $hash->{CL}{TYPE} eq 'FHEMWEB' ) + { + $l .= + 'Offline version'; + } + + if ( defined( $modMeta->{resources} ) + && defined( $modMeta->{resources}{x_commandref} ) + && defined( $modMeta->{resources}{x_commandref}{web} ) ) + { + my $title = + defined( $modMeta->{resources}{x_commandref}{title} ) + ? $modMeta->{resources}{x_commandref}{title} + : 'Online version'; + + $l .= + ( $webname ? ' | ' : '' ) + . '' + . $title . ''; + } + } + + elsif ($mAttr eq 'wiki' + && defined( $modMeta->{resources} ) + && defined( $modMeta->{resources}{x_wiki} ) + && defined( $modMeta->{resources}{x_wiki}{web} ) ) + { + my $title = + defined( $modMeta->{resources}{x_wiki}{title} ) + ? $modMeta->{resources}{x_wiki}{title} + : ( + $modMeta->{resources}{x_wiki}{web} =~ + m/^(?:https?:\/\/)?wiki\.fhem\.de/i ? 'FHEM Wiki' + : '' + ); + + $title = 'FHEM Wiki: ' . $title + if ( $title ne '' + && $title !~ m/^FHEM Wiki/i + && $modMeta->{resources}{x_wiki}{web} =~ + m/^(?:https?:\/\/)?wiki\.fhem\.de/i ); + + $l .= + '' + . $title . ''; + } + + elsif ($mAttr eq 'community_support' + && defined( $modMeta->{resources} ) + && defined( $modMeta->{resources}{x_support_community} ) + && defined( $modMeta->{resources}{x_support_community}{web} ) ) + { + + my $board = $modMeta->{resources}{x_support_community}; + $board = + $modMeta->{resources}{x_support_community}{subCommunity} + if ( + defined( + $modMeta->{resources}{x_support_community}{subCommunity} + ) + ); + + my $title = + defined( $board->{title} ) ? $board->{title} + : ( + $board->{web} =~ m/^(?:https?:\/\/)?forum\.fhem\.de/i + ? 'FHEM Forum' + : '' + ); + + $title = 'FHEM Forum: ' . $title + if ( $title ne '' + && $title !~ m/^FHEM Forum/i + && $board->{web} =~ m/^(?:https?:\/\/)?forum\.fhem\.de/i ); + + $l .= 'Limited - ' + if ( defined( $modMeta->{x_support_status} ) + && $modMeta->{x_support_status} eq 'limited' ); + + $l .= + '{description} ) + ? ' title="' + . $board->{description} + . '"' + : ( + defined( + $modMeta->{resources}{x_support_community} + {description} + ) + ? ' title="' + . $modMeta->{resources}{x_support_community} + {description} . '"' + : '' + ) + ) + . '>' + . $title . ''; + } + + elsif ($mAttr eq 'commercial_support' + && defined( $modMeta->{resources} ) + && defined( $modMeta->{resources}{x_support_commercial} ) + && defined( $modMeta->{resources}{x_support_commercial}{web} ) ) + { + my $title = + defined( $modMeta->{resources}{x_support_commercial}{title} ) + ? $modMeta->{resources}{x_support_commercial}{title} + : $modMeta->{resources}{x_support_commercial}{web}; + + $l .= 'Limited - ' + if ( $modMeta->{x_support_status} eq 'limited' ); + + $l .= + '' + . $title . ''; + } + + elsif ($mAttr eq 'bugtracker' + && defined( $modMeta->{resources} ) + && defined( $modMeta->{resources}{bugtracker} ) + && defined( $modMeta->{resources}{bugtracker}{web} ) ) + { + my $title = + defined( $modMeta->{resources}{bugtracker}{x_web_title} ) + ? $modMeta->{resources}{bugtracker}{x_web_title} + : ( + $modMeta->{resources}{bugtracker}{web} =~ + m/^(?:https?:\/\/)?forum\.fhem\.de/i ? 'FHEM Forum' + : ( + $modMeta->{resources}{bugtracker}{web} =~ + m/^(?:https?:\/\/)?github\.com\/fhem/i + ? 'Github Issues: ' . $modMeta->{name} + : $modMeta->{resources}{bugtracker}{web} + ) + ); + + # add prefix if user defined title + $title = 'FHEM Forum: ' . $title + if ( $title ne '' + && $title !~ m/^FHEM Forum/i + && $modMeta->{resources}{bugtracker}{web} =~ + m/^(?:https?:\/\/)?forum\.fhem\.de/i ); + $title = 'Github Issues: ' . $title + if ( $title ne '' + && $title !~ m/^Github issues/i + && $modMeta->{resources}{bugtracker}{web} =~ + m/^(?:https?:\/\/)?github\.com\/fhem/i ); + + $l .= + '' + . $title . ''; + } + + elsif ($mAttr eq 'version_control' + && defined( $modMeta->{resources} ) + && defined( $modMeta->{resources}{repository} ) + && defined( $modMeta->{resources}{repository}{type} ) + && defined( $modMeta->{resources}{repository}{url} ) ) + { + # Web link + if ( defined( $modMeta->{resources}{repository}{web} ) ) { + + # master link + my $url = + $modMeta->{resources}{repository}{web}; + + if ( + defined( $modMeta->{resources}{repository}{x_branch} ) + && defined( $modMeta->{resources}{repository}{x_dev} ) + && defined( + $modMeta->{resources}{repository}{x_dev}{x_branch} + ) + ) + { + my $bName = + $modMeta->{resources}{repository}{x_branch}; + $bName = 'production' + if ( + $modMeta->{resources}{repository}{x_branch} eq + $modMeta->{resources}{repository}{x_dev}{x_branch} + ); + + # webview: master entry + $l .= + 'View online source code: ' + . $bName . ''; + + # webview: dev link + $bName = + $modMeta->{resources}{repository}{x_dev}{x_branch}; + $bName = 'development' + if ( + $modMeta->{resources}{repository}{x_branch} eq + $modMeta->{resources}{repository}{x_dev}{x_branch} + ); + $url = + $modMeta->{resources}{repository}{x_dev}{web}; + + # webview: dev entry + $l .= + ' | ' + . $bName . ''; + + # raw: master entry + if ( + defined( $modMeta->{resources}{repository}{x_raw} ) + ) + { + $bName = + $modMeta->{resources}{repository}{x_branch}; + $bName = 'production' + if ( + $modMeta->{resources}{repository}{x_branch} eq + $modMeta->{resources}{repository}{x_dev} + {x_branch} ); + + $url = $modMeta->{resources}{repository}{x_raw}; + $l .= + $lb + . 'Download raw file: ' + . $bName . ''; + + # raw: dev link + if ( + defined( + $modMeta->{resources}{repository}{x_dev} + {x_raw} + ) + ) + { + $bName = + $modMeta->{resources}{repository}{x_dev} + {x_branch}; + $bName = 'development' + if ( + $modMeta->{resources}{repository}{x_branch} + eq + $modMeta->{resources}{repository}{x_dev} + {x_branch} ); + $url = + $modMeta->{resources}{repository}{x_dev} + {x_raw}; + + # raw: dev entry + $l .= + ' | ' + . $bName . ''; + } + } + } + + # master entry + else { + $l .= + 'View online source code'; + + if ( + defined( $modMeta->{resources}{repository}{x_raw} ) + ) + { + $l .= + $lb + . 'Download raw file'; + } + } + + $l .= $lb; + } + + # VCS link + my $urlPrefix = ( + $modMeta->{resources}{repository}{url} =~ + /^$modMeta->{resources}{repository}{type}/i + ? '' + : lc( $modMeta->{resources}{repository}{type} ) . '+' + ); + + $l .= + uc( $modMeta->{resources}{repository}{type} ) + . ' repository: ' + . '' + . $urlPrefix + . $modMeta->{resources}{repository}{url} . ''; + + if ( defined( $modMeta->{resources}{repository}{x_branch} ) ) { + if ( + lc( $modMeta->{resources}{repository}{type} ) eq 'svn' ) + { + $l .= + $lb + . 'Main branch: ' + . '' + . $modMeta->{resources}{repository}{x_branch} + . ''; + } + else { + $l .= + $lb + . 'Main branch: ' + . $modMeta->{resources}{repository}{x_branch}; + } + } + + if ( + defined( $modMeta->{resources}{repository}{x_branch} ) + && defined( $modMeta->{resources}{repository}{x_dev} ) + && defined( + $modMeta->{resources}{repository}{x_dev}{x_branch} + ) + && $modMeta->{resources}{repository}{x_branch} ne + $modMeta->{resources}{repository}{x_dev}{x_branch} + ) + { + if ( + lc( $modMeta->{resources}{repository}{x_dev}{type} ) eq + 'svn' ) + { + $l .= + $lb + . 'Dev branch: ' + . '' + . $modMeta->{resources}{repository}{x_dev}{x_branch} + . ''; + } + else { + $l .= + $lb + . 'Dev branch: ' + . $modMeta->{resources}{repository}{x_dev}{x_branch}; + } + } + } + else { + $l .= '-'; + } + + $l .= $tdClose; + } + + # these text attributes can be shown directly + elsif ( !ref( $modMeta->{$mAttr} ) ) { + $l .= $tdOpen; + + my $mAttrVal = + defined( $modMeta->{x_lang} ) + && defined( $modMeta->{x_lang}{$lang} ) + && defined( $modMeta->{x_lang}{$lang}{$mAttr} ) + ? $modMeta->{x_lang}{$lang}{$mAttr} + : $modMeta->{$mAttr}; + $mAttrVal =~ s/\\n/$lb/g; + + if ( $mAttr eq 'version' ) { + if ( $mAttrVal eq '0.000000001' ) { + $mAttrVal = '-'; + } + elsif ( $modMeta->{x_file}[7] ne 'generated/vcs' ) { + $mAttrVal = version->parse($mAttrVal)->normal; + + # only show maximum featurelevel for fhem.pl + $mAttrVal = $1 + if ( $modName eq 'Global' + && $mAttrVal =~ m/^(v\d+\.\d+).*/ ); + + # Only add commit revision when it is not + # part of the version already + $mAttrVal .= '-s' . $modMeta->{x_vcs}[5] + if ( defined( $modMeta->{x_vcs} ) + && $modMeta->{x_vcs}[5] ne '' ); + } + } + + # Add filename to module name + $mAttrVal .= ' (' . $modMeta->{x_file}[2] . ')' + if ( $modType eq 'module' + && $mAttr eq 'name' + && $modName ne 'Global' ); + + $l .= $mAttrVal . $tdClose; + } + + # this attribute is an array and needs further processing + elsif (ref( $modMeta->{$mAttr} ) eq 'ARRAY' + && @{ $modMeta->{$mAttr} } > 0 + && $modMeta->{$mAttr}[0] ne '' ) + { + $l .= $tdOpen; + + if ( $mAttr eq 'license' ) { + if ( defined( $modMeta->{resources} ) + && defined( $modMeta->{resources}{license} ) + && ref( $modMeta->{resources}{license} ) eq 'ARRAY' + && @{ $modMeta->{resources}{license} } > 0 + && $modMeta->{resources}{license}[0] ne '' ) + { + $l .= + '' + . $modMeta->{$mAttr}[0] . ''; + } + else { + $l .= $modMeta->{$mAttr}[0]; + } + } + elsif ( $mAttr eq 'author' ) { + my $authorCount = scalar @{ $modMeta->{$mAttr} }; + my $counter = 0; + + foreach ( @{ $modMeta->{$mAttr} } ) { + next if ( $_ eq '' ); + + my $authorName; + my $authorEditorOnly; + my $authorEmail; + + if ( $_ =~ +m/^([^<>\n\r]+?)(?:\s+(\(last release only\)))?(?:\s+(?:<(.*)>))?$/ + ) + { + $authorName = $1; + $authorEditorOnly = $2 ? ' ' . $2 : ''; + $authorEmail = $3; + } + + my $authorNameEmail = $authorName; + + # add alias name if different + if ( defined( $modMeta->{x_fhem_maintainer} ) + && ref( $modMeta->{x_fhem_maintainer} ) eq 'ARRAY' + && @{ $modMeta->{x_fhem_maintainer} } > 0 + && $modMeta->{x_fhem_maintainer}[$counter] ne '' ) + { + + my $alias = $modMeta->{x_fhem_maintainer}[$counter]; + + if ( $alias eq $authorName ) { + $authorNameEmail = + '' + . $authorName . '' + . $authorEditorOnly + if ($html); + } + else { + if ($html) { + $authorNameEmail = + $authorName + . ', alias ' + . $alias . '' + . $authorEditorOnly; + } + else { + $authorNameEmail = + $authorName + . $authorEditorOnly + . ', alias ' + . $alias; + } + } + } + + $l .= $lb if ($counter); + $l .= $lb . 'Co-' . $mAttrName . ':' . $lb + if ( $counter == 1 ); + $l .= + $authorNameEmail + ? $authorNameEmail + : $authorName . $authorEditorOnly; + + $counter++; + } + } + elsif ( $mAttr eq 'keywords' ) { + my $counter = 0; + foreach my $keyword ( @{ $modMeta->{$mAttr} } ) { + $l .= ', ' if ($counter); + my $descr = FHEM::Meta::GetKeywordDesc( $keyword, $lang ); + + if ($html) { + $l .= + '' + . $keyword . ''; + } + else { + $l .= $keyword; + } + + $counter++; + } + } + else { + $l .= join ', ', @{ $modMeta->{$mAttr} }; + } + + $l .= $tdClose; + } + + # woops, we don't know how to handle this attribute + else { + $l .= $tdOpen . '?' . $tdClose; + } + + $l .= $trClose; + + push @ret, $l; + $linecount++; + } + + push @ret, + $tFOpen + . $trOpen + . ( + $html + ? '' + : '' + ) + . 'Based on data generated by ' + . $lb + . $modMeta->{generated_by} + . $tdClose + . $trClose + . $tFClose; + + push @ret, $tClose . $blockClose; + + # show FHEM modules who use this package + @mAttrs = qw( + requires + recommends + suggests + ); + + $linecount = 1; + foreach my $mAttr (@mAttrs) { + next + unless ( defined( $FHEM::Meta::dependents{pkgs}{$modName}{$mAttr} ) + && ref( $FHEM::Meta::dependents{pkgs}{$modName}{$mAttr} ) eq + 'ARRAY' + && @{ $FHEM::Meta::dependents{pkgs}{$modName}{$mAttr} } > 0 ); + + my $dependents = ''; + + my $counter = 0; + foreach my $dependant ( sort { "\L$a" cmp "\L$b" } + @{ $FHEM::Meta::dependents{pkgs}{$modName}{$mAttr} } ) + { + my $link = $dependant; + $link = + '' + . $dependant . '' + if ($html); + + $dependents .= ', ' if ($counter); + $dependents .= $link; + $counter++; + } + + if ( $dependents ne '' ) { + if ( $linecount == 1 ) { + push @ret, + $blockOpen + . $tTitleOpen + . 'FHEM internal dependencies' + . $tTitleClose + . $tOpen; + + push @ret, $tHOpen . $trOpen; + + push @ret, $thOpen . 'Importance' . $thClose; + + push @ret, $thOpen . 'Dependent Modules' . $thClose; + + push @ret, $trClose . $tHClose; + } + + my $l = $linecount % 2 == 0 ? $trOpenEven : $trOpenOdd; + + my $importance = $mAttr; + $importance = 'required' if ( $mAttr eq 'requires' ); + $importance = 'recommended' if ( $mAttr eq 'recommends' ); + $importance = 'suggested' if ( $mAttr eq 'suggests' ); + + $l .= $tdOpen . $importance . $tdClose; + $l .= $tdOpen . $dependents . $tdClose; + + $l .= $trClose; + + push @ret, $l; + $linecount++; + } + } + push @ret, + $tFOpen + . $trOpen + . $tdOpen2 + . $strongOpen . 'Hint:' + . $strongClose + . ' Dependents can only be shown here if they were loaded into the metadata cache before.' + . $tdClose + . $trClose + . $tFClose + . $tClose + . $blockClose + if ( $linecount > 1 ); + + if ( + $modType eq 'module' + && $modName ne 'Global' + && ( !defined( $modules{$modName}{META} ) + || !defined( $modules{$modName}{META}{keywords} ) + || ! + grep ( /^fhem-mod-command$/, + @{ $modules{$modName}{META}{keywords} } ) ) + ) + { + push @ret, $blockOpen . $tTitleOpen . 'Devices' . $tTitleClose . $tOpen; + + my $linecount = 1; + + if ( defined( $modules{$modName}{LOADED} ) + && $modules{$modName}{LOADED} ) + { + my @instances = devspec2array( 'TYPE=' . $modName ); + if ( @instances > 0 ) { + push @ret, + $tHOpen + . $trOpen + . $thOpen . 'Name' + . $thClose + . $thOpen . 'State' + . $thClose + . $trClose + . $tHClose + . $tBOpen; + + foreach my $instance ( sort { "\L$a" cmp "\L$b" } @instances ) { + next if ( defined( $defs{$instance}{TEMPORARY} ) ); + + my $l = $linecount % 2 == 0 ? $trOpenEven : $trOpenOdd; + + my $device = $instance; + $device = + '' + . $instance . '' + if ($html); + + $l .= $tdOpen . $device . $tdClose; + $l .= $tdOpen . $defs{$instance}{STATE} . $tdClose; + + push @ret, $l; + $linecount++; + } + + push @ret, $tBClose; + } + else { + push @ret, + $tBOpen + . $trOpen + . $tdOpen + . 'The module was once loaded into memory, ' + . 'but currently there is no device defined.' + . $tdClose + . $trClose + . $tBClose; + } + } + else { + push @ret, + $tBOpen + . $trOpen + . $tdOpen + . 'The module is currently not in use.' + . $tdClose + . $trClose + . $tBClose; + } + + push @ret, $tClose . $blockClose; + } + + LoadInstallStatusPerl($modName); + + push @ret, + $blockOpen + . $tTitleOpen + . 'System Prerequisites' + . $tTitleClose + . $tOpen + . $trOpen + . $tdOpen; + + push @ret, $blockOpen . $tOpen . $tCOpen . 'Perl Packages' . $tCClose; + + if ( defined( $modMeta->{prereqs} ) + && defined( $modMeta->{prereqs}{runtime} ) ) + { + @mAttrs = qw( + requires + recommends + suggests + ); + + push @ret, $tHOpen . $trOpen; + + push @ret, $thOpen . 'Name' . $thClose; + + push @ret, $thOpen . 'Importance' . $thClose; + + push @ret, $thOpen . 'Status' . $thClose; + + push @ret, $thOpen . 'Action' . $thClose if ($html); + + push @ret, $trClose . $tHClose . $tBOpen; + + $linecount = 1; + foreach my $mAttr (@mAttrs) { + next + unless ( defined( $modMeta->{prereqs}{runtime}{$mAttr} ) + && keys %{ $modMeta->{prereqs}{runtime}{$mAttr} } > 0 ); + + foreach + my $prereq ( sort keys %{ $modMeta->{prereqs}{runtime}{$mAttr} } ) + { + my $isFhem = FHEM::Meta::ModuleIsInternal($prereq); + my $installed = $pkgStatus{Perl}{pkgs}{$prereq}{status}; + + my $l = $linecount % 2 == 0 ? $trOpenEven : $trOpenOdd; + + my $importance = $mAttr; + $importance = 'required' if ( $mAttr eq 'requires' ); + $importance = 'recommended' if ( $mAttr eq 'recommends' ); + $importance = 'suggested' if ( $mAttr eq 'suggests' ); + + my $version = $modMeta->{prereqs}{runtime}{$mAttr}{$prereq}; + $version = '' if ( !defined($version) || $version eq '0' ); + + my $action = ''; + my $inherited = ''; + if ( + defined( $modMeta->{prereqs}{runtime}{x_inherited} ) + && defined( + $modMeta->{prereqs}{runtime}{x_inherited}{$prereq} + ) + ) + { + $inherited = '[inherited]'; + $inherited = '' + . $inherited + . '' + if ($html); + } + + if ( + $mAttr ne 'requires' + && ( $installed eq 'missing' + || $installed eq 'outdated' ) + ) + { + $installed = ''; + + $action = + '
' + . ( $installed eq 'outdated' ? 'Update' : 'Install' ) + . '
'; + } + elsif ( $installed eq 'installed' ) { + $installed = $colorGreen . $installed . $colorClose; + } + elsif ($installed eq 'missing' + || $installed eq 'outdated' ) + { + $installed = + $colorRed + . $strongOpen + . uc($installed) + . $strongClose + . $colorClose; + + $action = + '
' + . ( $installed eq 'outdated' ? 'Update' : 'Install' ) + . '
'; + } + + $prereq = + '' + . $prereq . '' + if ( $html + && $installed ne 'built-in' + && $installed ne 'included' ); + + $prereq = + '' + . $prereq . '' + if ( $html + && $installed eq 'included' ); + + $l .= + $tdOpen + . $prereq + . ( $inherited ne '' ? " $inherited" : '' ) + . ( $version ne '' ? " ($version)" : '' ) + . $tdClose; + $l .= $tdOpen . $importance . $tdClose; + $l .= $tdOpen . $installed . $tdClose; + $l .= $tdOpen . $action . $tdClose if ($html); + + $l .= $trClose; + + push @ret, $l; + $linecount++; + } + } + + push @ret, $tBClose; + + push @ret, + $tFOpen + . $trOpenEven + . ( $html ? $tdOpen4 : $tdOpen3 ) + . $strongOpen . 'Hint:' + . $strongClose + . ' The module does not provide Perl prerequisites from its metadata.' + . $lb + . 'This result is based on automatic source code analysis ' + . 'and can be incorrect. ' + . 'Suggested Perl items may still be required if the module author had decided to implement some own dependency and/or error handling like returning an informative message instead of the original Perl error message.' + . $tdClose + . $trClose + . $tFClose + if ( defined( $modMeta->{x_prereqs_src} ) + && $modMeta->{x_prereqs_src} ne 'META.json' ); + } + elsif ( defined( $modMeta->{x_prereqs_src} ) ) { + push @ret, + $tBOpen + . $trOpenOdd + . $tdOpen + . 'No known prerequisites.' + . $tdClose + . $trClose + . $tBClose; + } + else { + push @ret, + $tBOpen + . $trOpenOdd + . $tdOpen + . 'Module metadata do not contain any prerequisites.' . "\n" + . ( + $html + ? 'Click here to install Perl::PrereqScanner::NotQuiteLite for automatic source code analysis.' + : 'For automatic source code analysis, please install Perl::PrereqScanner::NotQuiteLite first.' + ) + . $tdClose + . $trClose + . $tBClose; + } + push @ret, $tClose . $blockClose; + + if ( defined( $modMeta->{x_prereqs_nodejs} ) + && defined( $modMeta->{x_prereqs_nodejs}{runtime} ) ) + { + push @ret, + $blockOpen + . $tTitleClose + . $tOpen + . $tCOpen + . 'Node.js Packages' + . $tCClose; + + my @mAttrs = qw( + requires + recommends + suggests + ); + + push @ret, $tHOpen . $trOpen; + + push @ret, $thOpen . 'Name' . $thClose; + + push @ret, $thOpen . 'Importance' . $thClose; + + push @ret, $thOpen . 'Status' . $thClose; + + push @ret, $trClose . $tHClose . $tBOpen; + + $linecount = 1; + foreach my $mAttr (@mAttrs) { + next + unless ( defined( $modMeta->{x_prereqs_nodejs}{runtime}{$mAttr} ) + && keys %{ $modMeta->{x_prereqs_nodejs}{runtime}{$mAttr} } > + 0 ); + + foreach my $prereq ( + sort + keys %{ $modMeta->{x_prereqs_nodejs}{runtime}{$mAttr} } + ) + { + my $l = $linecount % 2 == 0 ? $trOpenEven : $trOpenOdd; + + my $importance = $mAttr; + $importance = 'required' if ( $mAttr eq 'requires' ); + $importance = 'recommended' if ( $mAttr eq 'recommends' ); + $importance = 'suggested' if ( $mAttr eq 'suggests' ); + + my $version = + $modMeta->{x_prereqs_nodejs}{runtime}{$mAttr}{$prereq}; + $version = '' if ( !defined($version) || $version eq '0' ); + + my $check = __IsInstalledNodejs($prereq); + my $installed = ''; + if ($check) { + if ( $check =~ m/^\d+\./ ) { + my $nverReq = + $version ne '' + ? $version + : 0; + my $nverInst = $check; + + #TODO suport for version range: + #https://metacpan.org/pod/CPAN::Meta::Spec#Version-Range + if ( $nverReq > 0 && $nverInst < $nverReq ) { + $installed .= + $colorRed + . 'OUTDATED' + . $colorClose . ' (' + . $check . ')'; + } + else { + $installed = 'installed'; + } + } + else { + $installed = 'installed'; + } + } + else { + $installed = $colorRed . 'MISSING' . $colorClose + if ( $importance eq 'required' ); + } + + $installed = $colorGreen . $installed . $colorClose; + + $prereq = + '' + . $prereq . '' + if ($html); + + $l .= + $tdOpen + . $prereq + . ( $version ne '' ? " ($version)" : '' ) + . $tdClose; + $l .= $tdOpen . $importance . $tdClose; + $l .= $tdOpen . $installed . $tdClose; + + $l .= $trClose; + + push @ret, $l; + $linecount++; + } + } + + push @ret, $tBClose . $tClose . $blockClose; + } + + if ( defined( $modMeta->{x_prereqs_python} ) + && defined( $modMeta->{x_prereqs_python}{runtime} ) ) + { + push @ret, $blockOpen . $tOpen . $tCOpen . 'Python Packages' . $tCClose; + + my @mAttrs = qw( + requires + recommends + suggests + ); + + push @ret, $tHOpen . $trOpen; + + push @ret, $thOpen . 'Name' . $thClose; + + push @ret, $thOpen . 'Importance' . $thClose; + + push @ret, $thOpen . 'Status' . $thClose; + + push @ret, $trClose . $tHClose . $tBOpen; + + $linecount = 1; + foreach my $mAttr (@mAttrs) { + next + unless ( defined( $modMeta->{x_prereqs_python}{runtime}{$mAttr} ) + && keys %{ $modMeta->{x_prereqs_python}{runtime}{$mAttr} } > + 0 ); + + foreach my $prereq ( + sort + keys %{ $modMeta->{x_prereqs_python}{runtime}{$mAttr} } + ) + { + my $l = $linecount % 2 == 0 ? $trOpenEven : $trOpenOdd; + + my $importance = $mAttr; + $importance = 'required' if ( $mAttr eq 'requires' ); + $importance = 'recommended' if ( $mAttr eq 'recommends' ); + $importance = 'suggested' if ( $mAttr eq 'suggests' ); + + my $version = + $modMeta->{x_prereqs_python}{runtime}{$mAttr}{$prereq}; + $version = '' if ( !defined($version) || $version eq '0' ); + + my $check = __IsInstalledPython($prereq); + my $installed = ''; + if ($check) { + if ( $check =~ m/^\d+\./ ) { + my $nverReq = + $version ne '' + ? $version + : 0; + my $nverInst = $check; + + #TODO suport for version range: + #https://metacpan.org/pod/CPAN::Meta::Spec#Version-Range + if ( $nverReq > 0 && $nverInst < $nverReq ) { + $installed .= + $colorRed + . 'OUTDATED' + . $colorClose . ' (' + . $check . ')'; + } + else { + $installed = 'installed'; + } + } + else { + $installed = 'installed'; + } + } + else { + $installed = $colorRed . 'MISSING' . $colorClose + if ( $importance eq 'required' ); + } + + my $isPerlCore = FHEM::Meta::ModuleIsPerlCore($prereq); + my $isFhem = + $isPerlCore + ? 0 + : FHEM::Meta::ModuleIsInternal($prereq); + if ( $isPerlCore || $prereq eq 'perl' ) { + $installed = + $installed ne 'installed' + ? "$installed (Perl built-in)" + : 'built-in'; + } + elsif ($isFhem) { + $installed = + $installed ne 'installed' + ? "$installed (FHEM included)" + : 'included'; + } + elsif ( $installed eq 'installed' ) { + $installed = $colorGreen . $installed . $colorClose; + } + + $prereq = + '' + . $prereq . '' + if ( $html + && !$isFhem + && !$isPerlCore + && $prereq ne 'perl' ); + + $l .= + $tdOpen + . $prereq + . ( $version ne '' ? " ($version)" : '' ) + . $tdClose; + $l .= $tdOpen . $importance . $tdClose; + $l .= $tdOpen . $installed . $tdClose; + + $l .= $trClose; + + push @ret, $l; + $linecount++; + } + } + + push @ret, $tBClose . $tClose . $blockClose; + } + + push @ret, $tdClose . $trClose . $tClose . $blockClose; + + return $header . join( "\n", @ret ) . $footer; +} + +sub CreateRawMetaJson ($$$) { + my ( $hash, $getCmd, $modName ) = @_; + $modName = 'Global' if ( uc($modName) eq 'FHEM' ); + my $modType = lc($getCmd) eq 'zzgetmodulemeta.json' ? 'module' : 'package'; + + FHEM::Meta::Load($modName); + + return '{}' + unless ( + ( + $modType eq 'module' + && defined( $modules{$modName}{META} ) + && scalar keys %{ $modules{$modName}{META} } > 0 + ) + || ( $modType eq 'package' + && defined( $packages{$modName}{META} ) + && scalar keys %{ $packages{$modName}{META} } > 0 ) + ); + + my $j = JSON->new; + $j->allow_nonref; + $j->canonical; + $j->pretty; + if ( $modType eq 'module' ) { + return $j->encode( $modules{$modName}{META} ); + + } + else { + return $j->encode( $packages{$modName}{META} ); + } +} + +sub __GetDefinedModulesFromFile($) { + my ($filePath) = @_; + my @modules; + my $fh; + + if ( open( $fh, '<' . $filePath ) ) { + while ( my $l = <$fh> ) { + if ( $l =~ /^define\s+\S+\s+(\S+).*/ ) { + my $modName = $1; + push @modules, $modName + unless ( grep ( /^$modName$/, @modules ) ); + } + } + close($fh); + } + + if (wantarray) { + return @modules; + } + elsif ( @modules > 0 ) { + return join( ',', @modules ); + } +} + +sub LoadInstallStatusPerl(;$) { + my ($modList) = @_; + my $t = TimeNow(); + my @rets; + + my $unused = 0; + my @lmodules; + + # if modList is undefined or is equal to '1' + if ( !$modList || ( !ref($modList) && $modList eq '1' ) ) { + $unused = 1 if ( $modList && $modList eq '1' ); + + foreach ( keys %modules ) { + + # Only process loaded modules + # unless unused modules were + # explicitly requested + push @lmodules, + $_ + if ( + $unused + || ( defined( $modules{$_}{LOADED} ) + && $modules{$_}{LOADED} eq '1' ) + ); + } + } + + # if a single module name was given + elsif ( !ref($modList) ) { + push @lmodules, $modList; + } + + # if a list of module names was given + elsif ( ref($modList) eq 'ARRAY' ) { + foreach ( @{$modList} ) { + push @lmodules, $_; + } + } + + # if a hash was given, assume every + # key is a module name + elsif ( ref($modList) eq 'HASH' ) { + foreach ( keys %{$modList} ) { + push @lmodules, $_; + } + } + + # Wrong method use + else { + $@ = + __PACKAGE__ . "LoadInstallStatusPerl: ERROR: Unknown parameter value"; + Log 1, $@; + return "$@"; + } + + foreach my $modName (@lmodules) { + $modName = 'Global' if ( uc($modName) eq 'FHEM' ); + my $type; + + if ( exists( $modules{$modName} ) + && !exists( $packages{$modName} ) ) + { + $type = 'module'; + } + elsif ( exists( $packages{$modName} ) + && !exists( $modules{$modName} ) ) + { + $type = 'package'; + } + elsif (exists( $packages{$modName} ) + && exists( $modules{$modName} ) ) + { + $type = 'module+package'; + } + next unless ($type); + + foreach my $type ( split( '\+', $type ) ) { + + FHEM::Meta::Load($modName); + + next + unless ( + ( $type eq 'module' && defined( $modules{$modName}{META} ) ) + || ( $type eq 'package' + && defined( $packages{$modName}{META} ) ) + ); + + my $modMeta = + $type eq 'module' + ? $modules{$modName}{META} + : $packages{$modName}{META}; + + $pkgStatus{Perl}{analyzed} = 2 + unless ( defined( $modMeta->{x_prereqs_src} ) ); + + # Perl + if ( defined( $modMeta->{prereqs} ) + && defined( $modMeta->{prereqs}{runtime} ) ) + { + my $modPreqs = $modMeta->{prereqs}{runtime}; + + foreach my $mAttr (qw(requires recommends suggests)) { + next + unless ( defined( $modPreqs->{$mAttr} ) + && keys %{ $modPreqs->{$mAttr} } > 0 ); + + foreach my $pkg ( keys %{ $modPreqs->{$mAttr} } ) { + push + @{ $pkgStatus{Perl}{pkgs}{$pkg}{ $type . 's' }{$mAttr} + }, + $modName + unless ( + grep ( /^$modName$/, + @{ + $pkgStatus{Perl}{pkgs}{$pkg} + { $type . 's' }{$mAttr} + } ) + ); + + next + if ( + defined( $pkgStatus{Perl}{pkgs}{$pkg}{status} ) ); + + my $fname = $pkg; + $fname =~ + s/^.*://g; # strip away any parent module names + + my $isPerlCore = FHEM::Meta::ModuleIsPerlCore($pkg); + my $isFhem = + $isPerlCore + ? 0 + : FHEM::Meta::ModuleIsInternal($pkg); + + if ( $pkg eq 'perl' ) { + $pkgStatus{Perl}{pkgs}{$pkg}{status} = + 'built-in'; + $pkgStatus{Perl}{installed}{$pkg} = + version->parse($])->numify; + } + elsif ( $pkg eq 'FHEM' ) { + $pkgStatus{Perl}{pkgs}{$pkg}{status} = + 'included'; + $pkgStatus{Perl}{installed}{$pkg} = + $modules{'Global'}{META}{version}; + } + elsif ( $pkg eq 'FHEM::Meta' || $pkg eq 'Meta' ) { + $pkgStatus{Perl}{pkgs}{$pkg}{status} = + 'included'; + $pkgStatus{Perl}{installed}{$pkg} = + FHEM::Meta->VERSION(); + } + elsif ($isPerlCore) { + $pkgStatus{Perl}{pkgs}{$pkg}{status} = + 'built-in'; + $pkgStatus{Perl}{installed}{$pkg} = 0; + } + + # This is a FHEM package + elsif ( $isFhem && $isFhem eq 'package' ) { + $pkgStatus{Perl}{pkgs}{$pkg}{status} = + 'included'; + $pkgStatus{Perl}{installed}{$pkg} = + defined( $packages{$fname}{META} ) + ? $packages{$fname}{META}{version} + : 0; + } + + # This is a FHEM module being loaded as package + elsif ( $isFhem && $isFhem eq 'module' ) { + $pkgStatus{Perl}{pkgs}{$pkg}{status} = + 'included'; + $pkgStatus{Perl}{installed}{$pkg} = + defined( $modules{$fname}{META} ) + ? $modules{$fname}{META}{version} + : 0; + } + elsif ( $pkg =~ /^Win32::/ && $^O !~ /Win/ ) { + $pkgStatus{Perl}{pkgs}{$pkg}{status} = 'n/a'; + } + else { + + my $pkgpath = $pkg . '.pm'; + $pkgpath =~ s/::/\//g; + + # remove any ealier tries to load + # to get the original error message + foreach ( keys %INC ) { + delete $INC{$_} + if ( !$INC{$_} ); + } + + #FIXME disable warnings does not work here... + no warnings; + my $verbose = AttrVal( 'global', 'verbose', 3 ); + $attr{global}{verbose} = 0; + eval "no warnings; require $pkg;"; + $attr{global}{verbose} = $verbose; + use warnings; + + if ( $@ && $@ =~ m/^Can't locate (\S+)\.pm/i ) { + my $missing = $1; + $missing =~ s/\//::/g; + $pkgStatus{Perl}{pkgs}{$missing}{status} = + 'missing'; + push @{ $pkgStatus{Perl}{missing}{$missing} }, + defined( $modPreqs->{$mAttr}{$missing} ) + ? $modPreqs->{$mAttr}{$missing} + : 0; + + $pkgStatus{Perl}{analyzed} = 1 + if ( $modMeta->{x_prereqs_src} ne 'META.json' + && !$pkgStatus{Perl}{analyzed} ); + + # If the error message does contain a + # different package name, + # the actual package is installed and + # misses another package by it's own + if ( $missing ne $pkg ) { + my $v = eval "$pkg->VERSION()"; + $pkgStatus{Perl}{pkgs}{$pkg}{status} = + 'installed'; + $pkgStatus{Perl}{installed}{$pkg} = + $v ? $v : 0; + + push @{ $pkgStatus{Perl}{pkgs}{$missing} + { $type . 's' }{$mAttr} }, + $modName + unless ( + grep ( /^$modName$/, + @{ + $pkgStatus{Perl}{pkgs}{$missing} + { $type . 's' }{$mAttr} + } ) + ); + + # Lets also update the module meta data + if ( $type eq 'module' ) { + $modMeta->{prereqs} + {runtime}{$mAttr}{$missing} = 0; + + push @{ $modMeta->{prereqs}{runtime} + {x_inherited}{$missing} }, + $pkg; + + } + else { + $packages{$modName}{META}{prereqs} + {runtime}{$mAttr}{$missing} = 0; + + push + @{ $packages{$modName}{META}{prereqs} + {runtime}{x_inherited}{$missing} + }, + $pkg; + } + } + } + else { + $pkgStatus{Perl}{pkgs}{$pkg}{status} = + 'installed'; + my $v = eval "$pkg->VERSION()"; + $pkgStatus{Perl}{installed}{$pkg} = + $v ? $v : 0; + } + } + + # check for outdated version + if ( $pkgStatus{Perl}{pkgs}{$pkg}{status} eq 'installed' + || $pkg eq 'perl' ) + { + my $reqV = $modPreqs->{$mAttr}{$pkg}; + my $instV = $pkgStatus{Perl}{installed}{$pkg}; + if ( defined($reqV) + && $reqV ne '' + && $reqV ne '0' + && defined($instV) + && $instV ne '' + && $instV ne '0' ) + { + $reqV = version->parse($reqV)->numify; + $instV = version->parse($instV)->numify; + + #TODO suport for version range: + # https://metacpan.org/pod/ \ + # CPAN::Meta::Spec#Version-Range + if ( $reqV > 0 && $instV < $reqV ) { + + $pkgStatus{Perl}{pkgs}{$pkg}{status} = + 'outdated'; + push + @{ $pkgStatus{Perl}{outdated}{$pkg} }, + $reqV; + + $pkgStatus{Perl}{analyzed} = 1 + if ( $modMeta->{x_prereqs_src} ne + 'META.json' + && !$pkgStatus{Perl}{analyzed} ); + } + } + } + + $pkgStatus{Perl}{pkgs}{$pkg}{timestamp} = $t; + } + } + } + + #TODO + # nodejs + # python + } + } + + # build installation hash + foreach my $area ( keys %pkgStatus ) { + foreach my $t (qw(missing outdated)) { + if ( defined( $pkgStatus{$area}{$t} ) + && ref( $pkgStatus{$area}{$t} ) eq 'HASH' + && scalar keys %{ $pkgStatus{$area}{$t} } > 0 ) + { + foreach my $pkg ( keys %{ $pkgStatus{$area}{$t} } ) { + next + unless ( ref( $pkgStatus{$area}{$t}{$pkg} ) eq 'ARRAY' ); + + # detect minimum required version + # for missing and outdated packages + my $v = maxNum( 0, @{ $pkgStatus{$area}{$t}{$pkg} } ); + $pkgStatus{$area}{$t}{$pkg} = $v; + + if ( + defined( + $pkgStatus{$area}{pkgs}{$pkg}{modules}{requires} + ) + && @{ $pkgStatus{$area}{pkgs}{$pkg}{modules}{requires} } + > 0 + ) + { + $pkgStatus{counter}{total}++; + $pkgStatus{counter}{$t}++; + $pkgStatus{counter}{required}{total}++; + $pkgStatus{counter}{required}{$t}++; + $pkgStatus{counter}{required}{$area}{total}++; + $pkgStatus{counter}{required}{$area}{$t}++; + $pkgStatus{counter}{$area}{total}++; + $pkgStatus{counter}{$area}{$t}++; + $pkgStatus{counter}{$area}{required}{total}++; + $pkgStatus{counter}{$area}{required}{$t}++; + + $pkgStatus{required}{$area}{$pkg}{status} = $t; + $pkgStatus{required}{$area}{$pkg}{version} = $v; + $pkgStatus{required}{$area}{$pkg}{modules} = + $pkgStatus{$area}{pkgs}{$pkg}{modules}{requires}; + + # add other modules + if ( + defined( + $pkgStatus{$area}{pkgs}{$pkg}{modules} + {recommends} + ) + && @{ + $pkgStatus{$area}{pkgs}{$pkg}{modules} + {recommends} + } > 0 + ) + { + foreach my $modName ( + @{ + $pkgStatus{$area}{pkgs}{$pkg}{modules} + {recommends} + } + ) + { + push + @{ $pkgStatus{required}{$area}{$pkg}{modules} + }, + $modName + unless ( + grep ( /^$modName$/, + @{ + $pkgStatus{required}{$area} + {$pkg}{modules} + } ) + ); + } + } + + if ( + defined( + $pkgStatus{$area}{pkgs}{$pkg}{modules}{suggests} + ) + && @{ + $pkgStatus{$area}{pkgs}{$pkg}{modules}{suggests} + } > 0 + ) + { + foreach my $modName ( + @{ + $pkgStatus{$area}{pkgs}{$pkg}{modules} + {suggests} + } + ) + { + push + @{ $pkgStatus{required}{$area}{$pkg}{modules} + }, + $modName + unless ( + grep ( /^$modName$/, + @{ + $pkgStatus{required}{$area} + {$pkg}{modules} + } ) + ); + } + } + } + elsif ( + defined( + $pkgStatus{$area}{pkgs}{$pkg}{modules}{recommends} + ) + && @{ $pkgStatus{$area}{pkgs}{$pkg}{modules}{recommends} + } > 0 + ) + { + $pkgStatus{counter}{total}++; + $pkgStatus{counter}{$t}++; + $pkgStatus{counter}{recommended}{total}++; + $pkgStatus{counter}{recommended}{$t}++; + $pkgStatus{counter}{recommended}{$area}{total}++; + $pkgStatus{counter}{recommended}{$area}{$t}++; + $pkgStatus{counter}{$area}{total}++; + $pkgStatus{counter}{$area}{$t}++; + $pkgStatus{counter}{$area}{recommended}{total}++; + $pkgStatus{counter}{$area}{recommended}{$t}++; + + $pkgStatus{recommended}{$area}{$pkg}{status} = $t; + $pkgStatus{recommended}{$area}{$pkg}{version} = $v; + $pkgStatus{recommended}{$area}{$pkg}{modules} = + $pkgStatus{$area}{pkgs}{$pkg}{modules}{recommends}; + + # add other modules + if ( + defined( + $pkgStatus{$area}{pkgs}{$pkg}{modules}{suggests} + ) + && @{ + $pkgStatus{$area}{pkgs}{$pkg}{modules}{suggests} + } > 0 + ) + { + foreach my $modName ( + @{ + $pkgStatus{$area}{pkgs}{$pkg}{modules} + {suggests} + } + ) + { + push @{ $pkgStatus{recommended}{$area}{$pkg} + {modules} }, + $modName + unless ( + grep ( /^$modName$/, + @{ + $pkgStatus{recommended}{$area} + {$pkg}{modules} + } ) + ); + } + } + } + elsif ( + defined( + $pkgStatus{$area}{pkgs}{$pkg}{modules}{suggests} + ) + && @{ $pkgStatus{$area}{pkgs}{$pkg}{modules}{suggests} } + > 0 + ) + { + $pkgStatus{counter}{total}++; + $pkgStatus{counter}{$t}++; + $pkgStatus{counter}{suggested}{total}++; + $pkgStatus{counter}{suggested}{$t}++; + $pkgStatus{counter}{suggested}{$area}{total}++; + $pkgStatus{counter}{suggested}{$area}{$t}++; + $pkgStatus{counter}{$area}{total}++; + $pkgStatus{counter}{$area}{$t}++; + $pkgStatus{counter}{$area}{suggested}{total}++; + $pkgStatus{counter}{$area}{suggested}{$t}++; + + $pkgStatus{suggested}{$area}{$pkg}{status} = $t; + $pkgStatus{suggested}{$area}{$pkg}{version} = $v; + $pkgStatus{suggested}{$area}{$pkg}{modules} = + $pkgStatus{$area}{pkgs}{$pkg}{modules}{suggests}; + } + } + } + else { + $pkgStatus{counter}{$t} = 0; + $pkgStatus{counter}{required}{$t} = 0; + $pkgStatus{counter}{required}{$area}{$t} = 0; + $pkgStatus{counter}{recommended}{$t} = 0; + $pkgStatus{counter}{recommended}{$area}{$t} = 0; + $pkgStatus{counter}{suggested}{$t} = 0; + $pkgStatus{counter}{suggested}{$area}{$t} = 0; + $pkgStatus{counter}{$area}{$t} = 0; + $pkgStatus{counter}{$area}{required}{$t} = 0; + $pkgStatus{counter}{$area}{recommended}{$t} = 0; + $pkgStatus{counter}{$area}{suggested}{$t} = 0; + } + } + } + + if (@rets) { + $@ = join( "\n", @rets ); + return "$@"; + } + + return undef; +} + +#TODO +# Checks whether a NodeJS package is installed in the system +sub __IsInstalledNodejs($) { + return 0 unless ( __PACKAGE__ eq caller(0) ); + return 0 unless (@_); + my ($pkg) = @_; + + return 0; +} + +#TODO +# Checks whether a Python package is installed in the system +sub __IsInstalledPython($) { + return 0 unless ( __PACKAGE__ eq caller(0) ); + return 0 unless (@_); + my ($pkg) = @_; + + return 0; +} + +sub __GetExtendedEnvPath { + return 0 unless ( __PACKAGE__ eq caller(0) ); + my @binpath = ( + $Config::Config{'installsitebin'}, + $Config::Config{'installsitescript'}, + $Config::Config{'sitebin'}, + $Config::Config{'sitescript'}, + $Config::Config{'installscript'}, + $Config::Config{'installvendorbin'}, + $Config::Config{'installvendorscript'}, + $Config::Config{'initialinstalllocation'}, + $Config::Config{'bin'} + ); + + my @path = split( /:/, $ENV{PATH} ); + + foreach my $p ( reverse @binpath ) { + next unless ( $p && $p ne '' ); + $p =~ s/\\/\\\\/g if ( $^O =~ m/Win/ ); + unshift @path, $p unless ( grep ( /^$p$/, @path ) ); + } + + return join( ":", @path ); +} + +sub __ToDay() { + my ( $sec, $min, $hour, $mday, $month, $year, $wday, $yday, $isdst ) = + localtime( gettimeofday() ); + + $month++; + $year += 1900; + + my $today = sprintf( '%04d-%02d-%02d', $year, $month, $mday ); + + return $today; +} + +sub __aUniq { + my %seen; + grep !$seen{$_}++, @_; +} + +use B qw/svref_2object/; + +sub __in_package { + return 0 unless ( __PACKAGE__ eq caller(0) ); + my ( $coderef, $package ) = @_; + my $cv = svref_2object($coderef); + return if not $cv->isa('B::CV') or $cv->GV->isa('B::SPECIAL'); + return $cv->GV->STASH->NAME eq $package; +} + +sub __list_module { + return 0 unless ( __PACKAGE__ eq caller(0) ); + my $module = shift; + my $inPackage = shift; + no strict 'refs'; + return grep { + defined &{"$module\::$_"} + and ( $inPackage ? __in_package( \&{*$_}, $module ) : 1 ) + } + keys %{"$module\::"}; +} +1; + +=pod +=encoding utf8 +=item helper +=item summary Module to help with FHEM installations +=item summary_DE Modul zur Unterstuetzung bei FHEM Installationen + +=begin html + + +

+ Installer +

+
    + Installer - Module to update FHEM, install 3rd-party FHEM modules and manage system prerequisites
    +
    +
    + Define
    +
      + define <name> Installer
      +
      + Example:
      +
        + define fhemInstaller Installer
        +

      +

    +
    + Get +
      +
    • checkPrereqs - list all missing prerequisites. If no parameter was given, the running live system will be inspected. If the parameter is a FHEM cfg file, inspection will be based on devices from this file. If the parameter is a list of module names, those will be used for inspection. +
      • +
    • search - search FHEM for device names, module names, package names, keywords, authors and Perl package names. +
      • +
    • showModuleInfo - list information about a specific FHEM module +
      • +
    • showPackageInfo - list information about a specific FHEM package +
      • +
    • zzGetModuleMETA.json - prints raw meta information of a FHEM module in JSON format +
      • +
    • zzGetPackageMETA.json - prints raw meta information of a FHEM package in JSON format +
      • +

    +
    + Attributes +
      +
    • disable - disables the device +
      • +
    • disabledForIntervals - disable device for interval time (13:00-18:30 or 13:00-18:30 22:00-23:00) +
      • +
    • installerMode - sets the installation mode. May be update, developer or install with update being the default setting. Some get and/or set commands may be hidden or limited depending on this. +
      • +
    +
+ +=end html + +=begin html_DE + +

+ +

+

+ Installer +

+
    + Eine deutsche Version der Dokumentation ist derzeit nicht vorhanden. Die englische Version ist hier zu finden: +
+ + +=end html_DE + +=for :application/json;q=META.json 98_Installer.pm +{ + "abstract": "Module to update FHEM, install 3rd-party FHEM modules and manage system prerequisites", + "x_lang": { + "de": { + "abstract": "Modul zum Update von FHEM, zur Installation von Drittanbieter FHEM Modulen und der Verwaltung von Systemvoraussetzungen" + } + }, + "version": "v0.5.7", + "release_status": "stable", + "author": [ + "Julian Pawlowski " + ], + "x_fhem_maintainer": [ + "loredo" + ], + "x_fhem_maintainer_github": [ + "jpawlowski" + ], + "keywords": [ + "Dependencies", + "Prerequisites", + "Setup" + ], + "prereqs": { + "runtime": { + "requires": { + "Data::Dumper": 0, + "Encode": 0, + "FHEM": 5.00918623, + "FHEM::Meta": 0.001006, + "FHEM::npmjs": 0, + "File::stat": 0, + "GPUtils": 0, + "HttpUtils": 0, + "IO::Socket::SSL": 0, + "Config": 0, + "ExtUtils::Installed": 0, + "B": 0, + "JSON::PP": 0, + "perl": 5.014, + "version": 0, + "SubProcess": 0 + }, + "recommends": { + "Perl::PrereqScanner::NotQuiteLite": 0, + "JSON": 0 + }, + "suggests": { + "Cpanel::JSON::XS": 0, + "JSON::XS": 0 + } + } + }, + "resources": { + "bugtracker": { + "web": "https://github.com/fhem/Installer/issues" + } + } +} +=end :application/json;q=META.json + +=cut