Note: This is a test perl code to check if works.
I have problem with my perl script, I know there's a solution for that by adding
print "Your server is not ok, please check!\n";
die "- Server is not ok!\n";
But in my project after stop in die "- Server is not ok!\n"; continue the script, I use print to show if works.
Heres the code
#!/usr/bin/perl
use strict;
use warnings;
use LWP::UserAgent;
my $ua = LWP::UserAgent->new( timeout => 1 );
$ua->agent("007");
my $req = HTTP::Request->new( GET => 'http://www.google.com.ph/' );
my $res;
for ( 1 .. 10 ) {
$res = $ua->request($req);
if ( $res->is_success ) {
print "+ Server is ok!\n";
}
else {
die "- Server is not ok!\n"; # I want to stop if server is not ok and print last code. Or other solution to stop instead of using die.
}
sleep 1;
}
print "Your server is not ok, please check!\n"; # Why this print not showing if stop in "- Server is not ok!\n"?
See image...
Other solution to stop? Intead using die to continue the perl script.
I hope someone will fixed this little problem, thanks for all reply!
for ( 1 .. 10 ) {
$res = $ua->request($req);
if ( $res->is_success ) {
print "+ Server is ok!\n";
}
else {
print "- Server is not ok!\n";
last; #this statement causes to exit the loop
}
sleep 1;
}
# at this point everything is oke
print "Your server is ok!\n";
Related
how can i cache errors in perl? Is there try/cache like in JS? I would like if any error occurs to go to the start of the script.
And if anyone has an idea of improvement for the script below let me know because this is my first one in perl. The script just has to loop forever and never stop. :)
#!/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);
I am answering the specific:
Is there try/cache like in JS?
Yes there is. Instead of
try {
possible evil code;
} catch (e) {
...
}
in perl you write
eval {
possible evil code;
};
if ($#) {
...
}
where $# is the message with which youre code died. BTW - don't vorget the ';' after the eval code.
HTH
Georg
In Perl you can use 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: $#};
}
Strange issue I am running into. I have a few devices with Telnet/SSH issues. When I run my script the results are saying the script was successful. When debug is on I get the follow results..
[ 0.012464] pr finding prompt
[ 0.016593] tr creating Net::Telnet wrapper for telnet
[ 0.017859] tr connecting with: telnet Host 10.xx.xx.xx Port 23
How could I add something to show a error if a promopt is not present or the connection times out?
Thanks
#!/usr/bin/perl
use Net::Appliance::Session;
$file = '1list';
open (FH, "< $file") or die "Can't open $file for read: $!";
my #ios_list = <FH>;
close FH or die "Cannot close $file: $!";
chomp(#ios_list);
my $ios_username = 'xxxx';
my $ios_password = 'xxxx';
DEVICE:
for my $ios_device_ip ( #ios_list ) {
my #version_info;
my $proto = shift;
if (($proto == 43)||($proto == 44)){
$tran = "SSH";
$app="/usr/local/bin/ssh";
}else{
$tran = "Telnet";
$app="/bin/telnet";
}
my $session_obj = Net::Appliance::Session->new(
host => $ios_device_ip,
transport => $tran,
personality => 'ios',
);
#interace
eval {
# try to login to the ios device, ignoring host check
$session_obj->connect(
username => $ios_username,
password => $ios_password,
#SHKC => 0
);
# get our running config
$session_obj->begin_privileged;
$session_obj->cmd('conf t');
$session_obj->cmd('aaa authorization config-commands');
$session_obj->cmd('exit');
$session_obj->end_privileged;
$session_obj->cmd('write memory');
# close down our session
$session_obj->close;
};
#error check
if ($#) {
if ( UNIVERSAL::isa($#, 'Net::Appliance::Session::Exception') ) {
# fault description from Net::Appliance::Session
print "We had an error during our Telnet/SSH session to device : $ios_devi
ce_ip \n";
print $#->message . " \n";
# message from Net::Telnet
print "Net::Telnet message : " . $#->errmsg . "\n";
# last line of output from your appliance
print "Last line of output from device : " . $#->lastline . "\n\n";
}
elsif (UNIVERSAL::isa($#, 'Net::Appliance::Session::Error') ) {
# fault description from Net::Appliance::Session
print "We had an issue during program execution to device : $ios_device_ip
\n";
# print $#->message . " \n";
}
else {
# we had some other error that wasn't a deliberately created exception
print "We had an issue when accessing the device : $ios_device_ip \n";
print "$ios_device_ip The reported error was : $# \n";
}
next DEVICE;
}
print #version_info;
print "$ios_device_ip ok \n";
#end
}
If you're having trouble connecting, it may help to check $# after the eval as there may be an error you're ignoring.
#interace
eval {
# try to login to the ios device, ignoring host check
$session_obj->connect(
username => $ios_username,
password => $ios_password,
#SHKC => 0
);
It's also worth noting that this doesn't do anything:
my $proto = shift;
if (($proto == 43)||($proto == 44)){
$tran = "SSH";
$app="/usr/local/bin/ssh";
}else{
shift is operating on #_ which isn't populated, so $proto will always be undef.
I want my server to stop for a few seconds and then start again.
I am trying to use sleep(5).
Will this help?
I've tried with a Perl script containing:
if($mech=~ m/(Connection refused)/) {print "SLEEPING\n";sleep(5);redo;}
A server hosts web pages. A client connects to a server. A Perl script using WWW::Mechanize is a client.
I suspect you're trying to do the following:
my $retries = 3;
my $resp; # response goes here
while ( $retries-- > 0 ) {
$resp = $ua->get( "http://www.google.com/" );
if ( ! $resp->is_success ) {
warn( "Failed to get webpage: " . $resp->status_line );
sleep( 5 );
next; # continue the while loop
}
last; # success!
}
if ( $retries == 0 ) {
die( "Too many retries!" );
}
# old versions of LWP::UserAgent didn't have decoded_content()
my $content = $resp->can('decoded_content') ?
$resp->decoded_content : $resp->content;
print( $content );
UPDATE
Here is the code you supplied in a comment:
use WWW::Mechanize;
my $mech = new WWW::Mechanize;
eval {
$mech->get($url);
};
if($#) {
print STDERR "Burst\n";
print STDERR Dumper($mech);
# my $var=$mech;
# print STDERR "var $var\n";
# if($mech=~ m/(Connection refused)/)
# {
# print "SLEEPING\n";
# sleep(5);
# redo;
# }
From perdoc -f redo:
The "redo" command restarts the loop block without evaluating the conditional again. The "continue" block, if any, is not executed. If the LABEL is omitted, the command refers to the innermost enclosing loop.
Seeing as you haven't put your code in a loop the call to redo doesn't have any effect.
***UPDATED CODE with resume functionality**
my $ua = LWP::UserAgent->new;
$ua->credentials('$ip:80', 'Realm', 'username', 'password');
my $response = $ua->mirror($url,$newfile);
if ($response->is_success) {
print "Download Successfull.";
}
else {
print "Error: " . $response->status_line;
}
********OLD CODE*****************
my $ua = LWP::UserAgent->new;
$ua->credentials('$ip:80', 'Realm', 'username', 'password');
my $response = $ua->get($url);
if ($response->is_success) {
print "Retrieved " .length($response->decoded_content) .
" bytes of data.";
}
else {
print "Error: " . $response->status_line;
}
open my $fh, '>encoding(UTF-8)', $tmp;
print {$fh} $response->decoded_content;
close $fh;
if ( -e $tmp ) {
my $filesize = ( stat $tmp )[9];
my $origsize = $queue[$rec][1];
if ( $filesize < $origsize) {
print "Resuming download";
******************************************
code for resuming the partly downloaded file...
*******************************************
}
else {
print "File downloaded correctly\n";
}
}
As i'm newbie to perl, could download decoded_content, though some errors persists.
Need to resume the file download, if we have a partial file.
This was the code i've tried, but am not able to know where to start with, hence any quick thoughts in this regard will be of great help indeed. Please help on this.
See method mirror in LWP::UserAgent. Documentation quote:
This method will get the document identified by $url and store it in file called $filename.
my $response = $ua->mirror($url, $filename); # no single quotes around variables!
See the source code for mirror, it deals correctly with truncated/partially downloaded files.
I am trying to write a Perl script using WWW-Mechanize.
Here is my code:
use DBI;
use JSON;
use WWW::Mechanize;
sub fetch_companies_list
{
my $url = shift;
my $browser = WWW::Mechanize->new( stack_depth => 0 );
my ($content, $json, $parsed_text, $company_name, $company_url);
eval
{
print "Getting the companies list...\n";
$browser->get( $url );
# die "Can't get the companies list.\n" unless( $browser->status );
$content = $browser->content();
# die "Can't get companies names.\n" unless( $browser->status );
$json = new JSON;
$parsed_text = $json->allow_nonref->utf8->relaxed->escape_slash->loose->allow_singlequote->allow_barekey->decode( $content );
foreach(#$parsed_text)
{
$company_name = $_->{name};
fetch_company_info( $company_name, $browser );
}
}
}
fetch_companies_list( "http://api.crunchbase.com/v/1/companies.js" );
The problem is the follows:
I start the script it finishes fine.
I restart the script. The script fails in "$browser->get()".
I have to wait some time (about 5 min) then it will start working again.
I am working on Linux and have WWW-Mechanize version 1.66.
Any idea what might be the problem? I don't have any firewall installed either on computer or on my router.
Moreover uncommenting the "die ..." line does not help as it stopping inside get() call. I can try to upgrade to the latest, which is 1.71, but I'd like to know if someone else experience this with this Perl module.
5 minutes (300 seconds) is the default timeout. Exactly what timed out will be returned in the response's status line.
my $response = $mech->res;
if (!$response->is_success()) {
die($response->status_line());
}
This is target site issue. It shows
503 Service Unavailable No server is available to handle this
request.
right now.
Retry with wait, try this
## set maximum no of tries
my $retries = 10;
## number of secs to sleep
my $sleep = 1;
do {
eval {
print "Getting the companies list...\n";
$browser->get($url);
# die "Can't get the companies list.\n" unless( $browser->status );
$content = $browser->content();
# die "Can't get companies names.\n" unless( $browser->status );
$json = new JSON;
$parsed_text = $json->allow_nonref->utf8->relaxed->escape_slash->loose->allow_singlequote->allow_barekey->decode($content);
foreach (#$parsed_text) {
$company_name = $_->{name};
fetch_company_info( $company_name, $browser );
}
};
if ($#) {
warn $#;
## rest for some time
sleep($sleep);
## increase the value of $sleep exponetially
$sleep *= 2;
}
} while ( $# && $retries-- );