Perl，无法捕获 return 代码？

Question

提前谢谢你。我不是 Perl 开发人员，但是，我真的很喜欢 Perl。喜欢bash/unix脚本，强大..我想把它作为我的脚本语言来学习，但是，现在我没有那个时间。

我的问题是 return 代码。

问题描述：我使用 Nagios Core 进行监控。我的任务是监视远程服务器上的日志文件，当日志中存在特定语句时，拉出该行，提取文件名，然后将此文件复制回摄取端点。我正在使用用 Perl 编写的 Nagios 插件，Check_logfiles。一个非常优秀和强大的插件。我可以在 Perl 脚本中编写挂钩，以对触发的事件执行任务。

这是我的插件脚本，在 check_logfiles 配置中作为子例程调用编写。

$scriptpath = 'C:\Program Files (x86)\Nagios\NCPA\contrib';
$protocolsdir = 'C:\Program Files (x86)\Nagios\NCPA\protocols';
$seekfilesdir = 'C:\Program Files (x86)\Nagios\NCPA\seek';

$MACROS = {
    LOGS_DIR => 'C:\APMConnect\Logs',
    PP_INGESTION_EP => 'C:\APMConnect\AutoDataLoader\Scandir\ManageAPM',
    SRC_DIR => 'E:\Zip File Archive'
};

#$postscript = 'custom_mail_alert.pl';
#$postscriptparams = '--sender alpcts000000881@ge.com --recpt gary.l.mills@ge.com --subject "Notification - APM Loader refeed performed" --message "$CL_SERVICEOUTPUT$" --log-file "C:\APMConnect\Logs\AutoLoader.log" --send_if_rc_gt 1 --display-name "Aviation Preprocessor Notification"';
#$postscriptstdin = '$CL_HOSTNAME$\t$CL_SERVICEDESC$\t$CL_SERVICESTATEID$\t$CL_SERVICEOUTPUT$\n';
    
@searches = (
  {
    tag => '504 Gateway Time-Out',
    logfile => '$LOGS_DIR$\AutoLoader.log',
    rotation => 'AutoLoader.log.\d{1,2}',
    type => 'rotating',
    criticalpatterns => [
        '^java.lang.Exception:Method failed: HTTP/1.1 504 Gateway Time-out Please check configuration details and replace or update the file :.*'
    ],
    options => 'protocol,perfdata,script,supersmartscript',
    script => sub {
        use File::Copy;
        
        $map_drive = 'C:\Windows\System32\net.exe use E: \win.alphp031.corp.bp.com\APM_Data_Storage /USER:lp814555sv xnEDs7PaD3g /PERSISTENT:YES';
        my $status = system("$map_drive 2>&1");
        my $exit_code = ($status >> 8) & 0xff;
        
#       if ( $exit_code!=0 ) {
#           printf "Exit Code: $exit_code\n";
#           printf "Status: $status\n";
#           printf 'CRITICAL - APM Data Storage NAS Share Cannot be mounted!';
#           return 2;
#       }
#       my $file_name = "BHPJanFP_2018-06-25-06-43-09.csv";
#       my $source_dir = 'C:\Users2555427\TEMP\A';
        my $target_dir = 'C:\Users2555427\TEMP\B';
#       my $sout = 'java.lang.Exception:Method failed: HTTP/1.1 504 Gateway Time-out Please check configuration details and replace or update the file : \ALPCTS000000881\Archivedir\PROCESS_ADL\FaultData20200826144206065.zip';
        
        my $_source_dir = $ENV{CHECK_LOGFILES_SRC_DIR};
        my $_target_dir = $ENV{CHECK_LOGFILES_PP_INGESTION_EP};
        my $sout = $ENV{CHECK_LOGFILES_SERVICEOUTPUT};
        my $result = rindex($sout, 'FaultData');
        my $_file_name = substr($sout, $result, length($sout));
        opendir(my $DIR, $_source_dir) || die "Can't opendir $_source_dir: $!"; 

        if( -f "$_source_dir/$_file_name" ) {
            copy ("$_source_dir\$_file_name", "$target_dir\$_file_name") || die "File Copy Failed: $!";
            if ( $? == 0 ) {
                printf 'OK - File Copy Successful!';
                printf " Copied File to Refeed APM: $_source_dir\$_file_name";
                return 0;
            } else {
                printf 'CRITICAL - File Copy Failed!';
                printf " Source dir: $_source_dir\$_file_name";
                return 2;
            }
        } else {
            printf 'CRITICAL - File Copy Failed, File CANNOT be located!';
            printf "Source dir: $_source_dir\$_file_name";
            return 2;
        }
        closedir($DIR);
    }
  }
);

我的问题从这里开始，映射 NAS 驱动器。我不知道如何获取和/或操纵 return 代码。因为有一个条件是 NAS 驱动器已经安装并且正在使用中。如果此条件存在，我也想允许执行，如果它已成功安装。

my $status = system("$map_drive 2>&1");

当磁盘已经安装时我得到这个

C:\Program Files (x86)\Nagios\NCPA\plugins\check_logfiles-3.12\plugins-scripts>check_logf
check_logfiles.cfg"
System error 85 has occurred.

The local device name is already in use.

CRITICAL - (1 errors in check_logfiles.protocol-2020-09-24-13-40-27) - 
Exit Code: 2
Status: 512

我需要继续执行此状态和0或成功挂载的状态。

如何捕获这些 return 代码？

所以我本质上需要伪代码之类的东西...

my $status = system("$map_drive 2>&1");
if ( $status != 0 || $status != rc = System error 85 has occurred ) {
   printf 'CRITICAL - APM Data Storage NAS Share Cannot be mounted!';
   return 2;  (*** 2 here is for Nagios )

我发现 return 系统代码我相信，找不到 net 命令？来自 https://docs.microsoft.com/en-us/windows/win32/debug/system-error-codes--0-499-

ERROR_ALREADY_ASSIGNED

85 (0x55)

本地设备名称已被使用。

但是做完之后... 我的 $status = system("$map_drive 2>&1"); 我的 $exit_code = ($status >> 8) & 0xff;

对于 ALREADY IN USE 或已经安装的情况，我得到“2”。

以确保调用中断或退出的所有其他条件以及两个 GOOD 条件允许处理或执行。

我希望这是有道理的，请告诉我，谢谢!!!

Answer 1

system returns 进程的退出代码，也在$?.

$^E returns the "extended OS error" and is used on operating systems which have separate ways of returning process error codes. On Windows, this is the result of GetLastError which gives system error codes.

Under Win32, $^E always returns the last error information reported by the Win32 call "GetLastError()" which describes the last error from within the Win32 API. Most Win32-specific code will report errors via $^E. ANSI C and Unix-like calls set "errno" and so most portable Perl code will report errors via $!.

所以你的支票应该是这样的...

my $exit = system("$map_drive 2>&1");
my $error = $^E;
if ( $exit != 0 || $error == 85 ) {

我已重命名 $status 以避免混淆。我已经将 $^E 分配给一个词法变量，因为它是一个全局变量，将被另一个系统调用覆盖。

Perl，无法捕获 return 代码？

Perl, can't capture return codes?

perl

return-value