asterisk-perl-1.08/0000755000175000017500000000000012754110634015004 5ustar cgonzalezcgonzalezasterisk-perl-1.08/META.yml0000664000175000017500000000124212754110634016256 0ustar cgonzalezcgonzalez--- abstract: 'Asterisk Perl Interface' author: - 'James Golovich ' build_requires: ExtUtils::MakeMaker: '0' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 7.1001, CPAN::Meta::Converter version 2.150005' license: unknown meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: asterisk-perl no_index: directory: - t - inc requires: Digest::MD5: '0' IO::Socket: '0' Net::Telnet: '0' resources: repository: https://github.com/asterisk-perl/asterisk-perl.git version: '1.08' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' asterisk-perl-1.08/.gitignore0000644000175000017500000000014312736552564017006 0ustar cgonzalezcgonzalezMakefile Makefile.old MANIFEST blib pm_to_blib asterisk-perl*tar.gz /META.yml /META.json /MYMETA.* asterisk-perl-1.08/README0000644000175000017500000000217512736552564015705 0ustar cgonzalezcgonzalezAsterisk Perl Modules by James Golovich These are all modules for interfacing with the Asterisk open source pbx system. The main site for these files is http://asterisk.gnuinter.net, or soon to be found at a CPAN mirror near you. Some documentation is in the the perl modules, use perldoc to read it (example: perldoc Asterisk::AGI) To install these modules just do: perl Makefile.PL make all make install Examples that use these modules can be found in the examples/ directory Here is a short description of what each does: agi-sayani.agi: AGI Script that says the callerid and dnis agi-test.agi: Rewrite of AGI Example included with asterisk calleridnamelookup.agi: AGI Script that uses an online reverse number databases to add a name to callerid tts-bofh.agi: AGI script that uses Festival to give a random bofh excuse tts-ping.agi: AGI script that pings an ip address and notifies the user if the host is up or down tts-line.agi: AGI script that uses Festival to read a text file one line at a time manager-test.pl: Example usage of the Asterisk::Manager module Asterisk can be found at http://www.asterisk.org asterisk-perl-1.08/examples/0000755000175000017500000000000012754110634016622 5ustar cgonzalezcgonzalezasterisk-perl-1.08/examples/directory.agi0000755000175000017500000005371012736552564021335 0ustar cgonzalezcgonzalez#!/usr/bin/perl ################################################################################ # Version: 0.1 # File: directory.agi # # The purpose of this agi script is to provide an online telephone directory # that can be easily accessed using the numbers on the phone dial pad. # # # You select entries by spelling out the name of the person you want to contact # using the phone dial pad. Now this is normally pretty labourious so the script # provides a few shortcuts to make things easier. # # The best way to illustrate this is by example: # Say you want to phone John Smith: # - You would start by typing 5, this would find all entries that start with # j,k or l. # - Next you would type 6 which would narrow down the selection to all entries # starting with either "j", "k" or "l" followed by either "m", "n" or "o". # - You continue to spell out the name in this fashion (4 = gHi, 6 = mnO etc) # until either a distinct match is found in the direcotry or the number of # matches is 9 or less. # # If a distinct match is found the number associated with the name is returned # and can be dialed. # # If the number of matches is 9 or less you can have an IVR menu containing the # matching names built on the fly and you will be prompted to select a name # (e.g. Press 1 for John Smith, Press 2 for John Doe etc). Once a name is # selected the number associated with the name is returned and can be dialed. # # # Now you might think that this is still pretty laborious but in fact you # usually only have to spell out the first few letter of the first name and the # last name to get a good match. # # # # Other feature include: # - Being able to jump to the last name without having to finish spelling out the # first name (i.e. Press 0 to skip to the last name) # - Multiple numbers can be associated with a name. In this case you will be # prompted to select which number you wanted returned for dialing (e.g. Press 1 # for Home, Press 2 for Business, etc) # - Undo last typed entry in case you misstyped something # - Wildcard matching (Press 1 to match any letter) # - IVR menus built on the fly so you do not need to prerecord anything # - IVR menus cached (the more you use it the quicker it gets) # - Returns the selected number in the variable "DIRNUMBER" # # # # So now that you are interrested the next question is how do you get this thing # up and running? # # First off you need the following: # - Festival # - Perl # - The Perl module Asterisk::AGI # # # Then just follow the next couple of steps: # 1). Place this file in the Asterisk agi-bin directory (/usr/share/asterisk/agi-bin) # and check the section "Check the following and adjust to your local environment" # to make sure it fits with your needs # # 2). Create an extension something like this: # exten => 100,1,AGI,directory.agi|Phonebook} # exten => 100,2,GotoIf($["${DIRNUMBER}" = ""]?3:4) # exten => 100,3,Hangup # exten => 100,4,Dial(SIP/${DIRNUMBER}@GW-PSTN,30) # # 3). Create a phone directory file called "Phonebook" and place it in # the directory /usr/share/asterisk/directory/. # # The phone directory conisist of one Heading Line and multiple Entry Lines # # The "Heading Line" has the following format: # # First NameLast NamePhone Location 1Phone Location 2... # # where by the must be a real tab character and there can be up to a # maximum of 9 phone locations # # The "Entry Lines" contain the actual data for the heading line columns also # seperated by characters. # # # Sounds complicated but the following example should help you understand: # # First NameLast NameCompanyBusiness PhoneHome PhoneMobile Phone # RemkoGolden+49 (89) 145456 # PeterKlein0221 87654230 # ClaudiaThompson052 52586345069 87654780171 65443897 # # Of course you can always also do what I did and that is to use the Microsoft # Outlook export feature. # # # To Do: # - Find undo bug. Sometines after an undo the search gets confused and returns # the wrong results. # - Allow skipping between first, last and company names. The handling is not that # clean and you cannot switch back and forth. # - Currently all the IVR prompts are build on the fly and cached. It would be # better to cat snippets together and use those. Would be simple if STREAM FILE # could take a list of files instead of just one. # - Cleanup the Perl code. # - Added ability to prerecord names as some are hard to understand. # # # Copyright (C) 2006 C. de Souza ( m.list at yahoo.de ) # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 # of the License, or (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. ################################################################################ use Asterisk::AGI; use File::Basename; use Digest::MD5 qw(md5_hex); ################################################################################ # Check the following and adjust to your local environment ################################################################################ # location of the phone directory files local $DIRECTORYDIR="/usr/share/asterisk/directory/"; # location of the wave file cache and owrking directory local $SOUNDDIR = "/var/lib/asterisk/festivalcache/"; # festival text2wave location local $T2WDIR= "/usr/bin/"; # International Country Code local $INTLCOUNTRYCODE = "\\+49"; # International Dialing Code local $INTLDAILINGCODE = "00"; # National Dialing Code local $NATIONALDAILINGCODE = "0"; ################################################################################ # Local stuff, should not require changing ################################################################################ local $hitCnt = 0; local $FLSEPERATOR = "~"; local %directory; local %directoryOrig; local $searchstr = ""; local $searchstrOrig = ""; local @numberLabels = (); local $MODE_COMMAND = "command"; local $MODE_ERROR = "error"; local $MODE_EXIT = "exit"; local $MODE_FOUND = "found"; local $MODE_SEARCHING = "searching"; local $mode = $MODE_SEARCHING; #my $debug = 0; my $SUBNAME = "MAIN"; my %input; ################################################################################ # Sub debug ################################################################################ sub debug { my $string = shift; my $level = shift || 3; $AGI->verbose($string, $level) if ( $debug ); return(0); } # sub debug ################################################################################ # sub getTTSFilename ################################################################################ sub getTTSFilename { my ( $text ) = @_; my $hash = md5_hex($text); my $wavefile = "$SOUNDDIR"."tts-diirectory-$hash.wav"; unless( -f $wavefile ) { open( fileOUT, ">$SOUNDDIR"."say-text-$hash.txt" ); print fileOUT "$text"; close( fileOUT ); my $execf=$T2WDIR."text2wave $SOUNDDIR"."say-text-$hash.txt -F 8000 -o $wavefile"; system( $execf ); unlink( $SOUNDDIR."say-text-$hash.txt" ); } return "$SOUNDDIR".basename($wavefile,".wav"); } # sub getTTSFilename ################################################################################ # sub performSearch { ################################################################################ sub performSearch { my( $digits, $mode, $hitCnt, $searchstr, $searchstrOrig ) = @_; my $SUBNAME = "performSearch"; my $digit = ""; $AGI->verbose( "$SUBNAME: Entering", 1 ); while(( length( $digits ) > 0 ) && ( $mode eq $MODE_SEARCHING ) ) { $digit = substr( $digits, 0, 1 ); $digits = substr( $digits, 1, length( $digits ) - 1 ); switch: { if( $digit eq "*" ) { $mode = $MODE_COMMAND; last switch} if( $digit == 0 ) { $searchstr .= ".*?~"; # use ? for minimal match i.e. first "$FLSEPERATOR" $searchstrOrig .= $digit; last switch} if( $digit == 1 ) { $searchstr .= "."; last switch} if( $digit == 2 ) { $searchstr .= "[abc]"; $searchstrOrig .= $digit; last switch} if( $digit == 3 ) { $searchstr .= "[def]"; $searchstrOrig .= $digit; last switch} if( $digit == 4 ) { $searchstr .= "[ghi]"; $searchstrOrig .= $digit; last switch} if( $digit == 5 ) { $searchstr .= "[jkl]"; $searchstrOrig .= $digit; last switch} if( $digit == 6 ) { $searchstr .= "[mno]"; $searchstrOrig .= $digit; last switch} if( $digit == 7 ) { $searchstr .= "[pqrs]"; $searchstrOrig .= $digit; last switch} if( $digit == 8 ) { $searchstr .= "[tuv]"; $searchstrOrig .= $digit; last switch} if( $digit == 9 ) { $searchstr .= "[wxyz]"; $searchstrOrig .= $digit; last switch} } # switch } if( $mode eq $MODE_SEARCHING ) { my $name = ""; foreach $name ( keys %directory ) { if( $name !~ /^$searchstr/i ) { delete $directory{ $name }; $hitCnt--; } } # foreach $name } # if( $mode eq $MODE_SEARCHING # Output some status info for debug #foreach $name ( keys %directory ) { # $AGI->verbose( "$SUBNAME: Found<$name>", 1 ); #} # foreach $name $AGI->verbose( "$SUBNAME: mode<$mode>" , 1 ); $AGI->verbose( "$SUBNAME: searchstr<$searchstr>" , 1 ); $AGI->verbose( "$SUBNAME: searchstrOrig<$searchstrOrig>" , 1 ); $AGI->verbose( "$SUBNAME: hitCnt<$hitCnt>", 1 ); return $mode, $hitCnt, $searchstr, $searchstrOrig; } # sub performSearch { ################################################################################ # sub loadFile ################################################################################ sub loadFile { my( $DIRECTORYDIR, $FLSEPERATOR, $name ) = @_; my $SUBNAME = "loadFile"; my $hitCnt = 0; my $line = ""; my $flname = ""; $AGI->verbose( "$SUBNAME: Entering", 1 ); open( FILE, $DIRECTORYDIR.$name ); # or die "Cannot open '$FILENAME': $!"; while( $line = ) { chop( $line ); chop( $line ); # seem to have a ^M in as well #print "line<$line>\n"; my ( $fname, $lname, $bname, $phoneNumbers ) = split /\t/, $line, 4; #print "fname<$fname>\tlname<$lname>\tbname<$bname>\n"; $flname = ""; $flname .= $fname.$FLSEPERATOR.$lname.$FLSEPERATOR.$bname; #print "flname<$flname>\tphone<$phoneNumbers>\n"; if(( $phoneNumbers ne "" ) && ( $flname ne "$FLSEPERATOR.$FLSEPERATOR" ) ) { if( @numberLabels == 0 ) { # deal with labels ( @numberLabels ) = split /\t/, $phoneNumbers, 9; } else { # deal with entries if( $directory{ $flname } ){ debug( "$SUBNAME: Duplicate entry <$flname>", 1 ); } else { $hitCnt++; $directory{ $flname } = $phoneNumbers; $directoryOrig{ $flname } = $phoneNumbers; } } #if( $hitCnt } else { debug( "$SUBNAME: No phone number(s) for <$flname>", 1 ); } #if( $phoneNumbers } #while close( FILE ); #print "hitCnt<$hitCnt>\n"; #foreach $name ( keys %directory ) { # print "Loaded <$name>\n"; #} return $hitCnt; } # sub loadFile ################################################################################ # sub cmdSelectContactFromMenu { ################################################################################ sub cmdSelectContactFromMenu { my( $mode, $hitCnt ) = @_; my $SUBNAME = "cmdSelectContactFromMenu"; my $contactMenu = ""; my $escapeDigits = "*"; my $menuPos = 0; my $fname = ""; my $lname = ""; my $inputKey = ""; $AGI->verbose( "$SUBNAME: Entering", 1 ); if( $hitCnt > 9 ) { $AGI->verbose( "$SUBNAME: hitCnt > 9", 1); $AGI->stream_file( getTTSFilename( "$hitCnt" )); $AGI->stream_file( getTTSFilename( "names is too may to list" )); } elsif( $hitCnt == 0 ) { $AGI->verbose( "$SUBNAME: hitCnt == 0", 1); $AGI->stream_file( getTTSFilename( "There are no names in the list" )); } else { my $name = ""; foreach $name ( sort keys %directory ) { $name =~ s/~/ /g; # needs to replace with $FLSEPERATOR $contactMenu .= "Press " . ++$menuPos . " to select $name. "; $escapeDigits .= "$menuPos"; } # foreach $name $AGI->verbose( "$SUBNAME: <$escapeDigits>$contactMenu ", 1); my $dtmfInput = 0; while( $dtmfInput == 0 ) { $dtmfInput = $AGI->stream_file( getTTSFilename( "$contactMenu" ), "$escapeDigits" ); ( $dtmfInput > 0 ) or $dtmfInput = $AGI->stream_file( getTTSFilename( "Press star to exit"), "$escapeDigits" ); } # while if( $dtmfInput < 0 ) { # ERROR! $mode = $MODE_EXIT; } else { $inputKey = chr( $dtmfInput ); $AGI->verbose( "$SUBNAME: inputKey = <$inputKey>", 1 ); if( $inputKey ne "*" ) { $menuPos = 0; foreach $name ( sort keys %directory ) { if( ++$menuPos != $inputKey ) { delete $directory{ $name }; $hitCnt--; #print "deleting $name ht:$hitCnt mp:$menuPos \n"; } } # foreach $name } # if( $inputKey ne "*" } # if( $dtmfInput < 0 } # if( $hitCnt #print $hitCnt; return $mode, $hitCnt; } # sub cmdSelectContactFromMenu ################################################################################ # sub cmdUndoLastSearch { ################################################################################ sub cmdUndoLastSearch { my( $searchstrOrig, $mode, $hitCnt, $searchstr ) = @_; my $SUBNAME = "cmdUndoLastSerach"; my $lastInput = ""; my $tmpSearchStrOrig = ""; $AGI->verbose( "$SUBNAME: Entering", 1 ); if( $searchstrOrig ) { # Reset hit count and search str as we will build this from the updated original search str $hitCnt = 0; $searchstr = ""; # Get last input $lastInput = substr( $searchstrOrig, length( $searchstrOrig ) - 1, 1); $AGI->verbose( "$SUBNAME: lastInput <$lastInput>", 1 ); # Chop last input off the end - could us chop() chop( $searchstrOrig ); $AGI->verbose( "$SUBNAME: searchstrOrig <$searchstrOrig>", 1 ); # Overwrite re-init directory, should be okay to overwrite my $key = ""; foreach $key ( keys %directoryOrig ) { $directory{ $key } = $directoryOrig{ $key }; $hitCnt++; } # Reprocess search # We have to mess with the mode here as we are in command mode but need to be in # search mode for the call to perform search - not nice ( $mode, $hitCnt, $searchstr, $searchStrOrig ) = performSearch( $searchstrOrig, "$MODE_SEARCHING", $hitCnt, $searchstr, "" ); $mode = $MODE_COMMAND; $AGI->stream_file( getTTSFilename( "Last search input, $lastInput, undone" ) ); } else { $AGI->stream_file( getTTSFilename( "Search input empty, nothing to undo." ) ); } # if( $searchstrOrig return $searchstrOrig, $mode, $hitCnt, $searchstr; } # sub cmdUndoLastSearch ################################################################################ # sub cmdReviewSearch ################################################################################ sub cmdReviewSearch { my( $searchstrOrig ) = @_; my $SUBNAME = "cmdReviewSerach"; $AGI->verbose( "$SUBNAME: Entering", 1 ); if( $searchstrOrig ) { $AGI->stream_file( getTTSFilename( "Search input entered so far is $searchstrOrig. " ) ); } else { $AGI->stream_file( getTTSFilename( "Search input empty." ) ); } # if( $searchstrOrig return $searchstrOrig, $mode, $hitCnt, $searchstr; } # sub cmdReviewSearch ################################################################################ # processTargetNumber { ################################################################################ sub processTargetNumber { my( $mode, $targetName, $targetNumber ) = @_; my $SUBNAME = "processTargetNumber"; $AGI->verbose( "$SUBNAME: Entering", 1 ); $AGI->verbose( "$SUBNAME: Target number before cleanup <$targetNumber>", 1 ); # expect number in format or similar # - $INTLDAILINGCODE (area-code) local-number # - $NATIONALDAILINGCODE area-code local-number # - local number $targetNumber =~ s/\s//g; $targetNumber =~ s/$INTLCOUNTRYCODE/$NATIONALDAILINGCODE/; $targetNumber =~ s/\+/$INTLDAILINGCODE/; $targetNumber =~ s/\D//g; $AGI->verbose( "$SUBNAME: Target number after cleanup <$targetNumber>", 1 ); $AGI->verbose( "$SUBNAME: Dialing $targetName on ($targetNumber)", 1 ); $AGI->stream_file( getTTSFilename( "Dialing $targetName on $targetNumber" ) ); $AGI->set_variable( 'DIRNUMBER', "$targetNumber" ); return $mode; } # sub processTargetNumber ############################################################################### # Main ############################################################################### # # Initialise Asterisk AGI # $AGI = new Asterisk::AGI; %input = $AGI->ReadParse(); ;foreach $i (sort keys %input) { ; $AGI->verbose( " -- $i = $input{ $i }", 4 ); ;} # # Load the phone direcotry # my $directoryName = $ARGV[0]; $hitCnt = loadFile( $DIRECTORYDIR, $FLSEPERATOR, $directoryName ); if( $hitCnt == 0 ) { $mode = $MODE_EXIT; $AGI->verbose( "There was a problem opening the directory", 1); $AGI->stream_file( getTTSFilename( "There was a problem opening the directory" )); $AGI->stream_file( getTTSFilename( "Please contact the system administrator" )); } # # Enter the main processing loop # while(( $mode eq $MODE_SEARCHING ) || ( $mode eq $MODE_COMMAND ) ) { # Return dynamic menu my $inputKey = ""; my $validInput = ""; # False if( $mode eq $MODE_SEARCHING ) { $AGI->verbose( "$SUBNAME: Search Mode", 1); # $AGI->stream_file( getTTSFilename( "$hitCnt contacts listed" ) ); if( $hitCnt == 0) { $inputKey = $AGI->get_data( getTTSFilename( "Zero contacts listed. Press the star key to access the undo last search input function" )); } else { $inputKey = $AGI->get_data( getTTSFilename( "$hitCnt contacts listed. Spell out the name of the contact by pressing the numbers corresponding to the letters, press 0 to skip to the last name, press 1 to match any letter. Press star for more options" )); } if( $inputKey == -1 ) { # ERROR! $mode = $MODE_EXIT; } elsif( $inputKey ne "" ) { $validInput = ! $validInput; # True } if( $validInput ) { # Process the input $validInput = ""; # Reset to False ( $mode, $hitCnt, $searchstr, $searchstrOrig ) = performSearch( $inputKey, $mode, $hitCnt, $searchstr, $searchstrOrig ); } # if( $validInput } else { #MODE_COMMAND $AGI->verbose( "$SUBNAME: Command Mode", 1); $inputKey = $AGI->get_data( getTTSFilename( "Press 1 to list contacts. " . "Press 2 to undo last search input. " . "Press 3 to review search input. " . "Press 9 to continue searching. " . "Press star to exit. " ), 2000, 1 ); if( $inputKey == -1 ) { # ERROR! $mode = $MODE_EXIT; } elsif( $inputKey ne "" ) { $validInput = ! $validInput; # True } if( $validInput ) { # Process the input $validInput = ""; # Reset to False switch: { if( $inputKey eq "*" ) { $mode = $MODE_EXIT; last switch} if( $inputKey == 1 ) { ( $mode, $hitCnt ) = cmdSelectContactFromMenu( $mode, $hitCnt ); last switch} if( $inputKey == 2 ) { ( $searchstrOrig, $mode, $hitCnt, $searchstr ) = cmdUndoLastSearch( $searchstrOrig, $mode, $hitCnt, $searchstr ); last switch} if( $inputKey == 3 ) { cmdReviewSearch( $searchstrOrig ); last switch} if( $inputKey == 9 ) { $mode = $MODE_SEARCHING; last switch} } # switch } # if( $validInput } # if( $mode eq $MODE_SEARCHING if(( $mode eq $MODE_SEARCHING ) || ( $mode eq $MODE_COMMAND ) ){ # Check if we found what we want or nothing left if( $hitCnt == 1 ) { $mode = $MODE_FOUND; } } } # while( if( $mode eq $MODE_FOUND ) { # # Determine number to dial # my $targetName = ""; my $targetNumber = ""; my @targetNumbers; # Get array of possible numbers to dial, should only be one contact to take my $name = ""; foreach $name ( keys %directory ) { $targetName = $name; $targetName =~ s/~/ /g; #need to replace with FLSEPERATOR ( @targetNumbers ) = split /\t/, $directory{ $name }, 9; } # foreach $name # Match the numbers to the number labels in case we need to prompt my $numberPosCnt = 0; my @numberMenu = (); my $escapeDigits = "*"; my $number = ""; foreach $number ( @targetNumbers ) { $numberPosCnt++; if( $number ne "" ) { # Create a menu entry $targetNumber = $number; $escapeDigits .= "$numberPosCnt"; $numberMenu[ @numberMenu ] = "Press $numberPosCnt to dial $numberLabels[ $numberPosCnt - 1 ]. "; } } #foreach $number $numberMenu[ @numberMenu ] = "Press * to exit. "; $AGI->verbose( "$SUBNAME: numberMenu <@numberMenu>", 1); if( @numberMenu > 2 ) { # Multiple numbers, prompt $mode = $MODE_SEARCHING; my $digit = 0; while( $mode eq $MODE_SEARCHING ) { # keep prompting till we get valid input my $dfmtInput = 0; my $prompt = ""; $AGI->stream_file( getTTSFilename( "$targetName has multiple numbers listed. " ) ); foreach $prompt ( @numberMenu ) { # cycle through the prompts ($dtmfInput > 1 ) or $dtmfInput = $AGI->stream_file( getTTSFilename( "$prompt" ), "$escapeDigits" ); $AGI->verbose( "$SUBNAME: Chosen number<$dtmfInput>", 1 ); } # foreach if( $dtmfInput < 0 ) { # ERROR! $mode = $MODE_EXIT; } elsif( $dtmfInput > 0 ) { # valid input $mode = $MODE_FOUND; $digit = chr( $dtmfInput ); } } # while if( $digit eq "*" ) { $mode = $MODE_EXIT; } else { $targetNumber = $targetNumbers[ $digit - 1 ]; } } # if( @numberMenu if( $mode eq $MODE_FOUND ) { $mode = processTargetNumber( $mode, $targetName, $targetNumber ); } } #( $mode eq $MODE_FOUND asterisk-perl-1.08/examples/agi-enum.agi0000755000175000017500000001014212736552564021023 0ustar cgonzalezcgonzalez#!/usr/bin/perl # # Script performs NAPTR lookups on E164 phone numbers # # Written by: James Golovich # # # Called like exten => _1NXXNXXXXXX,1,AGI,agi-enum.agi|enum.example.com # # Sample bind9 entries #this example uses the replacement field: #4.3.2.1.5.5.5.0.0.8.1 IN NAPTR 100 100 "u" "E2U+iax" . iax:testing.example.com. #the Dialed string would be IAX/testing.example.com # #this example uses the regexp field: #4.3.2.1.5.5.5.0.0.8.1 IN NAPTR 250 100 "u" "E2U+tel" "!^(.*)$!tel:\\1!" . #the Dialed string would be Zap/g2/18005551234 # #this example uses the regexp field to strip off the leading 1: #4.3.2.1.5.5.5.0.0.8.1 IN NAPTR 150 100 "u" "E2U+sip" "!^1(.*)$!sip:\\1@testing.example.com!" . #the Dialed string would be SIP/8005551234@testing.example.com # use Asterisk::AGI; use Net::DNS; #DEFAULTDOMAIN is the default domain to append to lookups that don't include a domain $DEFAULTDOMAIN = 'enum.example.com'; #DEFAULTTIMEOUT is the timeout seconds passed to the Dial app to wait for each call $DEFAULTTIMEOUT = 25; #SET ALLOWPSTN to allow tel: entries to be converted to Zap dialstrings. Default is disabled # Be Careful with this, it will dial whatever is passed in the entry #$ALLOWPSTN = 1; #DEFAULTPSTN is the prefix to be added to tel: entries $DEFAULTPSTN = 'Zap/g2'; @PROTOCOLS = ( 'iax', 'sip', 'tel' # 'h323' ); $AGI = new Asterisk::AGI; my %input = $AGI->ReadParse(); my $num = $input{'extension'}; if (!$num) { exit; } if ($ARGV[0] =~ /([\w\-\.]+)/) { $domain = $1; } else { $domain = $DEFAULTDOMAIN; } @test = naptr_query($num, $domain); for $x ( 0 .. $#test ) { if ($aref = $test[$x]) { $y = @$aref - 1; for $z ( 0 .. $y ) { if ($test[$x][$z]) { if ($res = place_call($test[$x][$z])) { exit $res; } } } } } sub place_call { my ($location) = @_; my $res = 0; my $option = ''; if ($location =~ /sip:(.*)/i) { $option = 'SIP/' . $1; } elsif ($location =~ /iax:(.*)/i) { $option = 'IAX/' . $1; } elsif ($location =~ /h323:(.*)/i) { $option = 'H323/' . $1; } elsif ($ALLOWPSTN && $location =~ /tel:(.*)/i) { my $telnum = $1; #strip all non-numeric $telnum =~ s/[^0-9]//g; $option = $DEFAULTPSTN . '/' . $telnum; } if ($option) { $option .= '|' . $DEFAULTTIMEOUT if ($DEFAULTTIMEOUT); $AGI->verbose("Executing Dial $option\n",3); $res = $AGI->exec('Dial', $option); } return $res; } sub naptr_query { my ($lookup, $domain) = @_; my $dns = Net::DNS::Resolver->new; my $name = reversenum($lookup) . '.' . $domain; $query = $dns->search($name, 'NAPTR'); if ($query) { foreach $rr ($query->answer) { next unless $rr->type eq "NAPTR"; my $order = $rr->order; my $pref = $rr->preference; if ($rr->flags !~ /u/i) { next; } foreach $svct (split(/\+/,$rr->service)) { next if ($svct =~ /E2U/i); next if (!validprotocol($svct)); } if ($rr->replacement) { $host = naptr_replace($rr->replacement, $rr->regexp, $lookup); } else { $host = naptr_regexp($rr->regexp, $lookup); } $hosts[$order][$pref] = $host; } } return @hosts; } sub naptr_replace { my ($replace, $regex, $number) = @_; return $replace; } sub naptr_regexp { my ($string, $number) = @_; my $regex = ''; my $data = ''; if ($string =~ /^(.).*(.)$/) { $delim = $1 if ($1 eq $2); } else { return ''; } if ($string =~ /$delim(.*)$delim(.*)$delim/) { $regex = $1; $data = $2; if ($regex) { if ($number =~ /$regex/) { if ($t = $1) { $data =~ s/\\1/$t/g; } if ($t = $2) { $data =~ s/\\2/$t/g; } if ($t = $3) { $data =~ s/\\3/$t/g; } if ($t = $4) { $data =~ s/\\4/$t/g; } if ($t = $5) { $data =~ s/\\5/$t/g; } if ($t = $6) { $data =~ s/\\6/$t/g; } if ($t = $7) { $data =~ s/\\7/$t/g; } if ($t = $8) { $data =~ s/\\8/$t/g; } if ($t = $9) { $data =~ s/\\9/$t/g; } } } } return $data; } sub reversenum { my ($num) = @_; #remove all non numeric $num =~ s/[^0-9]//g; return join('.', split(/ */, reverse($num))); } sub validprotocol { my ($prot) = @_; my $valid = 0; foreach (@PROTOCOLS) { if (m/$prot/i) { $valid = 1; } } return $valid; } asterisk-perl-1.08/examples/tts-bofh.agi0000755000175000017500000000123712736552564021054 0ustar cgonzalezcgonzalez#!/usr/bin/perl # # AGI Example that picks a random bofh excuse from the fortune database # and sends it to Festival (text to speech processor) # # This script also requires the Fortune perl module # # Written by: James Golovich # use Asterisk::AGI; use Fortune; $AGI = new Asterisk::AGI; my %input = $AGI->ReadParse(); my $base_filename = '/usr/share/games/fortunes/bofh-excuses'; $ffile = new Fortune ($base_filename); $ffile->read_header (); $fortune = '"' . $ffile->get_random_fortune () . '"'; $fortune =~ s/\n/ /g; $fortune =~ s/BOFH excuse \#(\d*):/Bastard Operator From Hell Excuse Number $1:,., /; $AGI->exec('Festival', $fortune); asterisk-perl-1.08/examples/tts-ping.agi0000755000175000017500000000217612736552564021076 0ustar cgonzalezcgonzalez#!/usr/bin/perl # # AGI Script that prompts the user for an ip address, pings the ip, and reports back to the user. # # Requires the Asterisk::AGI and Net::Ping::External perl modules # # Written by: James Golovich # # use Asterisk::AGI; use Net::Ping::External qw(ping); $AGI = new Asterisk::AGI; my %input = $AGI->ReadParse(); my $finished = 0; $AGI->exec('Festival', '"Enter the eye-p address you wish to ping."'); my $ipaddr = ''; my $x = 0; while (!$finished) { my $input = chr($AGI->wait_for_digit('5000')); if ($input =~ /^[0-9\*\#]$/) { if ($input =~ /^[\*\#]$/) { $x++; if ($x > 3) { $finished = 1; } else { $ipaddr .= '.'; } } else { $ipaddr .= $input; } } else { #must have timed out $finished = 1; } if ( length($ipaddr) > 14) { $finished = 1; } } if ($ipaddr !~ /\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}/) { $AGI->exec('Festival', "\"Invalid Address: $ipaddr\""); exit 0; } $AGI->exec('Festival', '"Please wait"'); if (ping(host => "$ipaddr", timeout => 2)) { $AGI->exec('Festival', '"Host is up"'); } else { $AGI->exec('Festival', '"Host is down"'); } asterisk-perl-1.08/examples/vm-cleanup.pl0000755000175000017500000000025512736552564021247 0ustar cgonzalezcgonzalez#!/usr/bin/perl # # Application to run daily (from cron) to cleanup old voicemail messages # # Written by: James Golovich # use Asterisk::Voicemail; asterisk-perl-1.08/examples/manager-test.pl0000755000175000017500000000170212736552564021565 0ustar cgonzalezcgonzalez#!/usr/bin/perl # # Example script to show how to use Asterisk::Manager # # Written by: James Golovich # # use lib './lib', '../lib'; use Asterisk::Manager; $|++; my $astman = new Asterisk::Manager; $astman->user('test'); $astman->secret('test'); $astman->host('duff'); $astman->connect || die $astman->error . "\n"; $astman->setcallback('Hangup', \&hangup_callback); $astman->setcallback('DEFAULT', \&default_callback); #print STDERR $astman->command('zap show channels'); print STDERR $astman->sendcommand( Action => 'IAXPeers'); #print STDERR $astman->sendcommand( Action => 'Originate', # Channel => 'Zap/7', # Exten => '500', # Context => 'default', # Priority => '1' ); $astman->eventloop; $astman->disconnect; sub hangup_callback { print STDERR "hangup callback\n"; } sub default_callback { my (%stuff) = @_; foreach (keys %stuff) { print STDERR "$_: ". $stuff{$_} . "\n"; } print STDERR "\n"; } asterisk-perl-1.08/examples/calleridnamelookup.agi0000755000175000017500000001432312736552564023200 0ustar cgonzalezcgonzalez#!/usr/bin/perl # # Use Reverse Number Database on the net to add name to callerid info # Currently only tries to query 411.com and anywho.com, but other lookups can # be added easily # If your callerid is only passed as a 7 digit number, # you can pass this script an argument with the default area code # # extensions.conf example: # exten => s,1,AGI,calleridnamelookup.agi # exten => s,2,Dial,Zap,1 # # Written by: James Golovich # Updated by: Jeff Siddall use Asterisk::AGI; use LWP::UserAgent; # Set $CACHELOOKUPS to 1 to cachelookups locally, default is enabled $CACHELOOKUPS = 1; # You must create this directory if you enable $CACHELOOKUPS, or caching will fail $CACHEDIR = '/var/spool/asterisk/calleridlookups'; # TIMEOUT is maximum number of seconds for http requests (we don't want to take too long) $TIMEOUT = 3; $VERSION = '0.03'; $AGI = new Asterisk::AGI; my %input = $AGI->ReadParse(); my $callerid = $input{'callerid'}; my $calleridname = $input{'calleridname'}; # Exit quickly unless the callerid number is the right length and the calleridname is empty or contains the word private or unknown # Skip the name lookup if the caller ID number is not 7, 10, or 11 digits long if (!(($callerid =~ /\d{7}/) || ($callerid =~ /\d{10}/) || ($callerid =~ /\d{11}/))) { $AGI->exec('Set', "CALLERID(name)=\"Invalid Number\""); exit(0); } # Skip the name lookup if the caller ID name is not unknown or private (ie: it is already valid) elsif (!(($calleridname =~ /private/i) || ($calleridname =~ /unknown/i) || (!$calleridname))) { exit(0); } $defaultnpa = $ARGV[0] if (defined($ARGV[0])); # Remove everything non numeric from callerid string $callerid =~ s/[^\d]//g; if (($callerid =~ /^(\d{3})(\d{3})(\d{4})$/) || ($callerid =~ /^1(\d{3})(\d{3})(\d{4})$/)) { $npa = $1; $nxx = $2; $station = $3; } elsif (defined($defaultnpa) && ($callerid =~ /^(\d{3})(\d{4})$/)) { $npa = $defaultnpa; $nxx = $1; $station = $2; } else { exit(0); } if ($name = lookup($npa, $nxx, $station)) { # Only modify the calleridname portion (leave the number unchanged) $AGI->exec('Set', "CALLERID(name)=\"$name\""); } else { $AGI->exec('Set', "CALLERID(name)=\"Name Lookup Failed\""); } exit(0); sub lookup { my $name = ''; if ($name = cache_lookup(@_)) { return $name; # Add other lookups here, always keep best db first in list # Use 411.com first since it looks up Canadian and US numbers, and will report the caller's area even if the number is unlisted } elsif ($name = www411_lookup(@_)) { } elsif ($name = anywho_lookup(@_)) { } # Cache only lookups that don't timeout, are not null, and haven't failed if (($name ne "") && ($name ne 'Name Server Timeout') && ($name ne 'Name Lookup Failed')) { my $result = cacheadd($npa, $nxx, $station, $name); } return $name; } sub cacheadd { my ($npa, $nxx, $station, $name) = @_; return 0 if (!$CACHELOOKUPS); open(CACHE, ">$CACHEDIR/$npa$nxx$station") || return 0; print CACHE "$name\n"; close(CACHE) || return 0; return 1; } sub cache_lookup { my ($npa, $nxx, $station) = @_; return 0 if (!$CACHELOOKUPS); my $name = ''; open(CACHE, "<$CACHEDIR/$npa$nxx$station") || return ''; $name = ; chomp($name); close(CACHE); # Must be a negatively cached result so just add a blank space so it will pass the other tests $name = ' ' if ($name eq ''); return $name; } sub anywho_lookup { my ($npa, $nxx, $station) = @_; my $ua = LWP::UserAgent->new( timeout => $TIMEOUT); my $URL = 'http://www.anywho.com/qry/wp_rl'; $URL .= '?npa=' . $npa . '&telephone=' . $nxx . $station; $ua->agent('AsteriskAGIQuery/$VERSION'); my $req = new HTTP::Request GET => $URL; my $res = $ua->request($req); if ($res->is_success()) { if ($res->content =~ /(.*)/s) { my $listing = $1; if ($listing =~ /(.*)<\/B>/) { my $clidname = $1; return $clidname; } } } return ''; } sub www411_lookup { my ($npa, $nxx, $station) = @_; my $ua = LWP::UserAgent->new( timeout => $TIMEOUT); my $URL = "http://www.411.com/search/Reverse_Phone?phone=$npa$nxx$station"; $ua->agent('AsteriskAGIQuery/$VERSION'); my $req = new HTTP::Request GET => $URL; my $res = $ua->request($req); if ($res->is_success()) { # The result may be an unlisted number, but the calling area is returned so show that if ($res->content =~ /based in\s*(.+?)\s*<\/strong>/s) { my $area = $1; # If the name has an '&' character, parse the HTML out $area =~ s/&\;/&/g; # Also parse out %20 and replace with space $area =~ s/%20/ /g; return($area); } # If the number is invalid say that there is no listing elsif ($res->content =~ /Please verify/s) { return('No Listing'); } # If the page returns a first and last name, this RE will grab it, with the first name in $1 and the second in $2 elsif ($res->content =~ /_RM_HTML_FIRST_ESC_=(.+?)\&_RM_HTML_LAST_ESC_=(.+?)\&_RM_HTML_ADDRESS_ESC_=/s) { my $name = "$1 $2"; # If the name has an '&' character, parse the HTML out $name =~ s/&\;/&/g; # Also parse out %20 and replace with space $name =~ s/%20/ /g; # Also parse out escape characters $name =~ s/\\//g; # Since the easy to parse result of the search has case mucked up this will capitalize the first letter of each word $name =~ s/((^\w)|(\s\w))/\U$1/g; return($name); } # If the page returns only a first name or last name, this RE will grab it in $1 elsif ($res->content =~ /_RM_HTML_FIRST_ESC_=(.+?)\&_RM_HTML_LAST_ESC_=/s || $res->content =~ /_RM_HTML_LAST_ESC_=(.+?)\&_RM_HTML_ADDRESS_ESC_=/s) { my $name = $1; # If the name has an '&' character, parse the HTML out $name =~ s/&\;/&/g; # Also parse out %20 and replace with space $name =~ s/%20/ /g; # Also parse out escape characters $name =~ s/\\//g; # Since the easy to parse result of the search has case mucked up this will capitalize the first letter of each word $name =~ s/((^\w)|(\s\w))/\U$1/g; return($name); } # If anything else happens just say "Name Lookup Failed" else { return('Name Lookup Failed'); } } else { return('Name Server Timeout'); } } asterisk-perl-1.08/examples/agi-test.agi0000755000175000017500000000316712736552564021047 0ustar cgonzalezcgonzalez#!/usr/bin/perl # # Simple AGI Application to show some of the features of AGI # # Written by: James Golovich # use Asterisk::AGI; $AGI = new Asterisk::AGI; my %input = $AGI->ReadParse(); my $tests = 0; my $pass = 0; my $fail = 0; #setup callback $AGI->setcallback(\&mycallback); print STDERR "AGI Environment Dump:\n"; foreach $i (sort keys %input) { print STDERR " -- $i = $input{$i}\n"; } print STDERR "1. Testing 'sendfile'..."; score($AGI->stream_file('beep')); print STDERR "2. Testing 'sendtext'..."; score($AGI->send_text('hello world')); print STDERR "3. Testing 'sendimage'..."; score($AGI->send_image('asterisk-image')); print STDERR "4. Testing 'saynumber'..."; score($AGI->say_number('192837465')); print STDERR "5. Testing 'waitdtmf'..."; score($AGI->wait_for_digit(1000)); print STDERR "6. Testing 'record'..."; score($AGI->record_file('testagi', 'gsm', 1234, 300)); print STDERR "6a. Testing 'record' playback..."; score($AGI->stream_file('testagi')); print STDERR "7.. Testing 'exec Dial,IAX/asterisk\@demo'..."; score($AGI->exec('Dial', 'IAX/asterisk@demo')); print STDERR "================== Complete ======================\n"; print STDERR "$tests tests completed, $pass passed, $fail failed\n"; print STDERR "==================================================\n"; sub score { my ($returncode) = @_; $tests++; if ($returncode >=0) { print STDERR "PASS ($returncode)\n"; $pass++; } else { print STDERR "FAIL ($returncode)\n"; $fail++; } } sub mycallback { my ($returncode) = @_; print STDERR "MYCALLBACK: User Hungup ($returncode)\n"; exit($returncode); } asterisk-perl-1.08/examples/tts-line.agi0000755000175000017500000000106712736552564021066 0ustar cgonzalezcgonzalez#!/usr/bin/perl # # AGI Example that reads through a file one line at a time and sends it to # Festival # # Written by: James Golovich # use Asterisk::AGI; $AGI = new Asterisk::AGI; my %input = $AGI->ReadParse(); my $filename = $ARGV[0]; open(TEXT, "<$filename") || die "Cannot open $filename: $!\n"; while ($string = ) { chop($string); # remove any quotes (") because they will screw up the string being passed to festival $string =~ s/\"/ /g; if ($string) { $return = $AGI->exec('Festival', "\"$string\""); } } close(TEXT); asterisk-perl-1.08/examples/agi-sayani.agi0000755000175000017500000000065312736552564021351 0ustar cgonzalezcgonzalez#!/usr/bin/perl # # Simple agi example that says the callerid and/or dnis # # Written by: James Golovich # use Asterisk::AGI; $AGI = new Asterisk::AGI; my %input = $AGI->ReadParse(); if (my $callerid = $input{'callerid'}) { $AGI->stream_file('agi-yourcalleridis'); $AGI->say_digits($callerid); } if (my $dnis = $input{'dnid'}) { $AGI->stream_file('agi-dnisis'); $AGI->say_digits($dnis); } exit; asterisk-perl-1.08/tests/0000755000175000017500000000000012754110634016146 5ustar cgonzalezcgonzalezasterisk-perl-1.08/tests/voicemail.pl0000755000175000017500000000116312736552564020473 0ustar cgonzalezcgonzalez#!/usr/bin/perl use lib './lib', '../lib'; use Asterisk::Voicemail; use Data::Dumper; my $vm = new Asterisk::Voicemail; $vm->readconfig(); $vm->spooldirectory('/tmp/vm'); print "Spool directory: " . $vm->spooldirectory() . "\n"; #($pass, $fn, $email) = $vm->vmbox('1234'); #print "VM $pass $fn $email\n"; #print Dumper $vm; $vm->createdefaultmailbox('9999'); $vm->createdefaultmailbox('1234'); print $vm->validmailbox('9999') . "\n"; print $vm->validmailbox('1234') . "\n"; print $vm->validmailbox('5555') . "\n"; print "COUNT: " . $vm->msgcount('1234','INBOX') . "\n"; print $vm->msgcountstr('1234','INBOX') . "\n"; asterisk-perl-1.08/tests/zapata.pl0000755000175000017500000000304312754101725017767 0ustar cgonzalezcgonzalez#!/usr/bin/perl use lib './lib', '../lib'; use Asterisk::Conf::Zapata; use Data::Dumper; my $zt = new Asterisk::Conf::Zapata; $zt->configfile('/etc/asterisk/zapata.conf'); $zt->readconfig(); $zt->setvariable('channels', '1-23', 'transfer', 'no'); $zt->setvariable('channels', '25', 'callerid', 'TESTINGINTEST'); $zt->setvariable('channels', '25', 'transfer', 'yes'); $zt->setvariable('channels', '25', 'mailbox', '9999'); $zt->setvariable('channels', '29', 'mailbox', '3333'); $zt->setvariable('channels', '29', 'callerid', 'TESTING'); #$zt->deletechannel('channels', '25'); #print STDERR $zt->cgiform('show', 'channels', ( 'channel' => '1-23' ) ); #print STDERR $zt->cgiform('delete', 'channels', ( 'channel' => '1-23' ) ); #print Dumper $zt; print STDERR $zt->cgiform('modify', 'channels', ( 'channel' => '1-23', 'callerid' => 'New Callerid Test', 'OLDcallerid' => 'blah', 'OLDchannel' => '1-23' ) ); print STDERR $zt->cgiform('add', 'channels', ( 'channel' => '97', 'callerid' => 'Blah Blah Blah', 'OLDcallerid' => 'blah', 'OLDchannel' => '97') ); print STDERR $zt->cgiform('modify', 'channels', ( 'channel' => '97', 'transfer' => 'yes', 'OLDchannel' => '97' ) ); print STDERR $zt->cgiform('delete', 'channels', ( 'channel' => '1-23', 'doit' => '1') ); #$zt->writeconfig(); #print STDERR $zt->htmlheader('Channel list'); #print STDERR $zt->cgiform('show', 'channels', ( 'channel' => '1-23' ) ); #print STDERR $zt->cgiform('modifyform', 'channels', ( 'channel' => '1-23' ) ); #print STDERR $zt->cgiform('list', 'channels'); #print STDERR $zt->htmlfooter(); asterisk-perl-1.08/tests/qcall.pl0000755000175000017500000000043412736552564017617 0ustar cgonzalezcgonzalez#!/usr/bin/perl use lib './lib', '../lib'; use Asterisk::QCall; use Data::Dumper; my $queue = new Asterisk::QCall; $mytime = time()+240; $queue->queuetime($mytime); #$queue->queuedir('/tmp/queuetemp'); $queue->create_qcall('Zap/g3/7343418096','5175409674', '8@incomingpri', 0); asterisk-perl-1.08/tests/extensions.pl0000755000175000017500000000064612736552564020727 0ustar cgonzalezcgonzalez#!/usr/bin/perl use lib './lib','../lib'; use Asterisk::Extension; use Data::Dumper; $ext = new Asterisk::Extension; $ext->readconfig('/etc/asterisk/extensions.conf'); my @arr= $ext->getextensionarr('demo','1234'); for (@arr) { $x++; # print "$x $_\n" if ($_); } #$ext->getcontextarr(); print "\n"; #print Dumper $ext; print Dumper $ext->matchextension('local', '559'); $ext->writeconfig('/tmp/test.config'); asterisk-perl-1.08/tests/astman.pl0000755000175000017500000000071212736552564020005 0ustar cgonzalezcgonzalez#!/usr/bin/perl use lib './lib', '../lib'; use Asterisk::Astman; use Data::Dumper; my $astman = new Asterisk::Astman; $astman->readconfig(); print "PORT: " . $astman->port() . "\n"; $astman->user('test'); $astman->secret('test'); $astman->host('localhost'); $astman->connect(); $astman->authenticate(); $astman->setevent( "testcb()"); $astman->managerloop(); #print Dumper $astman; sub testcb { my ($test) = @_; print "TESTCALLBACK $test\n"; } asterisk-perl-1.08/README.md0000644000175000017500000000270012736552564016276 0ustar cgonzalezcgonzalez#Asterisk Perl Modules [![Build Status](https://travis-ci.org/asterisk-perl/asterisk-perl.svg?branch=master)](https://travis-ci.org/asterisk-perl/asterisk-perl)[![Coverage Status](https://coveralls.io/repos/github/asterisk-perl/asterisk-perl/badge.svg?branch=master)](https://coveralls.io/github/asterisk-perl/asterisk-perl?branch=master) by James Golovich These are all modules for interfacing with the Asterisk open source pbx system. The main site for these files is http://asterisk.gnuinter.net, or soon to be found at a CPAN mirror near you. Some documentation is in the the perl modules, use perldoc to read it (example: perldoc Asterisk::AGI) To install these modules just do: perl Makefile.PL make all make install Examples that use these modules can be found in the examples/ directory Here is a short description of what each does: agi-sayani.agi: AGI Script that says the callerid and dnis agi-test.agi: Rewrite of AGI Example included with asterisk calleridnamelookup.agi: AGI Script that uses an online reverse number databases to add a name to callerid tts-bofh.agi: AGI script that uses Festival to give a random bofh excuse tts-ping.agi: AGI script that pings an ip address and notifies the user if the host is up or down tts-line.agi: AGI script that uses Festival to read a text file one line at a time manager-test.pl: Example usage of the Asterisk::Manager module Asterisk can be found at http://www.asterisk.org asterisk-perl-1.08/.travis.yml0000644000175000017500000000144012736552564017130 0ustar cgonzalezcgonzalezlanguage: perl perl: - "5.8" # normal preinstalled perl - "5.8.4" # downloads a pre-built 5.8.4 - "5.8.4-thr" # pre-built 5.8.4 with threading - "5.12.2" # builds perl 5.12.2 from source (pre-built not available) - "5.20" # installs latest perl 5.20 (if not already available) - "dev" # installs latest developer release of perl (e.g. 5.21.8) - "blead" # builds perl from git matrix: include: - perl: 5.18 env: COVERAGE=1 # enables coverage+coveralls reporting allow_failures: - perl: blead # ignore failures for blead perl sudo: false # faster builds as long as you don't need sudo access before_install: - eval $(curl https://travis-perl.github.io/init) --autoasterisk-perl-1.08/META.json0000664000175000017500000000230512754110634016427 0ustar cgonzalezcgonzalez{ "abstract" : "Asterisk Perl Interface", "author" : [ "James Golovich " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 7.1001, CPAN::Meta::Converter version 2.150005", "license" : [ "unknown" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "asterisk-perl", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "Digest::MD5" : "0", "IO::Socket" : "0", "Net::Telnet" : "0" } } }, "release_status" : "stable", "resources" : { "repository" : { "type" : "git", "url" : "https://github.com/asterisk-perl/asterisk-perl.git", "web" : "https://github.com/asterisk-perl/asterisk-perl" } }, "version" : "1.08", "x_serialization_backend" : "JSON::PP version 2.27300" } asterisk-perl-1.08/LICENSE0000644000175000017500000001373712736552564016040 0ustar cgonzalezcgonzalez The "Artistic License" Preamble The intent of this document is to state the conditions under which a Package may be copied, such that the Copyright Holder maintains some semblance of artistic control over the development of the package, while giving the users of the package the right to use and distribute the Package in a more-or-less customary fashion, plus the right to make reasonable modifications. Definitions: "Package" refers to the collection of files distributed by the Copyright Holder, and derivatives of that collection of files created through textual modification. "Standard Version" refers to such a Package if it has not been modified, or has been modified in accordance with the wishes of the Copyright Holder as specified below. "Copyright Holder" is whoever is named in the copyright or copyrights for the package. "You" is you, if you're thinking about copying or distributing this Package. "Reasonable copying fee" is whatever you can justify on the basis of media cost, duplication charges, time of people involved, and so on. (You will not be required to justify it to the Copyright Holder, but only to the computing community at large as a market that must bear the fee.) "Freely Available" means that no fee is charged for the item itself, though there may be fees involved in handling the item. It also means that recipients of the item may redistribute it under the same conditions they received it. 1. You may make and give away verbatim copies of the source form of the Standard Version of this Package without restriction, provided that you duplicate all of the original copyright notices and associated disclaimers. 2. You may apply bug fixes, portability fixes and other modifications derived from the Public Domain or from the Copyright Holder. A Package modified in such a way shall still be considered the Standard Version. 3. You may otherwise modify your copy of this Package in any way, provided that you insert a prominent notice in each changed file stating how and when you changed that file, and provided that you do at least ONE of the following: a) place your modifications in the Public Domain or otherwise make them Freely Available, such as by posting said modifications to Usenet or an equivalent medium, or placing the modifications on a major archive site such as uunet.uu.net, or by allowing the Copyright Holder to include your modifications in the Standard Version of the Package. b) use the modified Package only within your corporation or organization. c) rename any non-standard executables so the names do not conflict with standard executables, which must also be provided, and provide a separate manual page for each non-standard executable that clearly documents how it differs from the Standard Version. d) make other distribution arrangements with the Copyright Holder. 4. You may distribute the programs of this Package in object code or executable form, provided that you do at least ONE of the following: a) distribute a Standard Version of the executables and library files, together with instructions (in the manual page or equivalent) on where to get the Standard Version. b) accompany the distribution with the machine-readable source of the Package with your modifications. c) give non-standard executables non-standard names, and clearly document the differences in manual pages (or equivalent), together with instructions on where to get the Standard Version. d) make other distribution arrangements with the Copyright Holder. 5. You may charge a reasonable copying fee for any distribution of this Package. You may charge any fee you choose for support of this Package. You may not charge a fee for this Package itself. However, you may distribute this Package in aggregate with other (possibly commercial) programs as part of a larger (possibly commercial) software distribution provided that you do not advertise this Package as a product of your own. You may embed this Package's interpreter within an executable of yours (by linking); this shall be construed as a mere form of aggregation, provided that the complete Standard Version of the interpreter is so embedded. 6. The scripts and library files supplied as input to or produced as output from the programs of this Package do not automatically fall under the copyright of this Package, but belong to whoever generated them, and may be sold commercially, and may be aggregated with this Package. If such scripts or library files are aggregated with this Package via the so-called "undump" or "unexec" methods of producing a binary executable image, then distribution of such an image shall neither be construed as a distribution of this Package nor shall it fall under the restrictions of Paragraphs 3 and 4, provided that you do not represent such an executable image as a Standard Version of this Package. 7. C subroutines (or comparably compiled subroutines in other languages) supplied by you and linked into this Package in order to emulate subroutines and variables of the language defined by this Package shall not be considered part of this Package, but are the equivalent of input as in Paragraph 6, provided these subroutines do not change the language in any way that would cause it to fail the regression tests for the language. 8. Aggregation of this Package with a commercial distribution is always permitted provided that the use of this Package is embedded; that is, when no overt attempt is made to make this Package's interfaces visible to the end user of the commercial distribution. Such use shall not be construed as a distribution of this Package. 9. The name of the Copyright Holder may not be used to endorse or promote products derived from this software without specific prior written permission. 10. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. The End asterisk-perl-1.08/MANIFEST.SKIP0000644000175000017500000000046312736552564016721 0ustar cgonzalezcgonzalez^blib/ ^Makefile$ ^Makefile\.[a-z]+$ ^pm_to_blib$ CVS/.* ,v$ ^tmp/ \.old$ \.bak$ \.tmp$ \.swp$ ~$ ^# \.shar$ \.tar$ \.tgz$ \.tar\.gz$ \.zip$ \.DS_Store$ _uu$ \.svn cover_db/ coverage/ html/ learn/ research/ superseded/ svndiff/ ^Todo ^.cvsignore ^init ^results ^htmlify .git/ ^MYMETA.* nytprof/ nytprof.out asterisk-perl-1.08/Makefile.PL0000644000175000017500000000140312747443321016760 0ustar cgonzalezcgonzalezuse ExtUtils::MakeMaker; my $mm_ver = ExtUtils::MakeMaker->VERSION; WriteMakefile ( NAME => 'asterisk-perl', AUTHOR => 'James Golovich ', VERSION_FROM => 'lib/Asterisk.pm', ABSTRACT => 'Asterisk Perl Interface', PREREQ_PM => { 'IO::Socket' => 0, 'Digest::MD5' => 0, 'Net::Telnet' => 0 }, ($mm_ver < 6.46 ? () : (META_MERGE => { 'meta-spec' => { version => 2}, dynamic_config => 1, resources => { repository => { type => 'git', url => 'https://github.com/asterisk-perl/asterisk-perl.git', web => 'https://github.com/asterisk-perl/asterisk-perl' }, }, })), ); 1; asterisk-perl-1.08/lib/0000755000175000017500000000000012754110634015552 5ustar cgonzalezcgonzalezasterisk-perl-1.08/lib/Asterisk.pm0000644000175000017500000000064312754110562017700 0ustar cgonzalezcgonzalez# # $Id$ # package Asterisk; require 5.004; use vars qw($VERSION); $VERSION = '1.08'; sub version { $VERSION; } sub new { my ($class, %args) = @_; my $self = {}; $self->{configfile} = undef; $self->{config} = {}; bless $self, ref $class || $class; return $self; } sub DESTROY { } package asterisk::perl; =head1 NAME asterisk::perl This module exists solely to satisfy packaging requirements. =cut 1; asterisk-perl-1.08/lib/Asterisk/0000755000175000017500000000000012754110634017337 5ustar cgonzalezcgonzalezasterisk-perl-1.08/lib/Asterisk/Conf.pm0000644000175000017500000002144712754101725020573 0ustar cgonzalezcgonzalezpackage Asterisk::Conf; require 5.004; use Asterisk; $VERSION = '0.01'; $MULTISEP = ','; sub version { $VERSION; } sub new { my ($class, %args) = @_; my $self = {}; $self->{configfile} = undef; $self->{config} = {}; $self->{commit} = 0; $self->{'contextorder'} = (); $self->{'variables'} = {}; bless $self, ref $class || $class; return $self; } sub DESTROY { } sub configfile { my($self, $configfile) = @_; if (defined($configfile)) { $self->{'configfile'} = $configfile; } return $self->{'configfile'}; } sub _setvar { my ($self, $context, $var, $val, $order, $precomment, $postcomment) = @_; if (defined($self->{config}{$context}{$var}{val}) && ($self->{'variables'}{$var}{type} =~ /^multi/)) { $self->{config}{$context}{$var}{val} .= $MULTISEP . $val; } else { $self->{config}{$context}{$var}{val} = $val; $self->{config}{$context}{$var}{precomment} = $precomment; $self->{config}{$context}{$var}{postcomment} = $postcomment; $self->{config}{$context}{$var}{order} = $order; } } sub _addcontext { my ($self, $context, $order) = @_; if (!defined($order)) { $order = ($#{$self->{contextorder}} + 1); } $self->{contextorder}[$order] = $context; } sub _contextorder { my ($self) = @_; return @{$self->{contextorder}}; } sub readconfig { my ($self) = @_; my $context = ''; my $line = ''; my $precomment = ''; my $postcomment = ''; my $configfile = $self->configfile(); my $order = 0; my $contextorder =0; open(CF,"<$configfile") || die "Error loading $configfile: $!\n"; while ($line = ) { # chop($line); if ($line =~ /^;/) { $precomment .= $line; next; } elsif ($line =~ /(;.*)$/) { $postcomment .= $1; $line =~ s/;.*$//; } elsif ($line =~ /^\s*$/) { $precomment = ''; $postcomment = ''; next; } chop($line); $line =~ s/\s*$//; if ($line =~ /^\[(\w+)\]$/) { $context = $1; $self->_addcontext($context, $contextorder); $contextorder++; } elsif ($line =~ /^(\w+)\s*[=>]+\s*(.*)/) { $self->_setvar($context, $1, $2, $order, $precomment, $postcomment); $precomment = ''; $postcomment = ''; $order++; } else { print STDERR "Unknown line: $line\n" if ($DEBUG); } } close(CF); return %config; } sub rewriteconfig { my ($self) = @_; my $file = $self->{'configfile'}; my $fh; open($fh, ">$file") || print "
OPEN FILE ERROR ($file) $!\n"; $self->writeconfig($fh); close($fh); } sub writeconfig { my ($self, $fh) = @_; if (!$fh) { $fh = \*STDERR; } foreach $context ($self->_contextorder) { next if (!defined($self->{config}{$context})); print $fh "[$context]\n"; foreach $key (keys %{$self->{config}{$context}}) { next if (!$self->{config}{$context}{$key}{val}); print $fh $self->{config}{$context}{$key}{precomment}; my $val = $self->{config}{$context}{$key}{val}; if ($self->{'variables'}{$key}{type} =~ /^multi/) { foreach (split(/$MULTISEP/, $val)) { print $fh "$key => $_\n"; } } else { print $fh "$key => " . $val . "\n"; } } print $fh "\n"; } } sub setvariable { my ($self, $context, $var, $val) = @_; $self->{config}{$context}{$var}{val} = $val; $self->{config}{$context}{$var}{postcomment} = ";Modified by Asterisk::Config::$self->{'name'}\n"; } sub variablecheck { my ($self, $context, $variable, $value) = @_; my $ret = 0; my $regex = $self->{'variables'}{$variables}{'regex'}; if (my $type = $self->{'variables'}{$variable}{'type'}) { if ($type =~ /^multitext$/) { foreach $multiv (split($MULTISEP, $value)) { if ($multiv =~ /$regex/) { $ret = 1; } } } elsif ($type =~ /text$/) { if ($value =~ /$regex/) { $ret = 1; } } elsif ($type eq 'one') { foreach $item (@{$self->{'variables'}{$variable}{'values'}}) { if ($item eq $value) { $ret = 1; } } } } return $ret; } sub cgiform { my ($self, $action, $context, %vars) = @_; #valid actions: show, list, add, addform, modify, modifyform, delete, deleteform my $html = ''; my $module = $self->{'name'}; my $URL = $ENV{'SCRIPT_NAME'}; $html .= "\n"; if (!$action) { $action = 'list'; } if (!$context && $action ne 'list') { $html .= "

