weaken results from the CPAN

Asterisk-AMI

view release on metacpan or search on metacpan

        This checks the connection to the AMI to ensure it is still functional. It checks at the socket layer and
        also sends a 'PING' to the AMI to ensure it is still responding. If no TIMEOUT is given this will block
        waiting for a response.

        Returns 1 if the connection is good, 0 if it is not.

error ()

        Returns 1 if there are currently errors on the socket, 0 if everything is ok.

destroy ()

        Destroys the contents of all buffers and removes any current callbacks that are set.
	Mostly used internally. Useful if you want to ensure that our IO handle watcher gets removed.
	Gets called automatically when our object goes out of scope.

loop ()

        Starts an event loop via AnyEvent.

break ()

	Breaks/exits the current event loop. The program will continue from where the event loop was invoked.

=head1 See Also

AnyEvent, Asterisk::AMI::Common, Asterisk::AMI::Common::Dev

=head1 AUTHOR

Ryan Bullock (rrb3942@gmail.com)

=head1 BUG REPORTING AND FEEDBACK

Please report any bugs or errors to our github issue tracker at http://github.com/rrb3942/perl-Asterisk-AMI/issues or 
the cpan request tracker at https://rt.cpan.org/Public/Bug/Report.html?Queue=perl-Asterisk-AMI

=head1 LICENSE

Copyright (C) 2011 by Ryan Bullock (rrb3942@gmail.com)

This module is free software.  You can redistribute it and/or modify it under the terms of the Artistic License 2.0.

This program is distributed in the hope that it will be useful, but without any warranty; without even the implied 
warranty of merchantability or fitness for a particular purpose.

=cut

package Asterisk::AMI;

#Register warnings
use warnings::register;

use strict;
use warnings;

use AnyEvent;
use AnyEvent::Handle;
use AnyEvent::Socket;
use Digest::MD5;
use Scalar::Util qw/weaken/;
use Carp qw/carp/;

#Duh
use version 0.77; our $VERSION = version->declare("v0.2.8");

#Used for storing events while reading command responses Events are stored as hashes in the array Example 
#$self->{EVETNBUFFER}->{'Event'} = Something

#Buffer for holding action responses and data
# Structure: $self->{RESPONSEBUFFER}->{'ActionID'}->{'Response'}        = (Success|Failure|Follows|Goodbye|Pong|Etc..)        
# //Reponse Status
#                             {'Message'} = Message //Message in the response {'EVENTS'} = [%hash1, %hash2, ..]  //Arry 
#                             of Hashes of parsed events and data for this actionID {'PARSED'} = { Hashkey => value, 
#                             ...} {'COMPLETED'} = 0 or 1 //If the command is completed {'GOOD'} = 0 or 1 //if this 
#                             responses is good, no error, can only be 1 if also COMPLETED

#Create a new object and return it; If required options are missing, returns undef
sub new {
        my ($class, %values) = @_;

        my $self = bless {}, $class;

        #Configure our new object and connect, else return undef
        if ($self->_configure(%values) && $self->_connect()) {
                return $self;
        }

        return;
}

#Used by anyevent to load our read type
sub anyevent_read_type {

        my ($hdl, $cb) = @_;

        return sub {
                if ($hdl->{rbuf} =~ s/^(.+)(?:\015\012\015\012)//sox) {
                        $cb->($hdl, $1);
                }

                return 0;
        }
}

