view release on metacpan or  search on metacpan

lib/AnyEvent/XMPP/Ext/Ping.pm  view on Meta::CPAN

=cut

sub auto_timeout {
   my ($self, $timeout) = @_;

   $self->{autotimeout} = $timeout;

   return if defined $self->{cb_id2};

   $self->{cb_id2} =
      $self->reg_cb (
         stream_ready => sub {
            my ($self, $con) = @_;
            $self->enable_timeout ($con, \$self->{autotimeout});
         },
         disconnect => sub {
            my ($self, $con) = @_;
            $self->disable_timeout ($con);
         }
      );
}

=item B<enable_timeout ($con, $timeout)>

This enables a periodical ping on the connection C<$con>.
C<$timeout> must be the seconds that the ping intervals last.

If the server which is connected via C<$con> didn't respond within C<$timeout>
seconds the connection C<$con> will be disconnected.

Please note that there already is a basic timeout mechanism
for dead TCP connections in L<AnyEvent::XMPP::Connection>, see also
the C<whitespace_ping_interval> configuration variable for a connection
there. It then will depend on TCP timeouts to disconnect the connection.

Use C<enable_timeout> and C<auto_timeout> only if you really feel
like you need an explicit timeout for your connections.

=cut

sub enable_timeout {
   my ($self, $con, $timeout) = @_;
   my $rt = $timeout;
   unless (ref $timeout) {
      $rt = \$timeout;
   }
   $self->_start_cust_timeout ($con, $rt);
}

sub disable_timeout {
   my ($self, $con) = @_;
   delete $self->{cust_timeouts}->{$con};
}

sub _start_cust_timeout {
   my ($self, $con, $rtimeout) = @_;
   return unless $con->is_connected;

   $self->{cust_timeouts}->{$con} =
      AnyEvent->timer (after => $$rtimeout, cb => sub {
         delete $self->{cust_timeouts}->{$con};
         return unless $con->is_connected;

         $self->ping ($con, undef, sub {
            my ($t, $e) = @_;

            if (defined ($e) && $e->condition eq 'client-timeout') {
               $con->disconnect ("exceeded ping timeout of $$rtimeout seconds");
            } else {
               $self->_start_cust_timeout ($con, $rtimeout)
            }
         }, $$rtimeout);
      });
}

sub init {
   my ($self) = @_;

   if (eval "require Time::HiRes") {
      $self->{has_time_hires} = 1;
   }

   $self->{cb_id} = $self->reg_cb (
      iq_get_request_xml => sub {
         my ($self, $con, $node, $handled) = @_;

         if ($self->handle_ping ($con, $node)) {
            $$handled = 1;
         }
      }
   );
}

sub disco_feature { xmpp_ns ('ping') }

sub DESTROY {
   my ($self) = @_;
   $self->unreg_cb ($self->{cb_id});
   $self->unreg_cb ($self->{cb_id2}) if defined $self->{cb_id2};
}

sub handle_ping {
   my ($self, $con, $node) = @_;

   if (my ($q) = $node->find_all ([qw/ping ping/])) {
      unless ($self->{ignore_pings}) {
         $con->reply_iq_result ($node);
      }
      return 1;
   }

   0;
}

=item B<ping ($con, $dest, $cb, $timeout)>

This method sends a ping request to C<$dest> via the L<AnyEvent::XMPP::Connection>
in C<$con>. If C<$dest> is undefined the ping will be sent to the connected
server.  C<$cb> will be called when either the ping timeouts, an error occurs
or the ping result was received. C<$timeout> is an optional timeout for the