Perl：在使用 "strict refs" 时不能使用字符串 ("XXX") 作为 HASH 引用

Question

我一直在处理一个旧的 Perl 脚本，它在更新我的 Perl 环境后停止工作。

这是有问题的脚本（我已经按照评论中的建议添加了 use Data::Dumper; print Dumper \@checks;）：

#!/usr/bin/perl -w
use warnings;
use strict;
use sort 'stable';
use File::Spec;
use File::Temp qw(tempdir);
use Getopt::Long;
use Nagios::Plugin;
use Nagios::Plugin::Threshold;

my $PROGRAM = 'check_tsm';
my $VERSION = '0.2';

my $default_tsm_dir = '/opt/tivoli/tsm/client/ba/bin';
my $plugin = Nagios::Plugin->new(shortname => $PROGRAM);
my %opt = ('tsm-directory' => $default_tsm_dir);
my @checks;
Getopt::Long::config('bundling');
Getopt::Long::GetOptions(\%opt, 'host|H=s', 'username|U=s', 'password|P=s',
  'port|p=i',
  'tsm-directory=s', 'warning|w=s', 'critical|c=s', 'bytes', 'help', 'version',
  '<>' => sub {
    push @checks, {
      'type' => $_[0]->{'name'},
      'warning' => $opt{'warning'}, #$opt{'warning'} eq '-' ? undef : $opt{'warning'},
      'critical' => $opt{'critical'}, #$opt{'critical'} eq '-' ? undef : $opt{'critical'},
    };
  }) || exit UNKNOWN;
if ($opt{'help'}) {
  print "Usage: [=12=] [OPTION]... CHECK...\n";
}

$plugin->nagios_exit(UNKNOWN, "host not set\n") if !defined $opt{'host'};
$plugin->nagios_exit(UNKNOWN, "username not set\n") if !defined $opt{'username'};
$plugin->nagios_exit(UNKNOWN, "password not set\n") if !defined $opt{'password'};
$plugin->nagios_exit(UNKNOWN, "no check specified\n") if !@checks;

use Data::Dumper; print Dumper \@checks;
foreach my $check (@checks) {
  if ($check->{'type'} eq 'drives') {
    $check->{'text'} = 'Online drives';
    $check->{'query'} = "select count(*) from drives where online='YES'";
    $check->{'warning'} //= '2:';
    $check->{'critical'} //= '1:';
    $check->{'order'} = 0;
  } elsif ($check->{'type'} eq 'paths') {
    $check->{'text'} = 'Online paths';
    $check->{'query'} = "select count(*) from paths where online='YES' and destination_type='DRIVE'";
    $check->{'warning'} //= '2:';
    $check->{'critical'} //= '1:';
    $check->{'order'} = 0;
  } elsif ($check->{'type'} eq 'dbspace') {
    $check->{'text'} = 'Database space utilization';
    $check->{'query'} = "select used_db_space_mb, tot_file_system_mb from db";
    $check->{'warning'} //= 90;
    $check->{'critical'} //= 95;
    $check->{'order'} = 0;
  } elsif ($check->{'type'} eq 'logspace') {
    $check->{'text'} = 'Log space utilization';
    $check->{'query'} = "select used_space_mb, total_space_mb from log";
    $check->{'warning'} //= 90;
    $check->{'critical'} //= 95;
    $check->{'order'} = 0;
  } elsif ($check->{'type'} eq 'badvols') {
    $check->{'text'} = 'Error or read-only volumes';
    #$check->{'query'} = "select count(*) from volumes where error_state='YES' or access='READONLY'";
    $check->{'query'} = "select count(*) from volumes where (error_state='YES' and access='READONLY') or access='UNAVAILABLE'";
    $check->{'warning'} //= 0;
    $check->{'critical'} //= 0;
    $check->{'order'} = 0;
  } elsif ($check->{'type'} eq 'reclaimvols') {
    $check->{'text'} = 'Volumes needing reclamation';
    $check->{'query'} = "select count(*) from volumes join stgpools on volumes.stgpool_name=stgpools.stgpool_name where volumes.pct_reclaim>stgpools.reclaim and volumes.status='FULL' and volumes.access='READWRITE'";
    $check->{'warning'} //= 50;
    $check->{'critical'} //= 100;
    $check->{'order'} = 0;
  } elsif ($check->{'type'} eq 'freelibvols') {
    $check->{'text'} = 'Scratch library volumes';
    $check->{'query'} = "select count(*) from libvolumes where status='Scratch'";
    $check->{'warning'} //= '5:';
    $check->{'critical'} //= '1:';
    $check->{'order'} = 0;
  } elsif ($check->{'type'} eq 'reqs') {
    $check->{'text'} = 'Outstanding requests';
    $check->{'query'} = 'query request';
    $check->{'warning'} //= 0;
    $check->{'critical'} //= 1; # Critical not used since we only return 0 or 1
    $check->{'order'} = 1;
  } else {
    $plugin->nagios_exit(UNKNOWN, "unknown check ".$check->{'type'}."\n");
  }
}

# This needs stable sort in order so that reqs checks are always last
@checks = sort { $a->{'order'} <=> $b->{'order'} } @checks;

当我尝试运行脚本时，无论我使用哪个参数（驱动器、路径、dbspace ...），我都会收到此错误：

/usr/local/nagios/libexec/check_tsm --host=<IP ADDRESS> --port=<TCP PORT> --username=<USER> --password=<PASSWORD> --critical=85 --warning=80 dbspace
Can't use string ("dbspace") as a HASH ref while "strict refs" in use at /usr/local/nagios/libexec/check_tsm.tst line 23.

第 23 行是 push @checks, {。

我目前不明白问题出在哪里，因为在升级我的 Perl 版本之前它工作正常。

Answer 1

问题来自行

'type' => $_[0]->{'name'},

$_[0] 指的是封闭子例程的第一个参数（从 '<>' => sub { 开始）。根据 Getopt::Long's <> option 的文档，此子例程针对命令行的每个非选项参数调用一次，并将此“非选项参数”作为其单个参数。如果您在此子例程的开头添加 use Data::Dumper; print Dumper \@_;，您将获得输出：

$VAR1 = [
          'dbspace'
        ];

因此，$_[0] 是字符串 "dbspace"，而不是散列引用。做 $_[0]->{'name'} 没有意义。相反，您可能只想使用 $_[0]:

push @checks, {
  'type' => $_[0],
  ...

请参阅以了解为什么更新 Perl 会破坏您的脚本。

Answer 2

@Dada 描述了这个问题，但是您看到相同的代码在旧版本上工作而在新版本上失败，这是不寻常的 - 为什么它在旧设置上也没有失败？原因如下：

在 Getopt::Long 版本 2.37 中，参数处理程序中传递给回调函数的参数从普通字符串更改为对象（在本例中是一个 blessed hashref），字段包括 name。然而，在 2.39...

Passing an object as first argument to the callback handler for <> turned out to be a problem in cases where the argument was passed to other modules, e.g., Archive::Tar. Revert the change since the added functionality of the object is not really relevant for the <> callback function.

因此，您的旧的、有效的安装必须使用版本 2.37 或 2.38，其中提供的访问名称字段的代码工作正常。 2.39 或更新版本会破坏它（2.36 或更早版本也会）。

Perl：在使用 "strict refs" 时不能使用字符串 ("XXX") 作为 HASH 引用

Perl: Can't use string ("XXX") as a HASH ref while "strict refs" in use

linux

perl