#Sets variables for this object Also checks for minimum settings Returns 1 if everything was set, 0 if options were 
#missing
sub _configure {
        my ($self, %config) = @_;

        #Required settings
        my @required = ( 'USERNAME', 'SECRET' );

        #Defaults
        my %defaults = (        PEERADDR => '127.0.0.1',
                                PEERPORT => 5038,
                                AUTHTYPE => 'plaintext',
                                EVENTS => 'off',
                                BUFFERSIZE => 30000,
                                BLOCKING => 1
                        );

lib/Asterisk/AMI.pm view on Meta::CPAN

                                        return;
                                } else {
                                        #lowercase it for consistency
                                        $val = $lval;
                                }
                        }

                #Ensure all handlers are sub refs
                } elsif ($opt eq 'HANDLERS') {
                        while (my ($event, $handler) = each %{$val}) {
                                if (ref($handler) ne 'CODE') {
                                        carp "Handler for event type \'$event\' must be an anonymous subroutine or a subroutine reference" if warnings::enabled('Asterisk::AMI');
                                        return;
                                }
                        }
                }

                $self->{CONFIG}->{$opt} = $val;
        }


        #Check for required options
        foreach my $req (@required) {
                if (!exists $self->{CONFIG}->{$req}) {
                        carp "Must supply a username and secret for connecting to asterisk" if warnings::enabled('Asterisk::AMI');
                        return;
                }
        }

        #Change default port if using ssl
        if ($self->{CONFIG}->{USESSL}) {
                $defaults{PEERPORT} = 5039;
        }

        #Assign defaults for any missing options
        while (my ($opt, $val) = each(%defaults)) {
                if (!defined $self->{CONFIG}->{$opt}) {
                        $self->{CONFIG}->{$opt} = $val;
                }
        }

        #Make adjustments for Originate Async bullscrap
        if ($self->{CONFIG}->{ORIGINATEHACK}) {
                #Turn on call events, otherwise we wont get the Async response
                if (lc($self->{CONFIG}->{EVENTS}) eq 'off') {
                        $self->{CONFIG}->{EVENTS} = 'call';
                        #Fake event type so that we will discard events, else by turning on events our event buffer 
                        #Will just continue to fill up.
                        $self->{CONFIG}->{HANDLERS} = { 'JUSTMAKETHEHASHNOTEMPTY' => sub {} } unless ($self->{CONFIG}->{HANDLERS});
                #They already turned events on, just add call types to it, assume they are doing something with events 
                #and don't mess with the handlers
                } elsif (lc($self->{CONFIG}->{EVENTS}) !~ /on|call/x) {
                        $self->{CONFIG}->{EVENTS} .= ',call';
                }
        }

        #Initialize the seq number
        $self->{idseq} = 1;

        #Weaken reference for use in anonsub
        weaken($self);

        #Set keepalive
        $self->{CONFIG}->{KEEPALIVE} = AE::timer($self->{CONFIG}->{KEEPALIVE}, $self->{CONFIG}->{KEEPALIVE}, sub { $self->_send_keepalive }) if ($self->{CONFIG}->{KEEPALIVE});
        
        return 1;
}

#Handles connection failures (includes login failure);
sub _on_connect_err {

        my ($self, $message) = @_;

        warnings::warnif('Asterisk::AMI', "Failed to connect to asterisk - $self->{CONFIG}->{PEERADDR}:$self->{CONFIG}->{PEERPORT}");
        warnings::warnif('Asterisk::AMI', "Error Message: $message");

        #Dispatch all callbacks as if they timed out
        $self->_clear_cbs();

        if (exists $self->{CONFIG}->{ON_CONNECT_ERR}) {
                $self->{CONFIG}->{ON_CONNECT_ERR}->($self, $message);
        } elsif (exists $self->{CONFIG}->{ON_ERROR}) {
                $self->{CONFIG}->{ON_ERROR}->($self, $message);
        }

        $self->{SOCKERR} = 1;

        $self->destroy();

        return;
}

#Handles other errors on the socket
sub _on_error {

        my ($self, $message) = @_;

        warnings::warnif('Asterisk::AMI', "Received Error on socket - $self->{CONFIG}->{PEERADDR}:$self->{CONFIG}->{PEERPORT}");
        warnings::warnif('Asterisk::AMI', "Error Message: $message");
        
        #Call all cbs as if they had timed out
        $self->_clear_cbs();

        $self->{CONFIG}->{ON_ERROR}->($self, $message) if (exists $self->{CONFIG}->{ON_ERROR});
        
        $self->{SOCKERR} = 1;

        $self->destroy();

        return;
}

