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

I've been working on an old Perl script which stopped working after updating my Perl environment.

This is the script in question (I've added use Data::Dumper; print Dumper \@checks; as suggested in the comments):

#!/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;

When I try to run the script I keep on getting this error, no matter which parameter I use (drives, paths, 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.

Line 23 is push @checks, {.

I currently don't understand what the problem is, because before upgrading my Perl version it was working fine.

CodePudding user response：

@Dada describes the issue, but you're seeing the same code work on an old version and fail on a newer release, which is unusual - why didn't it fail on the old setup too? Here's why:

In Getopt::Long version 2.37, the argument passed to callback functions in argument handlers was changed from a plain string to an object (A blessed hashref in this case), with fields including name. However, in 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.

So your old, working, installation must have been using version 2.37 or 2.38, where the provided code accessing the name field worked fine. 2.39 or newer breaks it (As would 2.36 or older).

CodePudding user response：

The issue comes from the line

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

$_[0] refers to the first argument of the enclosing subroutine (which starts at '<>' => sub {). According to the documentation of Getopt::Long's <> option, this subroutine is called once per non-option argument of your command line, with this "non-option argument" as its single argument. If you add use Data::Dumper; print Dumper \@_; at the beginning of this subroutine, you'll get as output:

$VAR1 = [
          'dbspace'
        ];

Thus, $_[0] is the string "dbspace", rather than a hash reference. Doing $_[0]->{'name'} makes no sense. Instead, you probably just want to use $_[0]:

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

See @shawn's answer to understand why updating Perl broke your script.