view release on metacpan or  search on metacpan

examples/cmd_server.pl  view on Meta::CPAN

#!/usr/bin/perl

#Author: Ryan Bullock
#Version: 0.2
#Description: This provided a very simple command server for the asterisk manager interface.

use strict;
use warnings;
use AnyEvent::Impl::Perl;
use AnyEvent;
use AnyEvent::Handle;
use AnyEvent::Socket;
use Asterisk::AMI;

#Port to listen on
my $port = 5080;

#Delimiters
my $EOL = "\015\012";

my $EOR = $EOL;

#Command list;
my $list = 'Command List:' . $EOL;
$list .= 'channels - Displays list of active channels' . $EOL;
$list .= 'mailbox <mailbox> - Displays messages for a mailbox' . $EOL;
$list .= 'hangup <channel> - Hangs up a channel' . $EOL;
$list .= 'quit - Disconnects from server' . $EOL;
$list .= 'list - Displays this list' . $EOL . $EOR;

#Keep a list of clients
my %clients;

#Connect to asterisk
my $astman = Asterisk::AMI->new(PeerAddr => '127.0.0.1',
				Username => 'test',
				Secret	=> 'supersecret',
				Timeout => 3, #Default timeout for all operations, 3 seconds
				Keepalive => 60, #Send a keepalive every minute
				on_error => sub { print "Error occured on socket\r\n"; exit; },
				on_timeout => sub { print "Connection to asterisk timed out\r\n"; exit; },
                                Blocking => 0
			);

die "Unable to connect to asterisk" unless ($astman);

#Callback on mailbox command
sub mailboxcb {
	my ($asterisk, $action, $client) = @_;

	my $id = $action->{'ActionID'};
	
	my $mbstr;

	if ($action->{'GOOD'} && exists $action->{'PARSED'}) {
		while (my ($key, $value) = each %{$action->{'PARSED'}}) {
			$mbstr .= $key . ': '. $value . $EOL;
		}
	} else {
		$mbstr = 'Invalid Mailbox, or command failed' . $EOL;
	}

	$client->push_write($mbstr . $EOR);
}

#Callback on channels command
sub chancb {
	my ($asterisk, $action, $client) = @_;

	my $id = $action->{'ActionID'};
	
	my $chanstr;

	if ($action->{'GOOD'} && exists $action->{'EVENTS'}) {
		foreach my $channel (@{$action->{'EVENTS'}}) {
			$chanstr .= $channel->{'Channel'} . $EOL;
		}
	} else {
		$chanstr = 'No channels active' . $EOL;
	}

	$client->push_write($chanstr . $EOR);
}

#Callback on hangup command
sub hangupcb {
	my ($asterisk, $action, $client) = @_;

	my $id = $action->{'ActionID'};

	my $str;

	if ($action->{'GOOD'}) {
		$str = 'Channel hungup';
	} else {
		$str = 'Failed to hangup channel';
	}