#Handles the remote end disconnecting
sub _on_disconnect {

        my ($self) = @_;

        my $message = "Remote end disconnected - $self->{CONFIG}->{PEERADDR}:$self->{CONFIG}->{PEERPORT}";
        warnings::warnif('Asterisk::AMI', "Remote Asterisk Server ended connection - $self->{CONFIG}->{PEERADDR}:$self->{CONFIG}->{PEERPORT}");

        #Call all callbacks as if they had timed out
        _
        $self->_clear_cbs();

        if (exists $self->{CONFIG}->{ON_DISCONNECT}) {
                $self->{CONFIG}->{ON_DISCONNECT}->($self, $message);
        } elsif (exists $self->{CONFIG}->{ON_ERROR}) {
                $self->{CONFIG}->{ON_ERROR}->($self, $message);
        }

        $self->{SOCKERR} = 1;

        $self->destroy();

        return;
}

#What happens if our keep alive times out
sub _on_timeout {
        my ($self, $message) = @_;

        warnings::warnif('Asterisk::AMI', $message);

        if (exists $self->{CONFIG}->{ON_TIMEOUT}) {
                $self->{CONFIG}->{ON_TIMEOUT}->($self, $message);
        } elsif (exists $self->{CONFIG}->{ON_ERROR}) {
                $self->{CONFIG}->{ON_ERROR}->($self, $message);
        }

        $self->{SOCKERR} = 1;

        return;
}

#Things to do after our initial connect
sub _on_connect {

        my ($self, $fh, $line) = @_;

        if ($line =~ /^Asterisk\ Call\ Manager\/([0-9]\.[0-9])$/ox) {
                $self->{AMIVER} = $1;
        } else {
                warnings::warnif('Asterisk::AMI', "Unknown Protocol/AMI Version from $self->{CONFIG}->{PEERADDR}:$self->{CONFIG}->{PEERPORT}");
        }

        #Weak reference for us in anonysub
        weaken($self);

        $self->{handle}->push_read( 'Asterisk::AMI' => sub { $self->_handle_packet(@_); } );

        return 1;
}

#Connects to the AMI Returns 1 on success, 0 on failure
sub _connect {
        my ($self) = @_;

        #Weaken ref for use in anonysub
        weaken($self);

        #Build a hash of our anyevent::handle options
        my %hdl = (     connect => [$self->{CONFIG}->{PEERADDR} => $self->{CONFIG}->{PEERPORT}],
                        on_connect_err => sub { $self->_on_connect_err($_[1]); },
                        on_error => sub { $self->_on_error($_[2]) },
                        on_eof => sub { $self->_on_disconnect; },
                        on_connect => sub { $self->{handle}->push_read( line => sub { $self->_on_connect(@_); } ); });

        #TLS stuff
        $hdl{'tls'} = 'connect' if ($self->{CONFIG}->{USESSL});
        #TCP Keepalive
        $hdl{'keeplive'} = 1 if ($self->{CONFIG}->{TCP_KEEPALIVE});

        #Make connection/create handle
        $self->{handle} = AnyEvent::Handle->new(%hdl);

        #Return login status if blocking
        return $self->_login if ($self->{CONFIG}->{BLOCKING});

        #Queue our login
        $self->_login;

        #If we have a handle, SUCCESS!
        return 1 if (defined $self->{handle});

        return;
}

sub _handle_packet {
        my ($self, $hdl, $buffer) = @_;

        foreach my $packet (split /\015\012\015\012/ox, $buffer) {
                my %parsed;

                foreach my $line (split /\015\012/ox, $packet) {
                        #Is this our command output?
                        if ($line =~ s/--END\ COMMAND--$//ox) {
                                $parsed{'COMPLETED'} = 1;

                                push(@{$parsed{'CMD'}},split(/\x20*\x0A/ox, $line));
                        } else {
                                #Regular output, split on :\
                                my ($key, $value) = split /:\ /x, $line, 2;

                                $parsed{$key} = $value;

                        }
                }

                #Dispatch depending on packet type
                if (exists $parsed{'ActionID'}) {
                        $self->_handle_action(\%parsed);
                } elsif (exists $parsed{'Event'}) {
                        $self->_handle_event(\%parsed);
                }
        }

        return 1;
}

