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

Posted 2023-03-24

【中文标题】Perl：在使用“严格引用”时不能使用字符串（“XXX”）作为 HASH 引用

【英文标题】：Perl: Can't use string ("XXX") as a HASH ref while "strict refs" in use

【发布时间】：2022-01-15 18:05:03

【问题描述】：

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

这是有问题的脚本（我已按照 cmets 中的建议添加了 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;

当我尝试运行脚本时，无论我使用哪个参数（驱动器、路径、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 版本之前它工作正常。

【问题讨论】：

您确定发布了您正在调用的脚本的确切内容吗？因为我不希望您在第 44 行出现错误。复制脚本，并在“foreach my $check”行之前添加以下行：'use Data::Dumper;打印自卸车\@checks;'并向我们​​展示它产生的输出（将其添加到原始问题的末尾）

@Shawn：我已经从我的问题中删除了脚本的“帮助”部分。我没有意识到我没有更改错误行号以反映该更改。最初第 44 行是：“push checks”

@DaveMitchell：正如你告诉我的，我已经更新了我的代码，但输出似乎没有改变......

【参考方案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],
  ...

请参阅 @shawn's answer 以了解更新 Perl 会破坏您的脚本的原因。

【讨论】：

请注意，更新到更新版本的 Perl 并没有真正破坏您的脚本：它实际上从未工作过。 有一个窗口可以工作，虽然我没有'感觉无法追踪与Getopt::Long 的必要版本捆绑在一起的 perl 的确切版本。看我的回答。

@Shawn 感谢您指出这一点并且很好！我已经删除了答案的结尾（这是错误的）。 :)

@Dada：这就是解决方案，感谢你和这个帖子中的所有人

【参考方案2】：

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

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

将对象作为第一个参数传递给<> 的回调处理程序在将参数传递给其他模块（例如Archive::Tar）的情况下会出现问题。还原更改，因为对象的添加功能与 <> 回调函数并不真正相关。

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

【讨论】：

看起来 perl 5.8.9 使用了 Getopt::Long 2.37、5.10.1 和 5.12.0 都说他们更新到 2.38，并且 5.20.0 更新日志提到从 2.39 更新。也许 5.12.0 的变更日志有错字，那是 2.39 合并的时候？

好收获。进行此更改时，文档有点误导，因为它仍然说 This will call process("arg1") （尽管上面说 嗯，实际上它是一个字符串化的对象到参数名称。，但很容易错过这一行）。有趣的是（或没有），正如您提到的，此更改在 2.39 中恢复，那是在 2013 年，但文档仅在 2.51（2019 年）或 6 年后才更新。