view release on metacpan or  search on metacpan

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

package Asterisk::CoroManager;

require 5.8.8;

use strict;
use warnings;
use warnings::register;
use utf8;

use Coro;
use Coro::AnyEvent;                # NB: I have only tested with Coro::EV
use Coro::Semaphore;
use Coro::Channel;
use Coro::Debug;

use Carp qw( croak longmess );
use IO::Socket;
use Digest::MD5;
use Data::Dumper::Simple;
use Time::HiRes qw ( time );

use constant DEFAULT_TIMEOUT => 3; # Default timeout to wait for
                                   # action response

=head1 NAME

Asterisk::CoroManager - Asterisk Manager Interface, Coro version

=head1 SYNOPSIS

  use Asterisk::CoroManager;

  my $astman = new Asterisk::CoroManager({
                                          user   => 'username',
                                          secret => 'test',
                                          host   => 'localhost',
                                        });

  $astman->connect || die "Could not connect to " . $astman->host . "!\n";

  my $ping = $astman->sendcommand({ Action => 'Ping' }, { timeout => '2' });

  if( $ping ) {
      # $ping->{Response} should be 'Pong'
      print "Yay, we're alive! We got ". $ping->{Response} ."\n";
  }
  else {
      print "Got no pong in 2 seconds :-(\n";
  }

  $astman->disconnect;

=head1 DESCRIPTION

This module provides a dependable, event-based interface to the
asterisk manager interface.
L<http://www.voip-info.org/wiki/view/Asterisk+manager+API>

This is done with L<Coro>, and continuations.  If you are unfamiliar
with L<Coro>, go read up on it!  Your program should 'use Coro' quite
at the beginning, and be aware of that it is asynchronous.  If you
wait for an answer to a sendcommand, other events will probably be
triggered in the meanwhile.

=head2 Logging / Error handling

Asterisk::CoroManager uses L<Log::Log4perl> if it is installed.  Read
L<Log::Log4perl>, or initialize a simple logger like this:

  use Log::Log4perl qw(:easy);
  Log::Log4perl->easy_init( { level => $DEBUG,
                              file => ">>test.log" } );

=cut

BEGIN {
    # Check for Log::Log4perl...
    eval { use Log::Log4perl qw(get_logger :nowarn); };
    if($@) {
	print "Log::Log4perl not installed - stubbing.\n";
	no strict qw(refs);
	*{__PACKAGE__."::$_"} = sub { } for qw(trace debug error fatal);
    }
    else {
	print "Log::Log4perl installed - logging enabled.\n";
	no strict qw(refs);
	foreach my $level (qw(trace debug error fatal)) {
	    *{__PACKAGE__."::$level"} =
	      sub {
		  $Log::Log4perl::caller_depth++;
		  my( $astman, $message ) = @_;
		  my $log = Log::Log4perl->get_logger();
		  $log->$level($astman->host .': '. $message);
		  $Log::Log4perl::caller_depth--;
		  return;
	      };
	}
    }
}


my $EOL = "\015\012";
my $BLANK = $EOL x 2;

use vars qw($VERSION); $VERSION = '0.11'; sub version { return $VERSION }

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

Sends a command to asterisk.

If you are looking for a response, the command will wait for the
specific response from asterisk (identified with an ActionID).
Otherwise it returns immediately.

TODO: Implement timeout: Timeout is how long to wait for the response.
Defaults to 3 seconds.

Returns a hash or hash-ref on success (depending on wantarray), undef
on timeout.

=cut

sub sendcommand {
    my( $astman, $command, $args ) = @_;
    my $actionid = $command->{ActionID} || $ACTIONID_SEQ++;

    # Ping must be handled specially, since it doesn't return ActionID
    if( $command->{Action} and
	$command->{Action} eq 'Ping' ) {
	$actionid = 'Ping';
    }

    $command->{ActionID} ||= $actionid;

    $astman->trace("Sending command: ". Dumper($command));

    my $fh = $astman->{fh};
    my $cstring = make_packet(%$command);

    eval { # Send command to Asterisk
	$fh->send("$cstring$EOL");
    } or $astman->check_connection;

    if (defined wantarray) {
	$astman->debug("Waiting for response of command here.");
	$astman->trace(longmess());
	$astman->trace("-------------------------------------");
	$args ||= {};
	my $timeout = $args->{Timeout} || DEFAULT_TIMEOUT;
	my $response = new Coro::Channel;
	$astman->{action_cb}{$actionid} = sub{ $response->put(@_) };

	my $resp = $response->get; # Cede's until a response is gotten
	return unless( $resp );
	return wantarray ? %{$resp} : $resp;
	# TODO: Timeout!
    }

    return;
}


##############################################################################

=head2 check_connection

  $astman->check_connection();

Checks if the connection is still alive.  Tries to reconnect if it
isn't.

=cut

sub check_connection {
    my( $astman ) = @_;

    if( $astman->connected ) {
	$astman->debug("...connection appears to be fine...");
    }
    else {
	$astman->error("Lost connection to server!");
	$astman->error("Trying to reconnect...");

	$astman->{fh}->close if $astman->{fh}->connected;
	undef $astman->{fh};

	if( $astman->connect ) {
	    $astman->error("Succeeded in reconnect!  "
                           ."Continuing as if nothing happened.");
	}
	else {
	    $astman->fatal("Couldn't reconnect.  "
                           ."Dying here.  Good bye cruel world.");
	    croak "Couldn't reconnect.  Dying here.  "
              ."Good bye cruel world.";
	}
    }

    return;
}


##############################################################################

=head2 eventloop

  $astman->eventloop();

Will wait for events, until shut down.

=cut

sub eventloop {
    my ($astman) = @_;

    # Coro debug shell, if socket is available
    eval {
        my $shell = new_unix_server Coro::Debug "/tmp/myshell";
    };
    if($@) {
	$astman->error("Coro debug shell failed.\n");
    }

    $astman->{finished}->recv;

    return;
}