agi.pm

Astercon2 开源软交换 2.2.0

package Asterisk::AGI;

require 5.004;

use strict;
use warnings;
use Asterisk;

use vars qw(@ISA $VERSION);
@ISA = ( 'Asterisk' );

$VERSION = $Asterisk::VERSION;

=head1 NAME

Asterisk::AGI - Simple Asterisk Gateway Interface Class

=head1 SYNOPSIS

use Asterisk::AGI;

$AGI = new Asterisk::AGI;

# pull AGI variables into %input

	%input = $AGI->ReadParse();   

# say the number 1984

	$AGI->say_number(1984);

=head1 DESCRIPTION

This module should make it easier to write scripts that interact with the
asterisk open source pbx via AGI (asterisk gateway interface)

=head1 MODULE COMMANDS

=over 4

=cut

sub new {
	my ($class, %args) = @_;
	my $self = {};
	$self->{'callback'} = undef;
	$self->{'status'} = undef;
	$self->{'lastresponse'} = undef;
	$self->{'lastresult'} = undef;
	$self->{'hungup'} = 0;
	$self->{'debug'} = 0;
	$self->{'env'} = undef;
	bless $self, ref $class || $class;
	return $self;
}

sub ReadParse {
	my ($self, $fh) = @_;

	if (!$self->_env) {
		return $self->_ReallyReadParse($fh);
	}

	return %{$self->_env};
}

sub _ReallyReadParse {
	my ($self, $fh) = @_;

	my %input = ();

	$fh = \*STDIN if (!$fh);

	while (<$fh>) {
		chomp;
		last unless length($_);
		if (/^agi_(\w+)\:\s+(.*)$/) {
			$input{$1} = $2;
		}
	}
	

	if ($self->_debug > 0) {
		print STDERR "AGI Environment Dump:\n";
		foreach my $i (sort keys %input) {
			print STDERR " -- $i = $input{$i}\n";
		}
	}

	$self->_env(%input);
	return %input;
}

=item $AGI->setcallback($funcref)

Set function to execute when call is hungup or function returns error.

Example: $AGI->setcallback(\&examplecallback);

=cut 

sub setcallback {
	my ($self, $function) = @_;

	if (defined($function) && ref($function) eq 'CODE') {
		$self->{'callback'} = $function;
	} 
}

sub callback {
	my ($self, $result) = @_;

	if (defined($self->{'callback'}) && ref($self->{'callback'}) eq 'CODE') {
		&{$self->{'callback'}}($result);
	}
}

sub execute {
	my ($self, $command) = @_;

	$self->_execcommand($command);
	my $res = $self->_readresponse();
	my $ret = $self->_checkresult($res);

	if (defined($ret) && $ret eq '-1' && !$self->_hungup()) {
		$self->_hungup(1);
		$self->callback($ret);
	}

	return $ret;
}

sub _execcommand {
	my ($self, $command, $fh) = @_;

	$fh = \*STDOUT if (!$fh);

	select ((select ($fh), $| = 1)[0]);

	return -1 if (!defined($command));

	print STDERR "_execcommand: '$command'\n" if ($self->_debug>3);

	return print $fh "$command\n";
}

sub _readresponse {
	my ($self, $fh) = @_;

	my $response = undef;
	$fh = \*STDIN if (!$fh);
	while ($response = <$fh>) {
		chomp($response);
		if (!defined($response)) {
			return '200 result=-1 (noresponse)';
		} elsif ($response =~ /^agi_(\w+)\:\s+(.*)$/) {
			# I really hate duplicating code, but if anyone has a way to be backwards compatible and keep everyone happy please let me know!
			if ($self->_debug > 0) {
				print STDERR "AGI Environment Dump:\n" if (!$self->_env);
				print STDERR " -- $1 = $2\n";
			}
			$self->_addenv($1, $2);
		} else {
			return($response);
		}
	}
}