lib/Asterisk/AMI.pm view on Meta::CPAN

                        }
                }
        }
        
        if ($self->{RESPONSEBUFFER}->{$actionid}->{'COMPLETED'}) {
                #This aciton is finished do not accept any more packets for it
                delete $self->{EXPECTED}->{$actionid};

                #Determine goodness, do callback
                $self->_action_complete($actionid);
        }

        return 1;
}

#Handles proccessing and callbacks for 'Event' packets
sub _handle_event {
        my ($self, $event) = @_;

        #If handlers were configured just dispatch, don't buffer
        if ($self->{CONFIG}->{HANDLERS}) {
                if (exists $self->{CONFIG}->{HANDLERS}->{$event->{'Event'}}) {
                        $self->{CONFIG}->{HANDLERS}->{$event->{'Event'}}->($self, $event);
                } elsif (exists $self->{CONFIG}->{HANDLERS}->{'default'}) {
                        $self->{CONFIG}->{HANDLERS}->{'default'}->($self, $event);
                }
        } else {
                #Someone is waiting on this packet, don't bother buffering
                if (exists $self->{CALLBACKS}->{'EVENT'}) {
                        $self->{CALLBACKS}->{'EVENT'}->{'cb'}->($event);
                        delete $self->{CALLBACKS}->{'EVENT'};
                        #Save for later
                } else {
                        push(@{$self->{EVENTBUFFER}}, $event);
                }
        }

        return 1;
}

#This is used to provide blocking behavior for calls It installs callbacks for an action if it is not in the buffer 
#and waits for the response before returning it.
sub _wait_response {
        my ($self, $id, $timeout) = @_;

        #Already got it?
        if ($self->{RESPONSEBUFFER}->{$id}->{'COMPLETED'}) {
                my $resp = $self->{RESPONSEBUFFER}->{$id};
                delete $self->{RESPONSEBUFFER}->{$id};
                delete $self->{CALLBACKS}->{$id};
                delete $self->{EXPECTED}->{$id};
                return $resp;
        }

        #Don't Have it, wait for it Install some handlers and use a CV to simulate blocking
        my $process = AE::cv;

        $self->{CALLBACKS}->{$id}->{'cb'} = sub { $process->send($_[1]) };
        $timeout = $self->{CONFIG}->{TIMEOUT} unless (defined $timeout);

        #Should not need to weaken here because this is a blocking call Only outcomes can be error, timeout, or 
        #complete, all of which will finish the cb and clear the reference weaken($self)

        if ($timeout) {
                $self->{CALLBACKS}->{$id}->{'timeout'} = sub {
                                my $response = $self->{'RESPONSEBUFFER'}->{$id};
                                delete $self->{RESPONSEBUFFER}->{$id};
                                delete $self->{CALLBACKS}->{$id};
                                delete $self->{EXPECTED}->{$id};
                                $process->send($response);
                        };

                #Make sure event loop is up to date in case of sleeps
                AE::now_update;

                $self->{CALLBACKS}->{$id}->{'timer'} = AE::timer $timeout, 0, $self->{CALLBACKS}->{$id}->{'timeout'};
        }

        return $process->recv;
}

