如何检查 perl 模块是否可用？

Question

我找到了this:

my $rc = eval
{
  require Term::ReadKey;
  Term::ReadKey->import();
  1;
};

if($rc)
{
  # Term::ReadKey loaded and imported successfully
  ...
}

但这不适用于在其他模块中定义的包，例如：

{
  package Hi::Test;
}    

my $rc =  eval{ require Hi::Test };

$rc 在这里是假的。

如何检查“Hi::Test”是否可用？

Answer 1

我假设该包中确实发生了一些事情，而不仅仅是一个空块。

以下代码检查该包的符号表中是否有任何条目。它很脏，但只要注册了 subs 或 package 变量，它就可以工作。

{
  package Hi::Test;

  sub foo;
}

my $rc =  eval{ require Hi::Test };
if (! $rc) {
  $rc = do {
    no strict;
    *stash = *{"Hi::Test::"};
    scalar keys %stash;
  }
}

print $rc;

它将打印1。

Answer 2

你想要defined(*Hi::Test::) 之类的东西，只是简单地提及*Hi::Test:: 会创建包。

$ perl -E'
   say defined(*Hi::Test::) ? "exists" : "doesn'\''t exist";
'
exists

通过使用符号引用，您可以避免这个问题。

$ perl -E'
   { package Hi::Test }
   say defined(*{"Hi::Test::"}) ? "exists" : "doesn'\''t exist";
   say defined(*{"Hi::TEST::"}) ? "exists" : "doesn'\''t exist";
'
exists
doesn't exist

将该代码放在子程序中以使事情更清洁。

$ perl -E'
   use strict;
   use warnings;

   sub test_for_package {
      my ($pkg_name) = @_;
      $pkg_name .= "::";
      return defined(*$pkg_name);
   }

   { package Hi::Test }
   say test_for_package("Hi::Test") ? "exists" : "doesn'\''t exist";
   say test_for_package("Hi::TEST") ? "exists" : "doesn'\''t exist";
'
exists
doesn't exist

请注意，创建包Foo::Bar::Baz 也会创建包Foo 和Foo::Bar。

Answer 3

我对此有点生疏，但我认为你的 require 无论如何都会失败 - 这个错误：

#!/usr/bin/perl

{
    package Hi::Test;

    sub foo {
        print "bar\n";
    }
}

{
    package main;
    require Hi::Test; 
}

这个错误 - 它无法找到它 @INC（因为它不在 @INC 中）。 use 和 require 都专门告诉 perl“出去找一个模块文件”

但你仍然可以调用 'foo'：

Hi::Test::foo();

因此您无法使用 eval 测试模块的加载，也无法检查 %INC 。

但是你可以做的是检查%Hi:::

use Data::Dumper;
print Dumper \%Hi::;
print Dumper \%Hi::Test::;

这给了我们：

$VAR1 = {
          'Test::' => *{'Hi::Test::'}
        };
$VAR1 = {
          'foo' => *Hi::Test::foo
        };

所以我们可以：

print "Is loaded" if defined $Hi::{'Test::'}

Answer 4

更新
我找到了这个线索：

my $module =  *main::;
my @sub_name =  split '::', $full_name;
while( each @sub_name ) {
    $module =  $$module{ $sub_name[$_].'::' };
}
print "Module is available"   if $module;

与this 答案相比，它不会在全局存储中创建额外的变量