Centos 5 |
Perl 5.10.0 |
SOAP::Lite 1.20
Having read the documentation for using on_fault as an override to the default error handling of SOAP::Lite, I would expect the following code to use the callback for error handling processing. However, what I see happening is the default is being used
#!/usr/bin/perl
use strict;
use SOAP::Lite;
my $log #calls to Log4Perl
my $soapServer = "http://somelocation/services/GdeWsOpenAPI?wsdl"
my $soap = new SOAP::Lite();
$soap->on_fault( \&soapError );
$soap->service($soapServer);
sub soapError {
my($soap, $res) = #_;
my $message = ref $res ? $res->faultstring : $soap->transport->status;
$log->write( "fatal connection error to server $SoapServer: $message.", 0);
print STDERR "connection error: $message\n";
exit 1;
}
Output is:
Service description 'http://somelocation/services/GdeWsOpenAPI?wsdl' cannot be loaded: 500 Can't connect to somelocation:80
Expected (because of transport error):
connection error: Service description 'http://somelocation/services/GdeWsOpenAPI?wsdl' cannot be loaded: 500 Can't connect to somelocation:80
What am I missing?
The callback is for problems that occur when making a SOAP call. You haven't gotten that far.
my $soap = SOAP::Lite->new();
$soap->on_fault( \&soapError );
eval { $soap->service($soapServer); 1 }
or die("Can't initialize the web service: $#");
A fault is a special type of response from the server saying "something went wrong with your request". What's happening there is not a fault, it's failing to connect to the server at all. You might want to use Try::Tiny for this.
Related
I am connecting to sybase 12 from a perl script and calling storedprocs, I get the following warnings
DBD::Sybase::db prepare failed: Server message number=2401 severity=11 state=2 line=0 server=SERVER_NAME text=Character
set conversion is not available between client character set 'utf8' and server character set 'iso_1'.
Server message number=2411 severity=10 state=1 line=0 server=SERVER_NAME text=No conversions will be done.
at line 210.
Now, I understand these are only warnings, and my process works perfectly fine, but I am calling my stored proc in a loop and throughout the day and hence it creates a lot of warning message in my log files which causes the entire process to run a bit slower than expected. Can someone help me how can i suppress these please?
You can use a callback to handle the messages you want ignored. See the DBD::Sybase docs. The below is derived from the docs. You specify the message numbers you would like to ignore.
%blocked_msgs = map { $_ => 1 } ( 2401, 2411 );
sub err_handler {
my($err, $sev, $state, $line, $server, $proc, $msg, $sql, $err_type) = #_;
if ( exists $blocked_msgs{$err} ) { # it's a blocked message
return 0; # This is not an error
}
return 1;
}
This is how you might use it:
$dbh = DBI->connect('dbi:Sybase:server=troll', 'sa', '');
$dbh->{syb_err_handler} = \&err_handler;
$dbh->do("exec someproc");
$dbh->disconnect;
I'm trying to learn RabbitMQ for a project I'm working on. My research showed two libraries to use, Net::RabbitMQ and AnyEvent::RabbitMQ. AnyEvent::RabbitMQ seems overly baroque for my needs but Net::RabbitMQ does not appear to work as the examples show it should.
Below is some example code I found, it matches what I saw in the POD, but it isn't working.
#!/usr/bin/env perl
use strict;
use warnings;
use Net::RabbitMQ;
{
# closure to return a new channel ID every time we call nextchan
my $nextchan = 1;
sub nextchan { return $nextchan++ }
}
### BEGIN CONFIGURABLE PARAMETERS ######################################
my $qserver = q{xx.xx.xx.xx};
my %qparms = ();
my $qname = q{gravity.checks};
my $message = q{Test injection};
### NO CONFIGURABLE PARAMETERS BELOW THIS LINE #########################
my $mq = Net::RabbitMQ->new();
my $chanID = nextchan();
$message .= " " . scalar(localtime);
print STDERR qq{Will try to send message "$message" through channel $chanID};
$mq->connect( $qserver, %qparms );
It errors out :
$. / send . pl
Will try to send message "Test injection Fri Nov 14 06:50:44 2014" through channel 1 Usage : Net::RabbitMQ::connect( conn, hostname, options ) at . /send.pl line 28.
The problem is that the %qparams need to be passed by reference and not directly. The change line 28 to :
$mq->connect($qserver, \%qparms) ;
Solved my problem.
It doesn't error out. It prints to STDERR without checking if an error occured. It says I'll try and then it does:
$mq->connect( $qserver, %qparms );
This is just an information, not an error.
I use WWW::Mechanize to fetch and process web pages. I have a piece of code, which looping through a list of web pages. It looks approximately like this:
while (<$readFileHandle>) {
$mech->get("$url");
}
Now the problem occurs when one of the web pages in the list does not exist for some reason(which is ok). The issue is that in this case - the program returns an error and exits. The error looks like that:
Error GETing <url> Not Found at <PATH/file.pl> line ...
How can I ignore such type of error? I want the program just keep running.
You need to use eval {}; for this:
while ( my $url = readline($readFileHandle) ) {
chomp $url;
eval {
$mech->get($url);
};
if ($#) {
#error processing code
}
}
i have a perl app that is supposed to send emails to a massive number of recipients. It seems to work ok, but after about 9K emails it fails with:
Can't call method "auth" on an undefined value at...
In the code I see:
# Open a connection to the SendGrid mail server
my $smtp = Net::SMTP->new('smtp.xyz.net', Port=> 25, Hello=>$DOMAIN);
# Authenticate
my $code = $smtp->auth($USERNAME, $PASSWORD);
The Net::SMTP constructor returns undef if there's a problem (e.g. it's unable to connect to port 25 on smtp.xyz.net). You aren't checking for that, and when you try to call a method on undef, you get the error message you mentioned.
my $smtp = Net::SMTP->new('smtp.xyz.net', Port=> 25, Hello=>$DOMAIN)
or die "Failed to open SMTP connection: $!";
may give you more information. (Although it's not necessarily a socket error, so $! may not contain anything useful.)
The Net::SMTP documentation says that when a method fails it returns undef. So I expect your method call failed.
You might be able to get more information by enabling the Debug => 1 flag in the Net::SMTP constructor.
You will want to detect that your method call failed, and possibly retry it after a short wait.
# Open a connection to the SendGrid mail server
my $smtp = Net::SMTP->new('smtp.xyz.net', Port=> 25, Hello=>$DOMAIN, Debug=>1);
die "Failed to make connection" unless ($smtp);
# Authenticate
my $code = $smtp->auth($USERNAME, $PASSWORD);
You could change it to retry in increasing intervals
something like this:
my $retry = 10; # in seconds;
my $smtp = Net::SMTP->new('smtp.xyz.net', Port=> 25, Hello=>$DOMAIN);
while (not defined $smtp) {
if ($retry > 300) {
die "could not connect to smtp server, giving up";
else {
print "could not connect to smtp, retrying in $retry seconds\n";
}
sleep ($retry);
$smtp = Net::SMTP->new('smtp.xyz.net', Port=> 25, Hello=>$DOMAIN);
$retry *= 2;
}
# Authenticate
my $code = $smtp->auth($USERNAME, $PASSWORD);
This happens mainly if you have the wrong mailbox. Check if smtp.xyz.net is the correct smtp mailbox or it could even be mail.xyz.net. That kind of error occurs if auth is not able to work with the value of 'host' given.
I am trying to make my own Jabber bot but i have run into a little trouble. I have gotten my bot to respond to messages, however, if I try to change the bot's presence then it seems as though all of the messages you send to the bot get delayed.
What I mean is when I run the script I change the presence so I can see that it is online. Then when I send it a message it takes three before the callback subroutine I have set up for messages gets called. After the thirrd message is sent and the chat subroutine is called it still process the first message I sent.
This really doesn't pose too much of a problem except that I have it set up to log out when I send the message "logout" and it has to be followed by two more messages in order to log out. I am not sure what it is that I have to do to fix this but i think it has something to do with iq packets because I have an iq callback set as well and it gets called two times after setting the presence.
Here is my source code:
#!/usr/bin/perl
use strict;
use warnings;
#Libraries
use Net::Jabber;
use DBI;
use DBD::mysql;
#--------------- Config Vars -----------------
# Jabber Client
my $jbrHostname = "DOMAINNAME";
my $jbrUserName = "USERNAME";
my $jbrPassword = "PASSWORD";
my $jbrResource = "RESOURCE";
my $jbrBoss = new Net::Jabber::JID();
$jbrBoss->SetJID(userid=>"USERNAME",server=>$jbrHostname);
# MySQL
my $dbHostname = "DOMAINNAME";
my $dbName = "DATABASENAME";
my $dbUserName = "USERNAME";
my $dbPassword = "PASSWORD";
#--------------- End Config -----------------
# connect to the db
my $dbh = DBI->connect("DBI:mysql:database=$dbName;host=$dbHostname",$dbUserName, $dbPassword, {RaiseError => 1}) or die "Couldn't connect to the database: $!\n";
# create a new jabber client and connect to server
my $jabberBot = Net::Jabber::Client->new();
my $status = $jabberBot->Connect(hostname=>$jbrHostname) or die "Cannot connect ($!)\n";
my #results = $jabberBot->AuthSend(username=>$jbrUserName,password=>$jbrPassword,resource=>$jbrResource);
if($results[0] ne "ok")
{
die "Jabber auth error #results\n";
}
# set jabber bot callbacks
$jabberBot->SetMessageCallBacks(chat=>\&chat);
$jabberBot->SetPresenceCallBacks(available=>\&welcome);
$jabberBot->SetCallBacks(iq=>\&gotIQ);
$jabberBot->PresenceSend(type=>"available");
$jabberBot->Process(1);
sub welcome
{
$jabberBot->MessageSend(to=>$jbrBoss->GetJID(),subject=>"",body=>"Hello There!",type=>"chat",priority=>10);
&keepItGoing;
}
$jabberBot->MessageSend(to=>$jbrBoss->GetJID(),subject=>"",body=>"Hello There! Global...",type=>"chat",priority=>10);
#$jabberBot->Process(5);
&keepItGoing;
sub chat
{
print "Chat Called!\n";
my ($sessionID,$msg) = #_;
$jabberBot->MessageSend(to=>$msg->GetFrom(),subject=>"",body=>"Chatting!",type=>"chat",priority=>10);
if($msg->GetBody() ne 'logout')
{
print $msg->GetBody()."\n";
&keepItGoing;
}
else
{
&killBot($msg);
}
}
sub gotIQ
{
print $_[1]->GetID()."\n";
&chat;
}
sub keepItGoing
{
print "Movin' the chains!\n";
my $proc = $jabberBot->Process(1);
while(defined($proc) && $proc != 1)
{
$proc = $jabberBot->Process(1);
}
}
sub killBot
{
$jabberBot->MessageSend(to=>$_[0]->GetFrom(),subject=>"",body=>"Logging Out!",type=>"chat",priority=>10);
$jabberBot->Process(1);
$jabberBot->Disconnect();
exit;
}
Thanks for your help!
You've got resource starvation because of your keepItGoing routine. In general, trying to use XMPP synchronously like this is not going to work. I suggest getting your callbacks set up, then just calling Process() in one loop.
The docs for Process() say:
Process(integer) - takes the timeout period as an argument. If no
timeout is listed then the function blocks until
a packet is received. Otherwise it waits that
number of seconds and then exits so your program
can continue doing useful things. NOTE: This is
important for GUIs. You need to leave time to
process GUI commands even if you are waiting for
packets. The following are the possible return
values, and what they mean:
1 - Status ok, data received.
0 - Status ok, no data received.
undef - Status not ok, stop processing.
IMPORTANT: You need to check the output of every
Process. If you get an undef then the connection
died and you should behave accordingly.
Each time you call Process(), 0 or more of your callbacks will fire. You never know which, since it depends on server timing. If you want for Process() to return before sending something, you're almost always thinking synchronously, rather than asych, which kills you in XMPP.
In your case, if you remove the call to keepItGoing from chat(), I bet things will work more like you expect.
Replace the line:
$jabberBot->Process(1);
with these:
while (defined($jabberBot->Process(1))) {
# Do stuff here
}