diff --git a/fhem/FHEM/98_Installer.pm b/fhem/FHEM/98_Installer.pm index 57d373bf9..ab6689a49 100644 --- a/fhem/FHEM/98_Installer.pm +++ b/fhem/FHEM/98_Installer.pm @@ -34,185 +34,6 @@ use GPUtils qw(GP_Import); use JSON; use Data::Dumper; -# based on https://metacpan.org/release/perl -my @perlPragmas = qw( - attributes - autodie - autouse - base - bigint - bignum - bigrat - blib - bytes - charnames - constant - diagnostics - encoding - feature - fields - filetest - if - integer - less - lib - locale - mro - open - ops - overload - overloading - parent - re - sigtrap - sort - strict - subs - threads - threads::shared - utf8 - vars - vmsish - warnings - warnings::register -); - -# based on https://metacpan.org/release/perl -my @perlCoreModules = qw( - experimental - I18N::LangTags - I18N::LangTags::Detect - I18N::LangTags::List - IO - IO::Dir - IO::File - IO::Handle - IO::Pipe - IO::Poll - IO::Seekable - IO::Select - IO::Socket - IO::Socket::INET - IO::Socket::UNIX - Amiga::ARexx - Amiga::Exec - B - B::Concise - B::Showlex - B::Terse - B::Xref - O - OptreeCheck - Devel::Peek - ExtUtils::Miniperl - Fcntl - File::DosGlob - File::Find - File::Glob - FileCache - GDBM_File - Hash::Util::FieldHash - Hash::Util - I18N::Langinfo - IPC::Open2 - IPC::Open3 - NDBM_File - ODBM_File - Opcode - ops - POSIX - PerlIO::encoding - PerlIO::mmap - PerlIO::scalar - PerlIO::via - Pod::Html - SDBM_File - Sys::Hostname - Tie::Hash::NamedCapture - Tie::Memoize - VMS::DCLsym - VMS::Filespec - VMS::Stdio - Win32CORE - XS::APItest - XS::Typemap - arybase - ext/arybase/t/scope_0.pm - attributes - mro - re - Haiku - AnyDBM_File - B::Deparse - B::Op_private - Benchmark - Class::Struct - Config::Extensions - DB - DBM_Filter - DBM_Filter::compress - DBM_Filter::encode - DBM_Filter::int32 - DBM_Filter::null - DBM_Filter::utf8 - DirHandle - English - ExtUtils::Embed - ExtUtils::XSSymSet - File::Basename - File::Compare - File::Copy - File::stat - FileHandle - FindBin - Getopt::Std - Net::hostent - Net::netent - Net::protoent - Net::servent - PerlIO - SelectSaver - Symbol - Thread - Tie::Array - Tie::Handle - Tie::StdHandle - Tie::SubstrHash - Time::gmtime - Time::localtime - Time::tm - UNIVERSAL - Unicode::UCD - User::grent - User::pwent - blib - bytes - charnames - deprecate - feature - filetest - integer - less - locale - open - overload - overloading - sigtrap - sort - strict - subs - utf8 - vars - vmsish - warnings - warnings::register - OS2::ExtAttr - OS2::PrfDB - OS2::Process - OS2::DLL - OS2::REXX -); - # Run before module compilation BEGIN { # Import from main:: @@ -1139,6 +960,13 @@ sub CreateMetadataList ($$$) { ); next if ( $mAttr eq 'copyright' && !defined( $modMeta->{x_copyright} ) ); + next + if ( + $mAttr eq 'abstract' + && ( !defined( $modMeta->{abstract} ) + || $modMeta->{abstract} eq 'n/a' + || $modMeta->{abstract} eq '' ) + ); next if ( $mAttr eq 'description' @@ -1188,6 +1016,24 @@ sub CreateMetadataList ($$$) { && ( !defined( $modMeta->{resources} ) || !defined( $modMeta->{resources}{x_privacy} ) ) ); + 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_vcs} ) ) ); my $l = $linecount % 2 == 0 ? $rowOpenEven : $rowOpenOdd; my $mAttrName = $mAttr; @@ -1386,6 +1232,9 @@ sub CreateMetadataList ($$$) { && $modMeta->{resources}{x_support_community}{web} =~ m/^(?:https?:\/\/)?forum\.fhem\.de/i ); + $l .= 'Limited - ' + if ( $modMeta->{x_support_status} eq 'limited' ); + $l .= '{resources}{x_support_commercial}{web} @@ -1466,72 +1318,49 @@ sub CreateMetadataList ($$$) { { # Web link if ( defined( $modMeta->{resources}{repository}{web} ) ) { + + # master link my $url = $modMeta->{resources}{repository}{web}; - $url .= '/' unless ( $url =~ m/\/$/ ); - $url .= $modMeta->{resources}{repository}{x_branch_master} - if ( - defined( - $modMeta->{resources}{repository}{x_branch_master} - ) - ); if ( - defined( - $modMeta->{resources}{repository}{x_filepath} - ) - ) - { - $url .= '/' unless ( $url =~ m/\/$/ ); - $url .= - $modMeta->{resources}{repository}{x_filepath}; - $url .= '/' unless ( $url =~ m/\/$/ ); - $url .= $modMeta->{x_file}[2]; - - } - - if ( - defined( - $modMeta->{resources}{repository}{x_branch_master} - ) + defined( $modMeta->{resources}{repository}{x_branch} ) + && defined( $modMeta->{resources}{repository}{x_dev} ) && defined( - $modMeta->{resources}{repository}{x_branch_dev} + $modMeta->{resources}{repository}{x_dev}{x_branch} ) - && $modMeta->{resources}{repository}{x_branch_master} - ne $modMeta->{resources}{repository}{x_branch_dev} + && $modMeta->{resources}{repository}{x_branch} ne + $modMeta->{resources}{repository}{x_dev}{x_branch} ) { + # master entry $l .= 'View online source code: ' - . ( - defined( - $modMeta->{resources}{repository}{x_web_title} - ) ? $modMeta->{resources}{repository}{x_web_title} - : ( - defined( - $modMeta->{resources}{repository} - {x_branch_master} - ) - ? $modMeta->{resources}{repository} - {x_branch_master} - : 'master' - ) - ) . ''; + . $modMeta->{resources}{repository}{x_branch} + . ''; + # dev link $url = - $modMeta->{resources}{repository}{web}; - $url .= '/' unless ( $url =~ m/\/$/ ); - $url .= $modMeta->{resources}{repository}{x_branch_dev}; + $modMeta->{resources}{repository}{x_dev}{web}; + # dev entry $l .= ' | ' - . $modMeta->{resources}{repository}{x_branch_dev} - . ''; + . ( + defined( + $modMeta->{resources}{repository}{x_dev} + {x_branch} + ) + ? $modMeta->{resources}{repository}{x_dev}{x_branch} + : 'dev' + ) . ''; } + + # master entry else { $l .= '\n\r]+?)(?:\s+(\(last release only\)))?(?:\s+(?:<(.*)>))?$/ ? $colorGreen . 'IN USE' . $colorClose : $txtOpen . 'not' . $txtClose . ' in use'; - push @ret, 'This FHEM module is currently ' . $moduleUsage . '.' + push @ret, $lb . 'This FHEM module is currently ' . $moduleUsage . '.' unless ( $modName eq 'Global' ); push @ret, '

