Perl:Can't使用字符串("XXX")作为HASH ref;严格参考文献";

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 setn") if !defined $opt{'host'};
$plugin->nagios_exit(UNKNOWN, "username not setn") if !defined $opt{'username'};
$plugin->nagios_exit(UNKNOWN, "password not setn") if !defined $opt{'password'};
$plugin->nagios_exit(UNKNOWN, "no check specifiedn") 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的<>选项的文档，该子例程在命令行的每个非选项参数中调用一次；非选项自变量"；作为其唯一的论据。如果你在这个子程序的开头添加use Data::Dumper; print Dumper @_;，你会得到输出：

$VAR1 = [
'dbspace'
];

因此，$_[0]是字符串"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或更新版本也会打破它(。