sub _build_action {
        my ($actionhash, $id) = @_;

        my $action;
        my $async;
        my $callback;
        my $timeout;

        #Create an action out of a hash
        while (my ($key, $value) = each(%{$actionhash})) {

                my $lkey = lc($key);

                #Callbacks
                if ($key eq 'CALLBACK') {
                        carp "Use of the CALLBACK key in an action is deprecated and will be removed in a future release.\n",
                        "Please use the syntax that is available." if warnings::enabled('Asterisk::AMI');

                        $callback = $actionhash->{$key} unless (defined $callback);
                        next;
                #Timeout
                } elsif ($key eq 'TIMEOUT') {
                        carp "Use of the TIMEOUT key in an action is deprecated and will be removed in a future release\n",
                        "Please use the syntax that is available." if warnings::enabled('Asterisk::AMI');

                        $timeout = $actionhash->{$key} unless (defined $timeout);
                        next;
                #Exception of Orignate Async
                } elsif ($lkey eq 'async' && $value == 1) {
                        $async = 1;
                #Clean out user ActionIDs
                } elsif ($lkey eq 'actionid') {
                        carp "User supplied ActionID being ignored." if warnings::enabled('Asterisk::AMI');
                        next;
                }

                #Handle multiple values
                if (ref($value) eq 'ARRAY') {
                        foreach my $var (@{$value}) {
                                $action .= $key . ': ' . $var . "\015\012";
                        }
                } else {
                        $action .= $key . ': ' . $value . "\015\012";
                }
        }

        #Append ActionID and End Command
        $action .= 'ActionID: ' . $id . "\015\012\015\012";

        return ($action, $async, $callback, $timeout);
}

#Sends an action to the AMI Accepts an Array Returns the actionid of the action
sub send_action {
        my ($self, $actionhash, $callback, $timeout, $store) = @_;

        #No connection
        return unless ($self->{handle});

        #resets id number
        if ($self->{idseq} > $self->{CONFIG}->{BUFFERSIZE}) {
                $self->{idseq} = 1;
        }

        my $id = $self->{idseq}++;

        #Store the Action ID
        $self->{lastid} = $id;

        #Delete anything that might be in the buffer
        delete $self->{RESPONSEBUFFER}->{$id};
        delete $self->{CALLBACKS}->{$id};

        my ($action, $hcb, $htimeout);

        ($action, $self->{RESPONSEBUFFER}->{$id}->{'ASYNC'}, $hcb, $htimeout) = _build_action($actionhash, $id);

        $callback = $hcb unless (defined $callback);
        $timeout = $htimeout unless (defined $timeout);

        if ($self->{LOGGEDIN} || lc($actionhash->{'Action'}) =~ /login|challenge/x) {
                $self->{handle}->push_write($action);
        } else {
                $self->{PRELOGIN}->{$id} = $action;
        }

        $self->{RESPONSEBUFFER}->{$id}->{'COMPLETED'} = 0;
        $self->{RESPONSEBUFFER}->{$id}->{'GOOD'} = 0;
        $self->{EXPECTED}->{$id} = 1;

        #Weaken ref of use in anonsub
        weaken($self);

        #Set default timeout if needed
        $timeout = $self->{CONFIG}->{TIMEOUT} unless (defined $timeout);

        #Setup callback
        if (defined $callback) {
                #Set callback if defined
                $self->{CALLBACKS}->{$id}->{'cb'} = $callback;
                #Variable to return with Callback
                $self->{CALLBACKS}->{$id}->{'store'} = $store;
        }

        #Start timer for timeouts
        if ($timeout && defined $self->{CALLBACKS}->{$id}) {
                $self->{CALLBACKS}->{$id}->{'timeout'} = sub {
                                my $response = $self->{RESPONSEBUFFER}->{$id};
                                my $cb = $self->{CALLBACKS}->{$id}->{'cb'};
                                my $st = $self->{CALLBACKS}->{$id}->{'store'};
                                delete $self->{RESPONSEBUFFER}->{$id};
                                delete $self->{CALLBACKS}->{$id};
                                delete $self->{EXPECTED}->{$id};
                                delete $self->{PRELOGIN}->{$id};
                                $cb->($self, $response, $st);;
                        };
                $self->{CALLBACKS}->{$id}->{'timer'} = AE::timer $timeout, 0, $self->{CALLBACKS}->{$id}->{'timeout'};
        }

        return $id;
}