Perl Packages

'; @@ -1745,14 +1567,15 @@ m/^([^<>\n\r]+?)(?:\s+(\(last release only\)))?(?:\s+(?:<(.*)>))?$/ { push @ret, - $txtOpen . 'HINT:' - . $txtClose . "\n" + $txtOpen . 'Hint:' + . $txtClose + . $lb . 'This module does not provide Perl prerequisites from its metadata.' - . "\n" - . 'The following result is based on automatic source code analysis' - . "\n" + . $lb + . 'The following result is based on automatic source code analysis ' . 'and can be incorrect.' . $lb + . $lb if ( defined( $modMeta->{x_prereqs_src} ) && $modMeta->{x_prereqs_src} ne 'META.json' ); @@ -1823,10 +1646,11 @@ m/^([^<>\n\r]+?)(?:\s+(\(last release only\)))?(?:\s+(?:<(.*)>))?$/ if ( $importance eq 'required' ); } - my $isPerlPragma = ModuleIsPerlPragma($prereq); - my $isPerlCore = $isPerlPragma ? 0 : ModuleIsPerlCore($prereq); - my $isFhem = - $isPerlPragma || $isPerlCore ? 0 : ModuleIsInternal($prereq); + my $isPerlPragma = FHEM::Meta::ModuleIsPerlPragma($prereq); + my $isPerlCore = + $isPerlPragma ? 0 : FHEM::Meta::ModuleIsPerlCore($prereq); + my $isFhem = $isPerlPragma + || $isPerlCore ? 0 : FHEM::Meta::ModuleIsInternal($prereq); if ( $isPerlPragma || $isPerlCore || $prereq eq 'perl' ) { $installed = $installed ne 'installed' @@ -1872,11 +1696,12 @@ m/^([^<>\n\r]+?)(?:\s+(\(last release only\)))?(?:\s+(?:<(.*)>))?$/ push @ret, $tableClose; } elsif ( defined( $modMeta->{x_prereqs_src} ) ) { - push @ret, 'No known prerequisites.' . $lb . $lb; + push @ret, $lb . 'No known prerequisites.' . $lb . $lb; } else { push @ret, - 'Module metadata do not contain any prerequisites.' . "\n" + $lb + . 'Module metadata do not contain any prerequisites.' . "\n" . 'For automatic source code analysis, please install Perl::PrereqScanner::NotQuiteLite .' . $lb . $lb; @@ -2058,10 +1883,11 @@ m/^([^<>\n\r]+?)(?:\s+(\(last release only\)))?(?:\s+(?:<(.*)>))?$/ if ( $importance eq 'required' ); } - my $isPerlPragma = ModuleIsPerlPragma($prereq); - my $isPerlCore = $isPerlPragma ? 0 : ModuleIsPerlCore($prereq); - my $isFhem = - $isPerlPragma || $isPerlCore ? 0 : ModuleIsInternal($prereq); + my $isPerlPragma = FHEM::Meta::ModuleIsPerlPragma($prereq); + my $isPerlCore = + $isPerlPragma ? 0 : FHEM::Meta::ModuleIsPerlCore($prereq); + my $isFhem = $isPerlPragma + || $isPerlCore ? 0 : FHEM::Meta::ModuleIsInternal($prereq); if ( $isPerlPragma || $isPerlCore || $prereq eq 'perl' ) { $installed = $installed ne 'installed' @@ -2108,7 +1934,8 @@ m/^([^<>\n\r]+?)(?:\s+(\(last release only\)))?(?:\s+(?:<(.*)>))?$/ } - push @ret, 'Based on data generated by ' . $modMeta->{generated_by}; + push @ret, + $lb . $lb . 'Based on data generated by ' . $modMeta->{generated_by}; return $header . join( "\n", @ret ) . $footer; } @@ -2141,6 +1968,8 @@ sub __IsInstalledPerl($) { return version->parse($])->numify if ( $pkg eq 'perl' ); return $modules{'Global'}{META}{version} if ( $pkg eq 'FHEM' ); + return FHEM::Meta->VERSION() + if ( $pkg eq 'FHEM::Meta' || $pkg eq 'Meta' ); eval "require $pkg;"; @@ -2175,77 +2004,6 @@ sub __IsInstalledPython($) { return 0; } -sub ModuleIsPerlCore { - my ($module) = @_; - return grep ( /^$module$/, @perlCoreModules ) - ? 1 - : 0; -} - -sub ModuleIsPerlPragma { - my ($module) = @_; - return grep ( /^$module$/, @perlPragmas ) - ? 1 - : 0; -} - -sub ModuleIsInternal { - my ($module) = @_; - return 1 - if ( $module eq 'fhem.pl' || $module eq 'FHEM' || $module eq 'Global' ); - - my $p = GetModuleFilepath($module); - - # if module has a relative path, - # assume it is part of FHEM - return $p && ( $p =~ m/^(\.\/)?FHEM\/.+/ || $p =~ m/^(\.\/)?[^\/]+\.pm$/ ) - ? 1 - : 0; -} - -# Get file path of a Perl module -sub GetModuleFilepath { - my @path; - - foreach (@_) { - my $module = $_; - my $package = $module; - - # From This::That to This/That.pm - s/::/\//g, s/$/.pm/ foreach $module; - - if ( $module eq 'perl' ) { - push @path, $^X; # real binary - - # push @path, $ENV{_}; # symlink if any - } - elsif ( defined( $INC{$module} ) ) { - push @path, $INC{$module}; - } - else { - eval { - require $module; - 1; - }; - - if ( !$@ ) { - push @path, $INC{$module}; - } - else { - push @path, ''; - $@ = undef; - } - } - } - - if (wantarray) { - return @path; - } - elsif ( @path > 0 ) { - return join( ',', @path ); - } -} - #### my little helper sub ToDay() { @@ -2330,7 +2088,7 @@ sub ToDay() { "abstract": "Modul zum Update von FHEM, zur Installation von Drittanbieter FHEM Modulen und der Verwaltung von Systemvoraussetzungen" } }, - "version": "v0.0.2", + "version": "v0.0.3", "release_status": "testing", "author": [ "Julian Pawlowski "