Обработка ошибок Perl

Question

Как я могу кэшировать ошибки в perl? Есть ли в JS файл try/cache? Я хотел бы, если возникнет какая-либо ошибка, чтобы перейти к началу сценария.

И если у кого-то есть идея улучшения для сценария ниже, дайте мне знать, потому что это мой первый в 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 ($@) { 
... 
} 

где $ @ является сообщением, с которым Youre коды умерли. BTW - не vorget the ';' после кода eval.

НТН Георг

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: $@}; 
}