#Checks for a response to an action If no actionid is given uses last actionid sent Returns 1 if action success, 0 if 
#failure
sub check_response {
        my ($self, $actionid, $timeout) = @_;

        #Check if an actionid was passed, else us last
        $actionid = $self->{lastid} unless (defined $actionid);

        my $resp = $self->_wait_response($actionid, $timeout);

        if ($resp->{'COMPLETED'}) {
                return $resp->{'GOOD'};
        }

        return;
}

#Returns the Action with all command data and event Actions are hash references If an actionid is specified returns 
#that action, otherwise uses last actionid sent Removes the event from the buffer
sub get_response {
        my ($self, $actionid, $timeout) = @_;

        #Check if an actionid was passed, else us last
        $actionid = $self->{lastid} unless (defined $actionid);

        #Wait for the action to complete
        my $resp = $self->_wait_response($actionid, $timeout);
        
        if ($resp->{'COMPLETED'}) {
                return $resp;

lib/Asterisk/AMI.pm view on Meta::CPAN

                delete $self->{PRELOGIN};

                return 1;
        } else {
                #Login failed
                if ($login->{'COMPLETED'}) {
                        $self->_on_connect_err("Login Failed to Asterisk (bad auth) at $self->{CONFIG}->{PEERADDR}:$self->{CONFIG}->{PEERPORT}");
                } else {
                        $self->_on_connect_err("Login Failed to Asterisk due to timeout at $self->{CONFIG}->{PEERADDR}:$self->{CONFIG}->{PEERPORT}");
                }

                return;
        }

        return;
}

#Blocking Login
sub _login_block {
        my ($self, $action, $challenge, $timeout) = @_;

        my $resp;

        #If a challenge exists do handle it first before the login
        if (%{$challenge}) {

                #Get challenge response
                my $chresp = $self->action($challenge,$timeout);

                if ($chresp->{'GOOD'}) {

                        $action->{'Key'} = $self->_md5_resp($chresp->{'PARSED'}->{'Challenge'}, $self->{CONFIG}->{SECRET});
                        $action->{'AuthType'} = $self->{CONFIG}->{AUTHTYPE};

                        #Login
                        $resp = $self->action($action, $timeout);
                                                
                  } else {
                        #Challenge Failed
                        if ($chresp->{'COMPLETED'}) {
                                $self->_on_connect_err("$self->{CONFIG}->{AUTHTYPE} challenge failed");
                        } else {
                                $self->_on_connect_err("Timed out waiting for challenge");
                        }

                        return;
                }
        } else {
                #Plaintext login
                $resp = $self->action($action, $timeout);
        }

        return $self->_logged_in($resp);   
}

#Non-blocking login
sub _login_noblock {
        my ($self, $action, $challenge, $timeout) = @_;

        #Weaken ref for use in anonsub
        weaken($self);

        #Callback for login action
        my $login_cb = sub { $self->_logged_in($_[1]) };

        #Do a md5 challenge
        if (%{$challenge}) {
                #Create callbacks for the challenge
                 my $challenge_cb = sub {
                                if ($_[1]->{'GOOD'}) {
                                        my $md5 = Digest::MD5->new();

                                        $md5->add($_[1]->{'PARSED'}->{'Challenge'});
                                        $md5->add($self->{CONFIG}->{SECRET});

                                        $md5 = $md5->hexdigest;

                                        $action->{'Key'} = $md5;
                                        $action->{'AuthType'} = $self->{CONFIG}->{AUTHTYPE};

                                        $self->send_action($action, $login_cb, $timeout);
                                                
                                } else {
                                        if ($_[1]->{'COMPLETED'}) {
                                                $self->_on_connect_err("$self->{CONFIG}->{AUTHTYPE} challenge failed");
                                        } else {
                                                $self->_on_connect_err("Timed out waiting for challenge");
                                        }

                                        return;
                                }
                        };

                #Send challenge
                $self->send_action($challenge, $challenge_cb, $timeout);
        } else {
                #Plaintext login
                $self->send_action($action, $login_cb, $timeout);
        }

        return 1;
}

