Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

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

Tags:

linux

perl

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.

like image 489
Morrow2 Avatar asked Dec 22 '22 14:12

Morrow2


1 Answers

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.

like image 140
Dada Avatar answered May 03 '23 03:05

Dada