Asterisk-AMI
view release on metacpan or search on metacpan
lib/Asterisk/AMI.pm view on Meta::CPAN
And the contents of response will look similiar to the following:
{
'Message' => 'Originate successfully queued',
'EVENTS' => [
{
'Exten' => '100',
'CallerID' => '<unknown>',
'Event' => 'OriginateResponse',
'Privilege' => 'call,all',
'Channel' => 'SIP/peer-009c5510',
'Context' => 'some_context',
'Response' => 'Success',
'Reason' => '4',
'CallerIDName' => '<unknown>',
'Uniqueid' => '1276543236.82',
'ActionID' => '3',
'CallerIDNum' => '<unknown>'
}
],
'ActionID' => '3',
'GOOD' => 1,
'COMPLETED' => 1,
'Response' => 'Success'
};
More Info:
Check out the voip-info.org page for more information on the Originate action.
http://www.voip-info.org/wiki/view/Asterisk+Manager+API+Action+Originate
=head3 Callbacks
You may also specify a subroutine to callback when using send_action as well as a timeout.
An example of this would be:
$astman->send_action({ Action => 'Ping' }, \&somemethod, 7, $somevar);
In this example once the action 'Ping' finishes we will call somemethod() and pass it the a copy of our AMI object,
the Response Object for the action, and an optional variable $somevar. If a timeout is not specified
it will use the default set. A value of 0 means no timeout. When the timeout is reached somemethod() will be called
and passed a reference to our $astman and the uncompleted Response Object, therefore somemethod() should check the
state of the object. Checking the key {'GOOD'} is usually a good indication if the response is useable.
Anonymous subroutines are also acceptable as demostrated in the examples below:
my $callback = sub { return };
$astman->send_action({ Action => 'Ping' }, $callback, 7);
Or
$astman->send_action({ Action => 'Ping' }, sub { return }, 7);
=head3 Callback Caveats
Callbacks only work if we are processing packets, therefore you must be running an event loop. Alternatively, we run
mini-event loops for our blocking calls (e.g. action(), get_action()), so in theory if you set callbacks and then
issue a blocking call those callbacks should also get triggered. However this is an unsupported scenario.
Timeouts are done using timers and they are set as soon as you send the object. Therefore if you send an action with a
timeout and then monkey around for a long time before getting back to your event loop (to process input) you can time
out before ever even attempting to receive the response.
A very contrived example:
$astman->send_action({ Action => 'Ping' }, \&somemethod, 3);
sleep(4);
#Start loop
$astman->loop;
#Oh no we never even tried to get the response yet it will still time out
=head2 Passing Variables in an Action Response
Sometimes, when working in an event framework, you want a way to associate/map the response to an action with another
identifier used in your application. Normally you would have to maintain some sort of separate mapping involving the
ActionID to accomplish this. This modules provides a generic way to pass any perl scalar (this includes references)
with your action which is then passed to the callback with the response.
=head3 Passing
The variable to be passed to the callback should be passed as the fourth argument to the send_action() method.
For example to pass a simple scalar value:
my $vartostore = "Stored";
$astman->send_action({ Action => 'Ping' }, \&somemethod, undef, $vartostore });
And to pass a reference:
my @vartostore = ("One", "Two");
$astman->send_action({ Action => 'Ping' }, \&somemethod, undef, \@vartostore });
=head3 Retrieving
The passed variable will be available as the third argument to the callback.
To retrieve in a callback:
my ($astman, $resp, $store) = @_;
print $store . " was stored\n";
=head2 Responses and Events
NOTE: Empty fields sent by Asterisk (e.g. 'Account: ' with no value in an event) are represented by the hash
value of null string, not undef. This means you need to test for ''
(e.g. if ($response->{'Account'} ne '')) ) for any values that might be possibly be empty.
=head3 Responses
Responses are returned as response objects, which are hash references, structured as follows:
$response->{'Response'} Response to our packet (Success, Failed, Error, Pong, etc).
{'ActionID'} ActionID of this Response.
{'Message'} Message line of the response.
{'EVENTS'} Array reference containing Event Objects associated with this actionid.
{'PARSED'} Hash reference of lines we could parse into key->value pairs.
lib/Asterisk/AMI.pm view on Meta::CPAN
$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();
lib/Asterisk/AMI.pm view on Meta::CPAN
#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;
}
return;
}
#Sends an action and returns its data or undef if the command failed
sub action {
my ($self, $action, $timeout) = @_;
#Send action
my $actionid = $self->send_action($action);
if (defined $actionid) {
#Get response
return $self->get_response($actionid, $timeout);
}
return;
}
#Sends an action and returns 1 if it was successful and 0 if it failed
sub simple_action {
my ($self, $action, $timeout) = @_;
#Send action
my $actionid = $self->send_action($action);
lib/Asterisk/AMI.pm view on Meta::CPAN
$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);
}
( run in 1.450 second using v1.01-cache-2.11-cpan-75ffa21a3d4 )