#Disconnect from the AMI If logged in will first issue a logoff
sub disconnect {
        my ($self) = @_;

        $self->destroy();

        #No socket? No Problem.
        return 1;
}

#Pops the topmost event out of the buffer and returns it Events are hash references
sub get_event {
        my ($self, $timeout) = @_;
        #my $timeout = $_[1];

        $timeout = $self->{CONFIG}->{TIMEOUT} unless (defined $timeout);

        unless (defined $self->{EVENTBUFFER}->[0]) {

                my $process = AE::cv;

                $self->{CALLBACKS}->{'EVENT'}->{'cb'} = sub { $process->send($_[0]) };
                $self->{CALLBACKS}->{'EVENT'}->{'timeout'} = sub { warnings::warnif('Asterisk::AMI', "Timed out waiting for event"); $process->send(undef); };

                $timeout = $self->{CONFIG}->{TIMEOUT} unless (defined $timeout);

                if ($timeout) {

                        #Make sure event loop is up to date in case of sleeps
                        AE::now_update;

                        $self->{CALLBACKS}->{'EVENT'}->{'timer'} = AE::timer $timeout, 0, $self->{CALLBACKS}->{'EVENT'}->{'timeout'};
                }

                return $process->recv;
        }

        return shift @{$self->{EVENTBUFFER}};
}

#Returns server AMI version
sub amiver {
        my ($self) = @_;
        return $self->{AMIVER};
}

#Checks the connection, returns 1 if the connection is good
sub connected {
        my ($self, $timeout) = @_;
        
        if ($self && $self->simple_action({ Action => 'Ping'}, $timeout)) {
                return 1;
        } 

        return 0;
}

#Check whether there was an error on the socket
sub error {
        my ($self) = @_;
        return $self->{SOCKERR};
}

#Sends a keep alive
sub _send_keepalive {
        my ($self) = @_;
        #Weaken ref for use in anonysub
        weaken($self);
        my $cb = sub { 
                        unless ($_[1]->{'GOOD'}) {
                                $self->_on_timeout("Asterisk failed to respond to keepalive - $self->{CONFIG}->{PEERADDR}:$self->{CONFIG}->{PEERPORT}");
                        };
                 };

        my $timeout = $self->{CONFIG}->{TIMEOUT} || 5;
        
        return $self->send_action({ Action => 'Ping' }, $cb, $timeout);
}

#Calls all callbacks as if they had timed out Used when an error has occured on the socket
sub _clear_cbs {
        my ($self) = @_;

        foreach my $id (keys %{$self->{CALLBACKS}}) {
                my $response = $self->{RESPONSEBUFFER}->{$id};
                my $callback = $self->{CALLBACKS}->{$id}->{'cb'};
                my $store = $self->{CALLBACKS}->{$id}->{'store'};
                delete $self->{RESPONSEBUFFER}->{$id};
                delete $self->{CALLBACKS}->{$id};
                delete $self->{EXPECTED}->{$id};
                $callback->($self, $response, $store);
        }

        return 1;
}

#Cleans up
sub destroy {
        my ($self) = @_;

        $self->DESTROY;

        bless $self, "Asterisk::AMI::destroyed";

        return 1;
}

#Run event loop via anyevent
sub loop {
	$_[0]->{tmp_loop} = AnyEvent->condvar;
	my $exit = $_[0]->{tmp_loop}->recv;
	delete $_[0]->{tmp_loop};
	return $exit;
}

#Ends exits loops
sub break {
	if (defined $_[0]->{tmp_loop}) {
		$_[0]->{tmp_loop}->send(1);
	}
}

#Bye bye
sub DESTROY {
        my ($self) = @_;

        #Logoff if we are not in error
        if (!$self->{SOCKERR} && $self->{LOGGEDIN}) {

( run in 1.593 second using v1.01-cache-2.11-cpan-c221a9de4ec )