view release on metacpan or  search on metacpan

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

	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 }

my $ACTIONID_SEQ = 1;
my $RESULT_SEQ = 1;



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

=head1 Constructor

=head2 new

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

Supported args are:

  host       Asterisk host.  Defaults to 'localhost'.
  port       Manager port.  Defaults to 5038,
  user       Manager user.
  secret     Manager secret.

=cut

sub new
{
    my( $class, $args ) = @_;

    my $astman;
    $astman =  bless {
		      host        => $args->{host} || 'localhost',
		      port        => $args->{port} || 5038,
		      user        => $args->{user},
		      secret      => $args->{secret},
		      watcher     => undef,
		      finished    => undef, # Will hold AnyEvent->condvar
		      action_cb   => {},    # Action response callbacks
		      event_cb    => {},    # event callbacks
		      event_dcb   => undef, # event default callback
		      uevent_cb   => {},    # userevent callbacks
		      uevent_dcb  => undef, # userevent default callback
		      ami_version => undef,
		      read_buffer => [],
		     }, __PACKAGE__;

    $astman->add_event_callback('UserEvent',
                                sub{ $astman->handle_uevent(@_) }
                               );

    return $astman;
}


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

=head1 Actions

=cut

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

=head2 connect

  $astman->connect or croak "Could not connect to ". $astman->host ."!\n";

Connects the manager to asterisk.  User, secret and host should be set
before calling this.

Returns Asterisk Manager Interface version on success; otherwise undef.

=cut

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

    my $host = $astman->{host};
    my $port = $astman->{port};
    my $user = $astman->{user};
    my $secret = $astman->{secret};

    my $fh = new IO::Socket::INET( Proto => 'tcp',
				   PeerAddr => $host,
				   PeerPort => $port,
				   Blocking => 0,
				 );

    if (!$fh) {
	$astman->error("Can't bind ($host:$port): $@\n");
	return;
    }

    $astman->{fh} = $fh;
    $fh->autoflush(1);

    # Recieve greeting from asterisk server
    my $greeting = AnyEvent->condvar;
    my $greeting_watcher
      = AnyEvent->io( fh   => $fh,

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

	    };
	    $astman->{read_buffer} = [];
	}
	else {
	    push @{$astman->{read_buffer}}, $line;
	}
    }

    return;
}


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

=head2 handle_packet

handle_packet is called when incoming on fh has gotten a full packet.

=cut

sub handle_packet {
    my( $astman, $packet ) = @_;
    my $pack = parse_packet( $packet );
    my $event = $pack->{Event};
    my $callback;

    if( $pack->{Ping} and
	not $pack->{ActionID}
      ) {
	$pack->{ActionID} = 'Ping';
    }

    if( $event ) {
	$astman->handle_event( $pack );
    }
    elsif( my $actionid = $pack->{ActionID} ) {
	$astman->debug("Returning response for Action $actionid");
	$astman->handle_actionresponse( $pack );
    }
    else {
	$astman->trace("Unhandled packet from Asterisk.");
    }

    return;
}


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

=head2 handle_event

handle_event is called if an incoming packet is an event.  Falls back
to default event handler.

=cut

sub handle_event {
    my( $astman, $pack ) = @_;
    my $event = $pack->{Event};

    if ( my $callbacks =
	 $astman->{event_cb}{$event} ||
	 $astman->{event_dcb}
       ) {
	$astman->debug("Handling event: $event");
	foreach my $cb (@$callbacks) {
	    &{$cb}($pack);
	}
    }
    else {
	$astman->trace("Unhandled event: $event");
    }
    return;
}


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

=head2 handle_uevent

handle_uevent is called if an incoming packet is a user event.  Falls
back to default user event handler and ultimately to default event
handler.

=cut

sub handle_uevent {
    my( $astman, $pack ) = @_;
    my $uevent = $pack->{UserEvent};

    if ( my $callbacks =
	 $astman->{uevent_cb}{$uevent} ||
	 $astman->{uevent_dcb} ||
	 $astman->{event_dcb}
       ) {
	$astman->debug("Handling uevent: $uevent");

	foreach my $cb (@$callbacks) {
	    &{$cb}($pack);
	}
    }
    else {
	$astman->trace("Unhandled uevent: $uevent");
    }
    return;
}


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

=head2 handle_actionresponse

handle_actionresponse is called if an incoming packet is a response
with an ActionID.

=cut

sub handle_actionresponse {
    my( $astman, $resp ) = @_;
    my $actionid = $resp->{'ActionID'};

    if( my $callback = $astman->{action_cb}{$actionid} ) {
	&{$callback}($resp);
	delete $astman->{action_cb}{$actionid};
    }
    else {
	$astman->debug("Unhandled ActionID: $actionid");
	$astman->trace("Actions: ". Dumper( $astman->{action_cb} ));
    }
    return;
}


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

=head2 parse_packet

Parses a packet as array-ref and returns it as hash-ref.

Puts unmatched lines in an array in $pack->{RestResult}.

=cut

sub parse_packet {
    my( $packet ) = @_;
    my @rest;
    my %pack;

    while (my $line = shift @{$packet}) {
	if( $line =~ /^([^:]+):\ {0,1}([^\ ].*)$/ ) {
	    $pack{$1} = $2;
	}
	else {
	    push @rest, $line;
	}
    }

    if( @rest ) {