Perl錯誤處理

Question

如何緩存perl中的錯誤？有沒有像JS一樣嘗試/緩存？我想如果有任何錯誤發生到腳本的開始。

如果有人對下面的腳本有改進的想法，讓我知道，因爲這是我在Perl中的第一個。該腳本只需循環永不停止。 :)

#!/usr/bin/perl 

use strict; 
use warnings; 

use LWP::UserAgent; 
use JSON; 
use HTTP::Request::Common qw(POST GET); 
use Encode qw(encode); 
use DBI; 
use Time::Piece; 

# Beware: we disable the SSL certificate check for this script. 
$ENV{PERL_LWP_SSL_VERIFY_HOSTNAME}=0; 

# Debugging: off=0, medium=3, extensive=5 
my $debuglevel=0; 
my ($host,$username,$password)=('192.168.xxx.xxx','xxxx','xxxx'); 

# Define cms api key and nodeid. 
my ($cmsapi,$cmsnode)=('xxxxxxxxx','1'); 

# Define all parameters to be logged each script's iteration. 
# @parameterlist[x][$parameterid,$parameterlongtext,$parametershorttext,$data] 
# which corresponds for FHEM's DbLog with: 
# @parameterlist[x][$parameterid,$parameterlongtext,READING ,VALUE] 
# $parameterlist[x][3] will be populated by the script, thus here undefined in each line (the last value is missing). 
my @parameterlist=(
    [3922,"Status TC","statusHeatPump"], 
    [3931,"Zunanja temperatura","outsideTemperature"], 
    [3924,"Status zalogovnika","statusBuffer"], 
    [3925,"Status bojlerja","statusBoiler"], 
    [3940,"Temperatura bojlerja","boilerTemperature"], 
    [3943,"Temperatura zalogovnika","bufferTemperature"], 
    [4331,"Temperatura nadstropja","floorTemperature"], 
    [3811,"Temperatura pritličja","groundTemperature"], 
); 

# We substitute the text for the burner's status with an integer, so plots are easier. 
# Define which parameter holds the burner's status. 
my $parameterstatusHeatPump=3922; 
my @statusHeatPumpmatrix=( 
    ["Off",0], 
    ["Heating mode",50], 
); 


sub trim() { 
    my $str = $_[0]; 
    $str =~ s/^\s+|\s+$//g; 
    return $str; 
}; 
print "DEBUG: *** Script starting ***\n" if($debuglevel>0); 

while (1) { 
    sleep 1; 

    my $ua=LWP::UserAgent->new; 
    my $request=HTTP::Request->new(GET=>'https://'.$host.'/api/auth/login.json?user='.$username.'&pwd='.$password); 
    my $response=$ua->request($request); 
    my $decoded=decode_json($response->decoded_content(charset => 'none')); 
    my $success=$decoded->{'Result'}{'Success'}; 
    my $sessionid=$decoded->{'SessionId'}; 

    print "DEBUG: ".$response->content."\n" if($debuglevel>4); 
    print "DEBUG: ".$success."\n" if($debuglevel>4); 

    my $i=0; 
    my $j=0; 
    my $parameterid; 
    my $dataValue; 
    my $rightnow; 
    my $data = "empty"; 

    while (defined($parameterlist[$i][0])) { 
     $parameterid=$parameterlist[$i][0]; 
     $request=HTTP::Request->new(GET=>'https://'.$host.'/api/menutree/read_datapoint.json?SessionId='.$sessionid.'&Id='.$parameterid); 
     $response=$ua->request($request); 
     $decoded=JSON->new->utf8->decode($response->decoded_content(charset => 'none')); 
     $success=$decoded->{'Result'}{'Success'}; 
     $dataValue=encode('UTF-8', $decoded->{'Data'}{'Value'}); 
     $parameterlist[$i][3]=&trim($dataValue); 

     if ($parameterlist[$i][0]==$parameterstatusHeatPump) { 
      $j=0; 
      while (defined($statusHeatPumpmatrix[$j][0])) { 
       if ($statusHeatPumpmatrix[$j][0] eq $parameterlist[$i][3]) { 
        $parameterlist[$i][3]=$statusHeatPumpmatrix[$j][1]; 

        print "DEBUG: Substituting text of HeatPump\n" if($debuglevel>0); 
       }; 
       $j++; 
      } 
     } 
     print "DEBUG: ".$response->content."\n" if($debuglevel>4); 
     print "DEBUG: ".$success."\n" if($debuglevel>4); 
     print "DEBUG: ".$parameterlist[$i][1]."=".$dataValue."\n" if($debuglevel>0); 

     $rightnow=localtime->strftime('%Y-%m-%d %H:%M:%S'); 
     if ($data eq "empty"){ 
      $data = $parameterlist[$i][2].':'.$parameterlist[$i][3]; 
     } 
     else{ 
     $data = $parameterlist[$i][2].':'.$parameterlist[$i][3].','.$data; 
     } 
     $i++; 
    } 
    print "JSON data = ".$data."\n" if($debuglevel>0);; 

    #Post data 
    my $req=HTTP::Request->new(POST=>'http://cms.org/input/post.json?apikey='.$cmsapi.'&node='.$cmsnode.'&json={'.$data.'}'); 
    my $resp = $ua->request($req); 
    if ($resp->is_success) { 
     my $message = $resp->decoded_content; 
     print "Received reply: $message\n" if($debuglevel>0); 
    } 
    else { 
     print "HTTP POST error code: ", $resp->code, "\n" if($debuglevel>0); 
     print "HTTP POST error message: ", $resp->message, "\n" if($debuglevel>0); 
    } 
} 
print "DEBUG: *** Script ended ***\n\n" if($debuglevel>0); 

Answer 1

我回答具體：

是否有嘗試/緩存就像在JS？

是的。取而代之的

try { 
    possible evil code; 
} catch (e) { 
... 
} 

在Perl編寫

eval { 
    possible evil code; 
}; 
if ($@) { 
... 
} 

其中$ @是與您選擇的代碼去世的消息。順便說一句 - 不要惹惱';'之後的eval代碼。

HTH 喬治

Answer 2

在Perl中，你可以使用eval，

For Perl Script: 
eval { 
    your code statement; 
} 
if($@){ 
    print qq{Error: $@}; 
} 

For CGI file use like below if you want to print the error: 
eval { 
    your code statement || die "Error: $!"; 
} 
if($@){ 
    print qq{Error: $@}; 
}