sub _checkresult {
	my ($self, $response) = @_;

	return undef if (!defined($response));
	my $result = undef;

	$self->_lastresponse($response);
	if ($response =~ /^200/) {
		if ($response =~ /result=(-?[\d*#]+)/) {
			$result = $self->{'lastresult'} = $1;
		}
	} elsif ($response =~ /\(noresponse\)/) {
		$self->_status('noresponse');
	} else {
		print STDERR "Unexpected result '" . (defined($response) ? $response : '') . "'\n" if ($self->_debug>0);
	}
	print STDERR "_checkresult(" . (defined($response) ? $response : '') . ") = " . (defined($result) ? $result : '') . "\n" if ($self->_debug>3);

	return $result;				
}

sub _status {
	my ($self, $status) = @_;

	if (defined($status)) {
		$self->{'status'} = $status;
	} else {
		return $self->{'status'};
	}
}

sub _lastresponse {
	my ($self, $response) = @_;

	if (defined($response)) {
		$self->{'lastresponse'} = $response;
	} else {
		return $self->{'lastresponse'};
	}
}

sub _lastresult {
	my ($self, $result) = @_;

	if (defined($result)) {
		$self->{'lastresult'} = $result;
	} else {
		return $self->{'lastresult'};
	}
}

sub _hungup {
	my ($self, $value) = @_;

	if (defined($value)) {
		$self->{'hungup'} = $value;
	} else {
		return $self->{'hungup'};
	}
}

sub _debug {
	my ($self, $value) = @_;

	if (defined($value)) {
		$self->{'debug'} = $value;
	} else {
		return $self->{'debug'};
	}
}

sub _addenv {
	my ($self, $var, $value) = @_;

	$self->{'env'}->{$var} = $value;
}

sub _env {
	my ($self, %env) = @_;

	if (%env) {
		$self->{'env'} = \%env;
	} else {
		return $self->{'env'};
	}
}

sub _recurse {
	my ($self, $s2, $files, @args) = @_;

	my $sub = (caller(1))[3];
	my $ret = undef;

	foreach my $fn (@$files) {
		if (!$ret) {
			$ret = $self->$sub($fn, @args);
		}
	}
	return $ret;
}

=head1 AGI COMMANDS

=item $AGI->answer()

Executes AGI Command "ANSWER"

Answers channel if not already in answer state

Example: $AGI->answer();

Returns: -1 on channel failure, or
0 if successful

=cut

sub answer {
	my ($self) = @_;

	return $self->execute('ANSWER');
}

=item $AGI->channel_status([$channel])

Executes AGI Command "CHANNEL STATUS $channel"

Returns the status of the specified channel.  If no channel name is given the
returns the status of the current channel.

Example: $AGI->channel_status();

Returns: -1 Channel hungup or error
         0 Channel is down and available
         1 Channel is down, but reserved
         2 Channel is off hook
         3 Digits (or equivalent) have been dialed
         4 Line is ringing
         5 Remote end is ringing
         6 Line is up
         7 Line is busy

=cut

sub channel_status {
	my ($self, $channel) = @_;

	return $self->execute("CHANNEL STATUS $channel");
}

=item $AGI->control_stream_file($filename, $digits [, $skipms [, $ffchar [, $rewchar [, $pausechar]]]])

Executes AGI Command "CONTROL STREAM FILE $filename $digits [$skipms [$ffchar [$rewchar [$pausechar]]]]"

Send the given file, allowing playback to be controled by the given digits, if
any. Use double quotes for the digits if you wish none to be permitted.
Remember, the file extension must not be included in the filename.

Note: ffchar and rewchar default to * and # respectively.

Example: $AGI->control_stream_file('status', 'authorized');

Returns: -1 on error or hangup;
         0 if playback completes without a digit being pressed;
         the ASCII numerical value of the digit of one was pressed.

=cut

sub control_stream_file {
	my ($self, $filename, $digits, $skipms, $ffchar, $rewchar, $pausechar) = @_;

	return -1 if (!defined($filename));
	$digits = '""' if (!defined($digits));
	return $self->execute("CONTROL STREAM FILE $filename $digits $skipms $ffchar $rewchar $pausechar");
}

=item $AGI->database_del($family, $key)

Executes AGI Command "DATABASE DEL $family $key"

Removes database entry <family>/<key>

Example: $AGI->database_del('test', 'status');

Returns: 1 on success, 0 otherwise

=cut

sub database_del {
	my ($self, $family, $key) = @_;

	return $self->execute("DATABASE DEL $family $key");
}

=item $AGI->database_deltree($family, $key)

Executes AGI Command "DATABASE DELTREE $family $key"

Deletes a family or specific keytree within a family in the Asterisk database

Example: $AGI->database_deltree('test', 'status'); 
Example: $AGI->database_deltree('test');

Returns: 1 on success, 0 otherwise

=cut

sub database_deltree {
	my ($self, $family, $key) = @_;

	return $self->execute("DATABASE DELTREE $family $key");
}

=item $AGI->database_get($family, $key)

Executes AGI Command "DATABASE GET $family $key"

Example: $var = $AGI->database_get('test', 'status');

Returns: The value of the variable, or undef if variable does not exist

=cut

sub database_get {
	my ($self, $family, $key) = @_;

	my $result = undef;

	if ($self->execute("DATABASE GET $family $key")) {
		my $tempresult = $self->_lastresponse();
		if ($tempresult =~ /\((.*)\)/) {
			$result = $1;
		}
	}
	return $result;
}

=item $AGI->database_put($family, $key, $value)

Executes AGI Command "DATABASE PUT $family $key $value"

Set/modifes database entry <family>/<key> to <value>

Example: $AGI->database_put('test', 'status', 'authorized');

Returns: 1 on success, 0 otherwise

=cut

sub database_put {
	my ($self, $family, $key, $value) = @_;

	return $self->execute("DATABASE PUT $family $key $value");
}

=item $AGI->exec($app, $options)

Executes AGI Command "EXEC $app "$options""

The most powerful AGI command.  Executes the given application passing the given options.

Example: $AGI->exec('Dial', 'Zap/g2/8005551212');

Returns: -2 on failure to find application, or
whatever the given application returns

=cut

sub exec {
	my ($self, $app, $options) = @_;
	return -1 if (!defined($app));
	if (!defined($options)) {
		$options = '""';
	} elsif ($options =~ /^\".*\"$/) {
		# Do nothing
	} else {
		$options = '"' . $options . '"';
	}

	return $self->execute("EXEC $app $options");
}

=item $AGI->get_data($filename, $timeout, $maxdigits)

Executes AGI Command "GET DATA $filename $timeout $maxdigits"

Streams $filename and returns when $maxdigits have been received or
when $timeout has been reached.  Timeout is specified in ms

Example: $AGI->get_data('demo-welcome', 15000, 5);

=cut

sub get_data {
	my ($self, $filename, $timeout, $maxdigits) = @_;

	return -1 if (!defined($filename));
	return $self->execute("GET DATA $filename $timeout $maxdigits");
}

=item $AGI->get_full_variable($variable [, $channel])

Executes AGI Command "GET FULL VARIABLE $variablename $channel"

Similar to get_variable, but additionally understands
complex variable names and builtin variables.  If $channel is not set, uses the
current channel.

Example: $AGI->get_full_variable('status', 'SIP/4382');

Returns: The value of the variable, or undef if variable does not exist

=cut

sub get_full_variable {
	my ($self, $variable, $channel) = @_;

	$channel = '' if (!defined($channel));

	my $result = undef;

	if ($self->execute("GET FULL VARIABLE $variable $channel")) {
		my $tempresult = $self->_lastresponse();
		if ($tempresult =~ /\((.*)\)/) {
			$result = $1;
		}
	}
	return $result;
}

=item $AGI->get_option($filename, $digits [, $timeout])

Executes AGI Command "GET OPTION $filename $digits $timeout"

Behaves similar to STREAM FILE but used with a timeout option.

Streams $filename and returns when $digits is pressed or when $timeout has been
reached.  Timeout is specified in ms.  If $timeout is not specified, the command
will only terminate on the $digits set.  $filename can be an array of files
or a single filename.

Example: $AGI->get_option('demo-welcome', '#', 15000);
	 $AGI->get_option(['demo-welcome', 'demo-echotest'], '#', 15000);

=cut

sub get_option {
	my ($self, $filename, $digits, $timeout) = @_;
	my $ret = undef;

	$timeout = 0 if (!defined($timeout)); 
	return -1 if (!defined($filename));

	if (ref($filename) eq "ARRAY") {
		$ret = $self->_recurse(@_);
	} else {
		$ret = $self->execute("GET OPTION $filename $digits $timeout");
	}
	return $ret;
}

=item $AGI->get_variable($variable)

Executes AGI Command "GET VARIABLE $variablename"

Gets the channel variable <variablename>

Example: $AGI->get_variable('status');

Returns: The value of the variable, or undef if variable does not exist

=cut

sub get_variable {
	my ($self, $variable) = @_;

	my $result = undef;

	if ($self->execute("GET VARIABLE $variable")) {
		my $tempresult = $self->_lastresponse();
		if ($tempresult =~ /\((.*)\)/) {
			$result = $1;
		}
	}
	return $result;
}

=item $AGI->hangup($channel)

Executes AGI Command "HANGUP $channel"

Hangs up the passed $channel, or the current channel if $channel is not passed.
It is left to the AGI script to exit properly, otherwise you could end up with zombies.