[Asterisk-cvs] asterisk-addons/res_perl/INC AstAPI.pm, NONE,
1.1 AstAPIBase.pm, NONE, 1.1 AstConfig.pm, NONE,
1.1 LoadFile.pm, NONE, 1.1 PerlSwitch.pm, NONE,
1.1 WebServer.pm, NONE, 1.1 asterisk_init.pm, NONE, 1.1
anthm at lists.digium.com
anthm at lists.digium.com
Fri Sep 24 17:40:48 CDT 2004
Update of /usr/cvsroot/asterisk-addons/res_perl/INC
In directory mongoose.digium.com:/tmp/cvs-serv2784/INC
Added Files:
AstAPI.pm AstAPIBase.pm AstConfig.pm LoadFile.pm PerlSwitch.pm
WebServer.pm asterisk_init.pm
Log Message:
DoH forgot to add these files
--- NEW FILE: AstAPI.pm ---
use AstAPIBase;
package LoadSym;
sub CloneSymbols($$) {
my($hashRef,$newobj) = @_;
my $code;
my @export;
my $export_code;
my(%symbols);
my(@symbols);
%symbols = %{$hashRef};
@symbols = sort(keys(%symbols));
foreach (@symbols) {
#printf("%-10.10s| %s\n", $_, $symbols{$_});
my ($this) = $symbols{$_} =~ /::(.*)$/;
$code .= "*${newobj}::$this = $symbols{$_};\n";
}
return $code;
}
package AstAPI;
our %AST_CONTROL = (HANGUP => 1,
RING => 2,
RINGING => 3,
ANSWER => 4,
BUSY => 5,
TAKEOFFHOOK => 6,
OFFHOOK => 7,
CONGESTION => 8,
FLASH => 9,
WINK => 10,
OPTION => 11,
RADIO_KEY => 12,
RADIO_UNKEY => 13,
PROGRESS => 14
);
our %AST_FORMAT = (
G723_1 => (1 << 0),
GSM => (1 << 1),
ULAW => (1 << 2),
ALAW => (1 << 3),
G726 => (1 << 4),
ADPCM => (1 << 5),
SLINEAR => (1 << 6),
LPC10 => (1 << 7),
G729A => (1 << 8),
SPEEX => (1 << 9),
ILBC => (1 << 10),
MAX_AUDIO => (1 << 15),
JPEG => (1 << 16),
PNG => (1 << 17),
H261 => (1 << 18),
H263 => (1 << 19),
MAX_VIDEO => (1 << 24)
);
our %FORMAT_AST = reverse(%AST_FORMAT);
our %AST_STATE = (
DOWN => 0,
RESERVED => 1,
OFFHOOK => 2,
DIALING => 3,
RING => 4,
RINGING => 5,
UP => 6,
BUSY => 7,
DIALING_OFFHOOK => 8,
MUTE => (1 << 16)
);
our %STATE_AST = reverse(%AST_STATE);
our $AST_DIGIT_ANY = "0123456789";
$code =
LoadSym::CloneSymbols(\%AstAPIBasec::,"Asterisk::Embed") .
LoadSym::CloneSymbols(\%AstAPI::,"Asterisk::Embed");
eval $code;
1;
--- NEW FILE: AstAPIBase.pm ---
# This file was automatically generated by SWIG
package AstAPIBase;
require Exporter;
require DynaLoader;
@ISA = qw(Exporter DynaLoader);
package AstAPIBasec;
bootstrap AstAPIBase;
package AstAPIBase;
@EXPORT = qw( );
# ---------- BASE METHODS -------------
package AstAPIBase;
sub TIEHASH {
my ($classname,$obj) = @_;
return bless $obj, $classname;
}
sub CLEAR { }
sub FIRSTKEY { }
sub NEXTKEY { }
sub FETCH {
my ($self,$field) = @_;
my $member_func = "swig_${field}_get";
$self->$member_func();
}
sub STORE {
my ($self,$field,$newval) = @_;
my $member_func = "swig_${field}_set";
$self->$member_func($newval);
}
sub this {
my $ptr = shift;
return tied(%$ptr);
}
# ------- FUNCTION WRAPPERS --------
package AstAPIBase;
*asterisk_log = *AstAPIBasec::asterisk_log;
*asterisk_get_channel_by_name = *AstAPIBasec::asterisk_get_channel_by_name;
*asterisk_chanlist = *AstAPIBasec::asterisk_chanlist;
*asterisk_chan_priority = *AstAPIBasec::asterisk_chan_priority;
*asterisk_run_app = *AstAPIBasec::asterisk_run_app;
*asterisk_exec = *AstAPIBasec::asterisk_exec;
*asterisk_control_streamfile = *AstAPIBasec::asterisk_control_streamfile;
*asterisk_answer = *AstAPIBasec::asterisk_answer;
*asterisk_waitfordigit = *AstAPIBasec::asterisk_waitfordigit;
*asterisk_sendtext = *AstAPIBasec::asterisk_sendtext;
*asterisk_recvchar = *AstAPIBasec::asterisk_recvchar;
*asterisk_tddmode = *AstAPIBasec::asterisk_tddmode;
*asterisk_sendimage = *AstAPIBasec::asterisk_sendimage;
*asterisk_streamfile = *AstAPIBasec::asterisk_streamfile;
*asterisk_saynumber = *AstAPIBasec::asterisk_saynumber;
*asterisk_saydigits = *AstAPIBasec::asterisk_saydigits;
*asterisk_getdata = *AstAPIBasec::asterisk_getdata;
*asterisk_setcontext = *AstAPIBasec::asterisk_setcontext;
*asterisk_setextension = *AstAPIBasec::asterisk_setextension;
*asterisk_setpriority = *AstAPIBasec::asterisk_setpriority;
*asterisk_recordfile = *AstAPIBasec::asterisk_recordfile;
*asterisk_autohangup = *AstAPIBasec::asterisk_autohangup;
*asterisk_soft_hangup = *AstAPIBasec::asterisk_soft_hangup;
*asterisk_hangup = *AstAPIBasec::asterisk_hangup;
*asterisk_setcallerid = *AstAPIBasec::asterisk_setcallerid;
*asterisk_channelstatus = *AstAPIBasec::asterisk_channelstatus;
*asterisk_setvariable = *AstAPIBasec::asterisk_setvariable;
*asterisk_getvariable = *AstAPIBasec::asterisk_getvariable;
*asterisk_verbose = *AstAPIBasec::asterisk_verbose;
*asterisk_dbget = *AstAPIBasec::asterisk_dbget;
*asterisk_dbput = *AstAPIBasec::asterisk_dbput;
*asterisk_dbdel = *AstAPIBasec::asterisk_dbdel;
*asterisk_dbdeltree = *AstAPIBasec::asterisk_dbdeltree;
*asterisk_moh_start = *AstAPIBasec::asterisk_moh_start;
*asterisk_moh_stop = *AstAPIBasec::asterisk_moh_stop;
*asterisk_bridge_call = *AstAPIBasec::asterisk_bridge_call;
*asterisk_request_and_dial = *AstAPIBasec::asterisk_request_and_dial;
*asterisk_manager_command = *AstAPIBasec::asterisk_manager_command;
*asterisk_cli = *AstAPIBasec::asterisk_cli;
*asterisk_best_format = *AstAPIBasec::asterisk_best_format;
*asterisk_set_read_format = *AstAPIBasec::asterisk_set_read_format;
*asterisk_set_write_format = *AstAPIBasec::asterisk_set_write_format;
*asterisk_set_best_read_format = *AstAPIBasec::asterisk_set_best_read_format;
*asterisk_set_best_write_format = *AstAPIBasec::asterisk_set_best_write_format;
*asterisk_request = *AstAPIBasec::asterisk_request;
*asterisk_dial = *AstAPIBasec::asterisk_dial;
*asterisk_waitfor = *AstAPIBasec::asterisk_waitfor;
*asterisk_make_compatible = *AstAPIBasec::asterisk_make_compatible;
*asterisk_wait_for_control = *AstAPIBasec::asterisk_wait_for_control;
# ------- VARIABLE STUBS --------
package AstAPIBase;
*CONF_SIZE = *AstAPIBasec::CONF_SIZE;
1;
--- NEW FILE: AstConfig.pm ---
package AstConfig;
use strict;
sub _create_new_cat($) {
my $name = shift;
my $me = {
name => $name,
vars => [],
};
return $me;
}
sub init(;) {
my $proto = shift;
my $class = ref($proto) || $proto;
my $self = [];
bless ($self, $class);
}
sub return_data($) {
my($self) = @_;
return @{$self};
}
sub get_cat($$) {
my($self,$cat_name) = @_;
foreach(@{$self}) {
if($_->{name} eq $cat_name) {
return $_;
}
}
return undef;
}
sub add_cat($$) {
my $self = shift;
my $cat_name = shift;
my $cat = _create_new_cat($cat_name);
push @{$self},$cat;
return $cat;
}
sub add_var($$$$;$) {
my($self,$cat_name,$var,$val,$pop) = @_;
my $cat = $self->get_cat($cat_name);
unless($cat) {
$cat = $self->add_cat($cat_name);
}
pop @{$cat->{vars}} if($pop);
push @{$cat->{vars}},{var => $var, val => $val};
}
1;
--- NEW FILE: LoadFile.pm ---
# use me in asterisk_init.pm and call Perl(LoadFile:<file>:<arg1>:<..argn>)
package LoadFile;
$| = 1;
require Exporter;
our @ISA = qw(Exporter);
our @EXPORT = qw(LoadFile LoadFileCache LoadFileUnCache LoadFileCacheAll LoadFileUnCacheAll);
our @EXPORT_OK = (@EXPORT);
our $VERSION = 1;
my %LOAD_FILE;
my $astdir = "/etc/asterisk/perl";
sub _mydie($) {
my $msg = shift;
Asterisk::Embed::asterisk_log("LOG_ERROR","$msg\n");
return -1;
}
sub _inhale($) {
my $file = shift;
my ($filename) = $file =~ /\/([^\/]+)$/;
$file and $filename or return 0;
open(I,$file) or return 0;
$/=undef;
$code = <I>;
close I;
$/="\n";
eval {
my $ref = eval $code;
return 0 if(! ref $ref);
$LOAD_FILE{$filename} = [time,$ref];
Asterisk::Embed::asterisk_log("LOG_NOTICE","LoadFile: Cached $filename\n");
};
if($@) {
Asterisk::Embed::asterisk_log("LOG_ERROR","Perl Error: $@\n");
return 0;
}
return 1;
}
sub LoadFileUnCache($) {
my $filename = shift;
if(exists $LOAD_FILE{$filename}) {
delete $LOAD_FILE{$filename};
Asterisk::Embed::asterisk_log("LOG_NOTICE","uncached $filename\n");
}
else {
Asterisk::Embed::asterisk_log("LOG_NOTICE","$filename not cached\n");
}
}
sub LoadFileCache($) {
my $filename = shift;
_inhale("$astdir/apps/$filename");
}
sub LoadFileCacheAll() {
opendir(D,"$astdir/apps");
my @files = readdir D;
closedir D;
foreach my $file (@files) {
if($file =~ /.*\.pl$/) {
LoadFileCache($file);
}
}
}
sub LoadFileUnCacheAll() {
foreach my $file (keys %LOAD_FILE) {
LoadFileUnCache($file);
}
}
sub LoadFile() {
my $chan_name = shift;
my $filename = shift;
my $path = "$astdir/apps/$filename";
return _mydie("missing filename arguement.\n") unless($filename);
my($mod,$code);
my @st = stat "$path";
return _mydie("missing file: $path!\n") unless(@st);
if (exists $LOAD_FILE{$filename}) {
($mod,$code) = @{$LOAD_FILE{$filename}};
}
if (! $mod or $st[9] > $mod) { # new or newer
if(! _inhale($path)) {
return _mydie("Error Loading: $path!\n");
}
($mod,$code) = @{$LOAD_FILE{$filename}};
}
return $code->($chan_name, at _);
}
1;
--- NEW FILE: PerlSwitch.pm ---
package PerlSwitch;
$| = 1;
require Exporter;
our @ISA = qw(Exporter);
our @EXPORT = qw(perl_switch_handler perl_switch_register);
our @EXPORT_OK = (@EXPORT);
our $VERSION = 1;
my $switches = {
exists => undef,
canmatch => undef,
exec => undef,
matchmore => undef
};
sub perl_switch_register($) {
my $new = shift;
$switches->{exists} = $new->{exists} if($new->{exists});
$switches->{canmatch} = $new->{canmatch} if($new->{canmatch});
$switches->{exec} = $new->{exec} if($new->{exec});
$switches->{matchmore} = $new->{matchmore} if($new->{matchmore});
}
sub perl_switch_handler() {
my $type = $_[0];
if(exists $switches->{$type}) {
return $switches->{$type}->(@_);
}
return 0;
}
1;
--- NEW FILE: WebServer.pm ---
#!/usr/local/bin/perl
use IO::Socket;
use IO::Select;
use CGI;
use Data::Dumper;
our $server;
use IO::Handle;
our $finished = 0;
sub htdecode($;$) {
my $urlin = shift;
my $url = (ref $urlin) ? \$$urlin : \$urlin;
$$url =~ s/%([0-9A-Z]{2})/chr hex $1/ieg;
$$url;
}
sub genheads($@) {
my $now = scalar gmtime() . "GMT";
my $code = shift;
my %chart = (500 => "HTTP/1.1 500 Server Error",
404 => "HTTP/1.1 404 Not Found",
200 => "HTTP/1.1 200 OK",
302 => "HTTP/1.1 302 Found",
);
my @heads = ( $chart{$code} || $chart{404},
"Date: $now",
"Server: AsteriskWeb 1.0",
"Accept-Ranges: bytes"
);
if(!$_[0]) {
return join("\n", (@heads, at _)) . "\n";
}
join("\n", (@heads, at _)) . "\n\n";
}
sub done() {
asterisk_log("LOG_WARNING","WEB SERVER CLOSING DOWN\n");
close LOG;
$server->close();
$server = $client = undef;
$finished = 1;
}
my $select = IO::Select->new();
our %CGI_CODE = ();
sub webserver_eval_file($) {
my $file = shift;
my @st = stat "$file";
return undef if(! @st);
my $code;
my $mod;
my $key = $file;
$key =~ s/\W//g;
if(exists $CGI_CODE{$key}) {
($code,$mod) = @{$CGI_CODE{$key}};
if(! $mod || ($st[9] > $mod)) {
asterisk_log("LOG_WARNING","$file expired.\n");
$code = undef;
}
}
if(!$code) {
open(I,$file) or return undef;
$/=undef;
$code = <I>;
close I;
$/ = "\n";
asterisk_log("LOG_WARNING","Loaded $file\n");
eval {
eval $code;
return undef if(! \&ast_cgi);
$CGI_CODE{$key} = [\&ast_cgi,time];
};
}
return $CGI_CODE{$key}->[0];
}
sub web_server() {
my $server_port = "8080";
$server = IO::Socket::INET->new(LocalPort => $server_port,
Type => SOCK_STREAM,
Proto => "tcp",
Reuse => 1,
Listen => 50 ) # or SOMAXCONN
or die "Couldn't be a tcp server on port $server_port : $@\n";
print scalar localtime() . " PERL WEBSERVER ONLINE\n";
open(P,">/var/run/ev.pid");
print P $$;
close(P);
my $pid;
$SIG{INT} = $SIG{ALRM} = $SIG{HUP} = $SIG{KILL} = $SIG{USR2} = \&done;
while (! $finished and my $client = $server->accept()) {
if($client) {
$SIG{INT} = $SIG{HUP} = $SIG{KILL} = sub {exit};
my $done = 0;
my @req = ();
my $h11 = 0;
my $cgi = 0;
eval {
do {
my $line = <$client>;
$line =~ s/\r//g;
push @req,$line;
$h11++ if($line =~ /http\/1.1/i);
if ($h11) {
$done = 1 if($line eq "\n");
} else {
$done = 1;
}
} while (! $done);
};
# mega crude but it's a demo waddya want?
select $client;
my($how,$url,$proto) = split(" ",$req[0]);
my $docroot = "/etc/asterisk/perl/htdocs";
my $urlroot = "$docroot$url";
if(-d $urlroot) {
foreach my $f (("index.cgi","index.cgi")) {
if(-f "$urlroot/$f") {
$urlroot .= "/$f";
}
}
}
my ($FILE,$QUERY_STRING) = $urlroot =~ /([^\?]+)\?{0,1}(.*)/;
if(! -f $FILE) {
print genheads(200,"Content-Type: text/html");
print "<B>NOT FOUND</B>";
#exit;
break;
}
if($FILE =~ /\.cgi/) {
if($how =~ /get/i){
print genheads(200);
my $code = webserver_eval_file($FILE);
eval {
if($code) {
$code->({SOCKET => $client, SOCKET_NO => fileno($client),QUERY_STRING => $QUERY_STRING});
}
else {
print "Content-Type: text/html\n\n<h1>500 ERROR</h1>";
}
};
}
else {
print genheads(200,"Content-Type: text/html");
print "<B>NOT SUPPORTED YET!!</B>";
}
}
else {
open(I,$FILE);
print while(<I>);
close I;
}
$client->close();
}
}
}
1;
--- NEW FILE: asterisk_init.pm ---
#use WebServer; # WebServer.pm makes a mini-web server
use Socket;
use POSIX;
use AstConfig;
use Data::Dumper;
use LoadFile;
use AstAPI;#<----- need this to talk to asterisk.
use PerlSwitch; # switching feature
# <configuration settings>
%PERL_CONFIG = (
USE_CDR => 0, # enable CDR
USE_SWITCH => 0, # enable switch
USE_CONFIG => 0 # enable config
);
# </configuration settings>
# LoadFile.pm implements the LoadFile func for app_perl to allow you
# to put mini perl apps in 1 file and load them by name
# each file is only loaded 1 time unless it changes on disk, then
# it will be re-read from disk and re-cached.
#
# exten => 1234,1,Perl(LoadFile:demo.pl:some arg)
#
sub startup() {
asterisk_log("LOG_NOTICE","perl is in the house.");
asterisk_log("LOG_NOTICE","Hi! I'm using perl to call ast_log\n\n");
# uncomment the line below and the top line in this file to enable WebServer.pm
# return("thread:web_server");
return();
}
sub logtest() {
asterisk_log("LOG_NOTICE",sprintf("TEST %s\n",join(" ", at _)));
}
sub shutdown() {
asterisk_log("LOG_NOTICE","Perl sayin' C-YA!");
return("");
}
# this function implements the perl config engine gateway
# basicly, you get the name of the config file as the arg
# and you need to init a AstConfig obj ($config) and return the
# $config->return_data() func. this will config queues.conf
# as shown you could also connect to a DB here etc and build any
# config you see fit.
sub perl_config() {
my $arg = shift;
my $config = init AstConfig();
print "\n\n\nperl config called on $arg\n";
if($arg eq "queues.conf") {
$config->add_cat("somequeue");
$config->add_var("somequeue","Member","Agent/1000,1234,1");
$config->add_var("somequeue","Member","Agent/1001,1234,1");
$config->add_cat("anotherqueue");
$config->add_var("anotherqueue","Member","Agent/1000,1234,1");
$config->add_var("anotherqueue","Member","Agent/1001,1234,1");
return $config->return_data();
}
}
# this is a demo of a typical func you call from extensions.conf
# arglist is a ':' seperated list of strings
# exten => 1234,1,Perl(perldemo:${EXTEN})
#
# this code is only compile once so you cant change it w/o restarting.
# when a func is called from extensions.conf, the 1st arg is always the channel name
# so typically you want to call
# my $chan_name = shift;
# my $chan = asterisk_get_channel_by_name($chan_name);
# $chan is the main argument to many of the asterisk_* functions
sub perldemo() {
my $chan_name = shift;
my $arg = shift;
asterisk_log("LOG_NOTICE","EXTEN is [$arg]\n");
my $chan = asterisk_get_channel_by_name($chan_name);
asterisk_answer($chan);
asterisk_streamfile($chan,"conf-onlyperson","1",0);
asterisk_soft_hangup($chan);
# some code to try bringing up a channel / bridge a call
# my $newchan = asterisk_request_and_dial("Zap","7",AST_FORMAT_ULAW,"Test",60000);
# if($chan and $newchan) {
# asterisk_bridge_call($chan,$newchan,0,0,1);
# }
# asterisk_soft_hangup($chan);
# asterisk_hangup($newchan);
}
# some junk to document other possible api calls
# docs someday!
#$data = asterisk_getdata($chan,"beep",5,5000);
#asterisk_log("LOG_NOTICE","input was $data!\n");
#asterisk_hangup($chan);
#asterisk_exec($chan,"Dial","Zap/g3/14149361212");
#asterisk_log("LOG_NOTICE",sprintf("digit was %d",asterisk_waitfordigit($chan,10000)));
#asterisk_moh_start($chan,"default");
sub switch_exists() {
my($type,$channel,$context,$exten,$priority,$callerid,$data) = @_;
print "Perl Switch Exists: $context/$exten/$priority [$callerid] [$data]\n";
return 0;
}
sub switch_canmatch() {
my($type,$channel,$context,$exten,$priority,$callerid,$data) = @_;
print "Perl Switch CanMatch: $context/$exten/$priority\n";
return 0;
}
sub switch_exec() {
my($type,$channel,$context,$exten,$priority,$callerid,$data) = @_;
print "Perl Switch Exec: $context/$exten/$priority [$callerid] [$data]\n";
return 0;
}
sub switch_matchmore() {
my($type,$channel,$context,$exten,$priority,$callerid,$data) = @_;
print "Switch MatchMore: $context/$exten/$priority\n";
return 0;
}
my $switches = {
exists => \&switch_exists,
canmatch => \&switch_canmatch,
exec => \&switch_exec,
matchmore => \&switch_matchmore
};
perl_switch_register($switches) if($PERL_CONFIG{USE_SWITCH});
## cdr gateway function args are in order just like cdr_csv
## times are all expressed as ints
sub perl_cdr() {
}
1;
More information about the svn-commits
mailing list