Perl：在使用“严格引用”时不能使用字符串（“XXX”）作为哈希引用

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: $0 [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;

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

/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]是 string "dbspace"，而不是哈希引用。做事$_[0]->{'name'}没有任何意义。相反，您可能只想使用$_[0]：

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

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

Answer 2

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

在Getopt::Long版本 2.37 中，传递给参数处理程序中的回调函数的参数从纯字符串更改为对象（在本例中为受祝福的 hashref），其中字段包括name. 然而，在2.39...

在将参数传递给<>其他模块（例如Archive::Tar. 恢复更改，因为对象的添加功能与<>回调函数并不真正相关。

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