Context must be specified\n"; return $html; } #if this is an addform we need to ask for the contextname if ($action =~ /(.*)form$/) { $html .= "

\n"; $html .= "\n"; $html .= "\n"; $html .= "\n"; } if ($action eq 'list') { foreach $context (@{$self->{'contextorder'}}) { $html .= "Context $context\n"; } } if ($action eq 'deleteform') { $html .= "
Are you sure you want to delete context $context?\n"; $html .= "
Confirm\n"; } elsif ($action eq 'delete') { if ($vars{'doit'} == 1 && $self->deletecontext($context)) { $html .= "
Context $context has been deleted\n"; $self->{'commit'} = 1; } else { $html .= "
Unable to delete context $context\n"; } } elsif ($action eq 'show' || $action =~ /^modify/ || $action =~ /^add/ ) { if ($action eq 'add') { $self->_addcontext($context); $self->{'commit'} = 1; } elsif ($action eq 'show') { $html .= "Add new\n"; $html .= "Modify\n"; $html .= "Delete\n"; } foreach $var ( sort keys %{$self->{'variables'}} ) { my $value = ''; #the logic here seems backwards, but trust me its right if (my $regex = $self->{'variables'}{$var}{'contextregex'}) { if ($context !~ /$regex/) { next; } } if (my $regex = $self->{'variables'}{$var}{'negcontextregex'}) { if ($context =~ /$regex/) { next; } } if ($self->{'config'}{$context}{$var}{'val'}) { $value = $self->{'config'}{$context}{$var}{'val'}; } else { $value = $self->{'variables'}{$var}{'default'}; } if ($action eq 'show') { $html .= "
$var: $value\n"; } elsif ($action =~ /(.*)form$/) { my $subaction = $1; my $fieldtype = $self->{'variables'}{$var}{'type'}; $html .= "\n"; if ($fieldtype =~ /text$/) { $html .= "
$var: \n"; } elsif ($fieldtype eq 'one') { $html .= "
$var: \n"; foreach $item (@{$self->{'variables'}{$var}{'values'}}) { my $checked = 'checked' if ($item eq $value); $html .= " $item\n"; } } } elsif ($action eq 'modify' || $action eq 'add') { if ($action eq 'add' || ($vars{"VAR$var"} ne $vars{"OLD$var"})) { my $newval = $vars{"VAR$var"}; #need to check for valid value here $html .= "\n"; if ($self->variablecheck($context, $var, $newval)) { $html .= "
SET VARIABLE $context $var=$newval\n"; $self->setvariable($context, $var, $newval); $self->{'commit'} = 1; } } } } } if ($action =~ /form$/) { $html .= "
\n"; $html .= "
\n"; } if ($self->{'commit'}) { print "
Going to try to commit\n"; $self->rewriteconfig(); } $html .= "\n"; return $html; } sub htmlheader { my ($self, $title) = @_; $title = $self->{'description'} if (!defined($title)); my $html = "$title\n"; $html .= "\n"; return $html; } sub htmlfooter { my ($self) = @_; my $html = "\n"; return $html; } sub deletecontext { my ($self, $context) = @_; if (delete($self->{'config'}{$context})) { return 1; } else { return 0; } } sub helptext { my ($self, $helpname) = @_; } 1; asterisk-perl-1.08/lib/Asterisk/AGI.pm0000644000175000017500000006252412736552564020322 0ustar cgonzalezcgonzalezpackage 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; my $readvars = 0; $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); } elsif (($readvars && ($response eq '')) || ($response eq 'HANGUP')) { print STDERR "Skipping blank response or HANGUP because we just read vars\n" if ($self->_debug > 0); $readvars = 0; } elsif ($response) { return($response); } else { print STDERR "AGI Received unknown response: '$response'\n" if ($self->_debug > 0); } } return '200 result=-1 (noresponse)'; } 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; } =back =head1 AGI COMMANDS =over 4 =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)); $skipms = '' if (!defined($skipms)); $ffchar = '' if (!defined($ffchar)); $rewchar = '' if (!defined($rewchar)); $pausechar = '' if (!defined($pausechar)); 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 / 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 / to 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 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. Example: $AGI->hangup(); Returns: Always returns 1 =cut sub hangup { my ($self, $channel) = @_; if ($channel) { return $self->execute("HANGUP $channel"); } else { return $self->execute("HANGUP"); } } =item $AGI->noop() Executes AGI Command "NOOP" Does absolutely nothing except pop up a log message. Useful for outputting debugging information to the Asterisk console. Example: $AGI->noop("Test Message"); Returns: -1 on hangup or error, 0 otherwise =cut sub noop { my ($self, $string) = @_; return $self->execute("NOOP $string"); } =item $AGI->receive_char($timeout) Executes AGI Command "RECEIVE CHAR $timeout" Receives a character of text on a channel. Specify timeout to be the maximum time to wait for input in milliseconds, or 0 for infinite. Most channels do not support the reception of text. Example: $AGI->receive_char(3000); Returns: Returns the decimal value of the character if one is received, or 0 if the channel does not support text reception. Returns -1 only on error/hangup. =cut sub receive_char { my ($self, $timeout) = @_; #wait forever if timeout is not set. is this the prefered default? $timeout = 0 if (!defined($timeout)); return $self->execute("RECEIVE CHAR $timeout"); } =item $AGI->receive_text($timeout) Executes AGI Command "RECEIVE TEXT $timeout" Receives a string of text on a channel. Specify timeout to be the maximum time to wait for input in milliseconds, or 0 for infinite. Most channels do not support the reception of text. Example: $AGI->receive_text(3000); Returns: Returns the string of text if received, or -1 for failure, error or hangup. =cut sub receive_text { my ($self, $timeout) = @_; #wait forever if timeout is not set. is this the prefered default? $timeout = 0 if (!defined($timeout)); return $self->execute("RECEIVE TEXT $timeout"); } =item $AGI->record_file($filename, $format, $digits, $timeout, $beep, $offset, $beep, $silence) Executes AGI Command "RECORD FILE $filename $format $digits $timeout [$offset [$beep [s=$silence]]]" Record to a file until $digits are received as dtmf. The $format will specify what kind of file will be recorded. The $timeout is the maximum record time in milliseconds, or -1 for no timeout. $offset samples is optional, and if provided will seek to the offset without exceeding the end of the file. $silence is the number of seconds of silence allowed before the function returns despite the lack of dtmf digits or reaching timeout. Example: $AGI->record_file('foo', 'wav', '#', '5000', '0', 1, '2'); Returns: 1 on success, -1 on hangup or error. =cut sub record_file { my ($self, $filename, $format, $digits, $timeout, $offset, $beep, $silence) = @_; my $extra = ''; return -1 if (!defined($filename)); $digits = '""' if (!defined($digits)); $extra .= $offset if (defined($offset)); $extra .= ' ' . $beep if (defined($beep)); $extra .= ' s=' . $silence if (defined($silence)); return $self->execute("RECORD FILE $filename $format $digits $timeout $extra"); } =item $AGI->say_alpha($string, $digits) Executes AGI Command "SAY ALPHA "$string" $digits" Say a given character string, returning early if any of the given DTMF $digits are received on the channel. Returns Example: $AGI->say_alpha('Joe Smith', '#'); Returns: 0 if playback completes without a digit being pressed; the ASCII numerical value of the digit if one was pressed; -1 on error/hangup. =cut sub say_alpha { my ($self, $string, $digits) = @_; $digits = '""' if (!defined($digits)); return -1 if (!defined($string)); return $self->execute("SAY ALPHA \"$string\" $digits"); } =item $AGI->say_date($time [, $digits]) =cut =item $AGI->say_time($time [, $digits]) =cut =item $AGI->say_datetime($time [, $digits [, $format [, $timezone]]]) Executes AGI Command "SAY DATE $number $digits" Executes AGI Command "SAY TIME $number $digits" Executes AGI Command "SAY DATETIME $number $digits $format $timezone" Say a given date or time, returning early if any of the optional DTMF $digits are received on the channel. $time is number of seconds elapsed since 00:00:00 on January 1, 1970, Coordinated Universal Time (UTC), commonly known as "unixtime." For say_datetime, $format is the format the time should be said in; see voicemail.conf (defaults to "ABdY 'digits/at' IMp"). Acceptable values for $timezone can be found in /usr/share/zoneinfo. Defaults to machine default. Example: $AGI->say_date('100000000'); $AGI->say_time('100000000', '#'); $AGI->say_datetime('100000000', '#', 'ABdY IMp', 'EDT'); 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 say_datetime_all { my ($self, $type, $time, $digits, $format, $timezone) = @_; my $ret = 0; return -1 if (!defined($time)); $digits = '""' if (!defined($digits)); $format = '' if (!defined($format)); $timezone = '' if (!defined($timezone)); if ($type eq 'date') { $ret = $self->execute("SAY DATE $time $digits"); } elsif ($type eq 'time') { $ret = $self->execute("SAY TIME $time $digits"); } elsif ($type eq 'datetime') { $ret = $self->execute("SAY DATETIME $time $digits $format $timezone"); } else { $ret = -1; } return $ret; } sub say_date { my ($self, $time, $digits) = @_; return $self->say_datetime_all('date', $time, $digits); } sub say_time { my ($self, $time, $digits) = @_; return $self->say_datetime_all('time', $time, $digits); } sub say_datetime { my ($self, $time, $digits, $format, $timezone) = @_; return $self->say_datetime_all('datetime', $time, $digits, $format, $timezone); } =item $AGI->say_digits($number, $digits) Executes AGI Command "SAY DIGITS $number $digits" Says the given digit string $number, returning early if any of the $digits are received. Example: $AGI->say_digits('8675309'); Returns: -1 on error or hangup, 0 if playback completes without a digit being pressed, or the ASCII numerical value of the digit of one was pressed. =cut sub say_digits { my ($self, $number, $digits) = @_; $digits = '""' if (!defined($digits)); return -1 if (!defined($number)); $number =~ s/\D//g; return $self->execute("SAY DIGITS $number $digits"); } =item $AGI->say_number($number, $digits, $gender) Executes AGI Command "SAY NUMBER $number $digits [$gender]" Says the given $number, returning early if any of the $digits are received. Example: $AGI->say_number('98765'); Returns: -1 on error or hangup, 0 if playback completes without a digit being pressed, or the ASCII numerical value of the digit of one was pressed. =cut sub say_number { my ($self, $number, $digits, $gender) = @_; $digits = '""' if (!defined($digits)); $gender = '' if (!defined($gender)); return -1 if (!defined($number)); $number =~ s/\D//g; return $self->execute("SAY NUMBER $number $digits $gender"); } =item $AGI->say_phonetic($string, $digits) Executes AGI Command "SAY PHONETIC "$string" $digits" Say a given character string with phonetics, returning early if any of the given DTMF digits are received on the channel. Example: $AGI->say_phonetic('Joe Smith', '#'); Returns: 0 if playback completes without a digit being pressed; the ASCII numerical value of the digit if one was pressed; -1 on error/hangup. =cut sub say_phonetic { my ($self, $string, $digits) = @_; $digits = '""' if (!defined($digits)); return -1 if (!defined($string)); return $self->execute("SAY PHONETIC \"$string\" $digits"); } =item $AGI->send_image($image) Executes AGI Command "SEND IMAGE $image Sends the given image on a channel. Most channels do not support the transmission of images. Example: $AGI->send_image('image.png'); Returns: -1 on error or hangup, 0 if the image was sent or if the channel does not support image transmission. =cut sub send_image { my ($self, $image) = @_; return -1 if (!defined($image)); return $self->execute("SEND IMAGE $image"); } =item $AGI->send_text($text) Executes AGI Command "SEND TEXT "$text" Sends the given text on a channel. Most channels do not support the transmission of text. Example: $AGI->send_text('You've got mail!'); Returns: -1 on error or hangup, 0 if the text was sent or if the channel does not support text transmission. =cut sub send_text { my ($self, $text) = @_; return 0 if (!defined($text)); return $self->execute("SEND TEXT \"$text\""); } =item $AGI->set_autohangup($time) Executes AGI Command "SET AUTOHANGUP $time" Cause the channel to automatically hangup at