| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | #!/usr/bin/perl | 
| 2 |  |  |  |  |  |  |  | 
| 3 |  |  |  |  |  |  | =head1 NAME | 
| 4 |  |  |  |  |  |  |  | 
| 5 |  |  |  |  |  |  | Asterisk::AMI - Perl module for interacting with the Asterisk Manager Interface | 
| 6 |  |  |  |  |  |  |  | 
| 7 |  |  |  |  |  |  | =head1 VERSION | 
| 8 |  |  |  |  |  |  |  | 
| 9 |  |  |  |  |  |  | 0.2.7_1 | 
| 10 |  |  |  |  |  |  |  | 
| 11 |  |  |  |  |  |  | =head1 SYNOPSIS | 
| 12 |  |  |  |  |  |  |  | 
| 13 |  |  |  |  |  |  | use Asterisk::AMI; | 
| 14 |  |  |  |  |  |  | my $astman = Asterisk::AMI->new(PeerAddr => '127.0.0.1', | 
| 15 |  |  |  |  |  |  | PeerPort => '5038', | 
| 16 |  |  |  |  |  |  | Username => 'admin', | 
| 17 |  |  |  |  |  |  | Secret => 'supersecret' | 
| 18 |  |  |  |  |  |  | ); | 
| 19 |  |  |  |  |  |  |  | 
| 20 |  |  |  |  |  |  | die "Unable to connect to asterisk" unless ($astman); | 
| 21 |  |  |  |  |  |  |  | 
| 22 |  |  |  |  |  |  | my $action = $astman->({ Action => 'Command', | 
| 23 |  |  |  |  |  |  | Command => 'sip show peers' | 
| 24 |  |  |  |  |  |  | }); | 
| 25 |  |  |  |  |  |  |  | 
| 26 |  |  |  |  |  |  | =head1 DESCRIPTION | 
| 27 |  |  |  |  |  |  |  | 
| 28 |  |  |  |  |  |  | This module provides an interface to the Asterisk Manager Interface. It's goal is to provide a flexible, powerful, and | 
| 29 |  |  |  |  |  |  | reliable way to interact with Asterisk upon which other applications may be built. It utilizes AnyEvent and therefore | 
| 30 |  |  |  |  |  |  | can integrate very easily into event-based applications, but it still provides blocking functions for us with standard | 
| 31 |  |  |  |  |  |  | scripting. | 
| 32 |  |  |  |  |  |  |  | 
| 33 |  |  |  |  |  |  | =head2 SSL SUPPORT INFORMATION | 
| 34 |  |  |  |  |  |  |  | 
| 35 |  |  |  |  |  |  | For SSL support you will also need the module that AnyEvent::Handle uses for SSL support, which is not a required | 
| 36 |  |  |  |  |  |  | dependency. Currently that module is 'Net::SSLeay' (AnyEvent:Handle version 5.251) but it may change in the future. | 
| 37 |  |  |  |  |  |  |  | 
| 38 |  |  |  |  |  |  | =head3 CentOS/Redhat | 
| 39 |  |  |  |  |  |  |  | 
| 40 |  |  |  |  |  |  | If the version of Net:SSLeay included in CentOS/Redhat does not work try installing an updated version from CPAN. | 
| 41 |  |  |  |  |  |  |  | 
| 42 |  |  |  |  |  |  | =head2 Constructor | 
| 43 |  |  |  |  |  |  |  | 
| 44 |  |  |  |  |  |  | =head3 new([ARGS]) | 
| 45 |  |  |  |  |  |  |  | 
| 46 |  |  |  |  |  |  | Creates a new AMI object which takes the arguments as key-value pairs. | 
| 47 |  |  |  |  |  |  |  | 
| 48 |  |  |  |  |  |  | Key-Value Pairs accepted: | 
| 49 |  |  |  |  |  |  | PeerAddr        Remote host address | 
| 50 |  |  |  |  |  |  | PeerPort        Remote host port | 
| 51 |  |  |  |  |  |  | Events Enable/Disable Events 'on'|'off' | 
| 52 |  |  |  |  |  |  | Username        Username to access the AMI | 
| 53 |  |  |  |  |  |  | Secret Secret used to connect to AMI | 
| 54 |  |  |  |  |  |  | AuthType        Authentication type to use for login        'plaintext'|'MD5' | 
| 55 |  |  |  |  |  |  | UseSSL Enables/Disables SSL for the connection 0|1 | 
| 56 |  |  |  |  |  |  | BufferSize        Maximum size of buffer, in number of actions | 
| 57 |  |  |  |  |  |  | Timeout Default timeout of all actions in seconds | 
| 58 |  |  |  |  |  |  | Handlers        Hash reference of Handlers for events        { 'EVENT' => \&somesub }; | 
| 59 |  |  |  |  |  |  | Keepalive        Interval (in seconds) to periodically send 'Ping' actions to asterisk | 
| 60 |  |  |  |  |  |  | TCP_Keepalive        Enables/Disables SO_KEEPALIVE option on the socket        0|1 | 
| 61 |  |  |  |  |  |  | Blocking        Enable/Disable blocking connects        0|1 | 
| 62 |  |  |  |  |  |  | on_connect        A subroutine to run after we connect | 
| 63 |  |  |  |  |  |  | on_connect_err        A subroutine to call if we have an error while connecting | 
| 64 |  |  |  |  |  |  | on_error        A subroutine to call when an error occurs on the socket | 
| 65 |  |  |  |  |  |  | on_disconnect        A subroutine to call when the remote end disconnects | 
| 66 |  |  |  |  |  |  | on_timeout        A subroutine to call if our Keepalive times out | 
| 67 |  |  |  |  |  |  | OriginateHack        Changes settings to allow Async Originates to work 0|1 | 
| 68 |  |  |  |  |  |  |  | 
| 69 |  |  |  |  |  |  | 'PeerAddr' defaults to 127.0.0.1. | 
| 70 |  |  |  |  |  |  | 'PeerPort' defaults to 5038. | 
| 71 |  |  |  |  |  |  | 'Events' default is 'off'. May be anything that the AMI will accept as a part of the 'Events' parameter for the | 
| 72 |  |  |  |  |  |  | login action. | 
| 73 |  |  |  |  |  |  | 'Username' has no default and must be supplied. | 
| 74 |  |  |  |  |  |  | 'Secret' has no default and must be supplied. | 
| 75 |  |  |  |  |  |  | 'AuthType' sets the authentication type to use for login. Default is 'plaintext'.  Use 'MD5' for MD5 challenge | 
| 76 |  |  |  |  |  |  | authentication. | 
| 77 |  |  |  |  |  |  | 'UseSSL' defaults to 0 (no ssl). When SSL is enabled the default PeerPort changes to 5039. | 
| 78 |  |  |  |  |  |  | 'BufferSize' has a default of 30000. It also acts as our max actionid before we reset the counter. | 
| 79 |  |  |  |  |  |  | 'Timeout' has a default of 0, which means no timeout on blocking. | 
| 80 |  |  |  |  |  |  | 'Handlers' accepts a hash reference setting a callback handler for the specified event. EVENT should match | 
| 81 |  |  |  |  |  |  | the contents of the {'Event'} key of the event object will be. The handler should be a subroutine reference that | 
| 82 |  |  |  |  |  |  | will be passed the a copy of the AMI object and the event object. The 'default' keyword can be used to set | 
| 83 |  |  |  |  |  |  | a default event handler. If handlers are installed we do not buffer events and instead immediately dispatch them. | 
| 84 |  |  |  |  |  |  | If no handler is specified for an event type and a 'default' was not set the event is discarded. | 
| 85 |  |  |  |  |  |  | 'Keepalive' only works when running with an event loop. Used with on_timeout, this can be used to detect if | 
| 86 |  |  |  |  |  |  | asterisk has become un-responsive. | 
| 87 |  |  |  |  |  |  | 'TCP_Keepalive' default is disabled. Activates the tcp keep-alive at the socket layer. This does not require | 
| 88 |  |  |  |  |  |  | an event-loop and is lightweight. Useful for applications that use long-lived connections to Asterisk but | 
| 89 |  |  |  |  |  |  | do not run an event loop. | 
| 90 |  |  |  |  |  |  | 'Blocking' has a default of 1 (block on connecting). A value of 0 will cause us to queue our connection | 
| 91 |  |  |  |  |  |  | and login for when an event loop is started. If set to non blocking we will always return a valid object. | 
| 92 |  |  |  |  |  |  |  | 
| 93 |  |  |  |  |  |  | 'on_connect' is a subroutine to call when we have successfully connected and logged into the asterisk manager. | 
| 94 |  |  |  |  |  |  | it will be passed our AMI object. | 
| 95 |  |  |  |  |  |  |  | 
| 96 |  |  |  |  |  |  | 'on_connect_err', 'on_error', 'on_disconnect' | 
| 97 |  |  |  |  |  |  | These three specify subroutines to call when errors occur. 'on_connect_err' is specifically for errors that | 
| 98 |  |  |  |  |  |  | occur while connecting, as well as failed logins. If 'on_connect_err' or 'on_disconnect' it is not set, | 
| 99 |  |  |  |  |  |  | but 'on_error' is, 'on_error' will be called. 'on_disconnect' is not reliable, as disconnects seem to get lumped | 
| 100 |  |  |  |  |  |  | under 'on_error' instead. When the subroutine specified for any of theses is called the first argument is a copy | 
| 101 |  |  |  |  |  |  | of our AMI object, and the second is a string containing a message/reason. All three of these are 'fatal', when | 
| 102 |  |  |  |  |  |  | they occur we destroy our buffers and our socket connections. | 
| 103 |  |  |  |  |  |  |  | 
| 104 |  |  |  |  |  |  | 'on_timeout' is called when a keep-alive has timed out, not when a normal action has. It is non-'fatal'. | 
| 105 |  |  |  |  |  |  | The subroutine will be called with a copy of our AMI object and a message. | 
| 106 |  |  |  |  |  |  |  | 
| 107 |  |  |  |  |  |  | 'OriginateHack' defaults to 0 (off). This essentially enables 'call' events and says 'discard all events | 
| 108 |  |  |  |  |  |  | unless the user has explicitly enabled events' (prevents a memory leak). It does its best not to mess up | 
| 109 |  |  |  |  |  |  | anything you have already set. Without this, if you use 'Async' with an 'Originate' the action will timeout | 
| 110 |  |  |  |  |  |  | or never callback. You don't need this if you are already doing work with events, simply add 'call' events | 
| 111 |  |  |  |  |  |  | to your eventmask. | 
| 112 |  |  |  |  |  |  |  | 
| 113 |  |  |  |  |  |  | =head2 Disabling Warnings | 
| 114 |  |  |  |  |  |  |  | 
| 115 |  |  |  |  |  |  | If you have warnings enabled this module will emit a number of them on connection errors, deprecated features, etc. | 
| 116 |  |  |  |  |  |  | To disable this but still have all other warnings in perl enabled you can do the following: | 
| 117 |  |  |  |  |  |  |  | 
| 118 |  |  |  |  |  |  | use Asterisk::AMI; | 
| 119 |  |  |  |  |  |  | use warnings; | 
| 120 |  |  |  |  |  |  | no warnings qw(Asterisk::AMI); | 
| 121 |  |  |  |  |  |  |  | 
| 122 |  |  |  |  |  |  | That will enable warnings but disable any warnings from this module. | 
| 123 |  |  |  |  |  |  |  | 
| 124 |  |  |  |  |  |  | =head2 Warning - Mixing Event-loops and blocking actions | 
| 125 |  |  |  |  |  |  |  | 
| 126 |  |  |  |  |  |  | For an intro to Event-Based programming please check out the documentation in AnyEvent::Intro. | 
| 127 |  |  |  |  |  |  |  | 
| 128 |  |  |  |  |  |  | If you are running an event loop and use blocking methods (e.g. get_response, check_response, action, | 
| 129 |  |  |  |  |  |  | simple_action, connected, or a blocking connect) the outcome is unspecified. It may work, it may lock everything up, the action may | 
| 130 |  |  |  |  |  |  | work but break something else. I have tested it and behavior seems unpredictable at best and is very | 
| 131 |  |  |  |  |  |  | circumstantial. | 
| 132 |  |  |  |  |  |  |  | 
| 133 |  |  |  |  |  |  | If you are running an event-loop use non-blocking callbacks! It is why they are there! | 
| 134 |  |  |  |  |  |  |  | 
| 135 |  |  |  |  |  |  | However if you do play with blocking methods inside of your loops let me know how it goes. | 
| 136 |  |  |  |  |  |  |  | 
| 137 |  |  |  |  |  |  | =head2 Actions | 
| 138 |  |  |  |  |  |  |  | 
| 139 |  |  |  |  |  |  | =head3 ActionIDs | 
| 140 |  |  |  |  |  |  |  | 
| 141 |  |  |  |  |  |  | This module handles ActionIDs internally and if you supply one in an action it will simply be ignored and overwritten. | 
| 142 |  |  |  |  |  |  |  | 
| 143 |  |  |  |  |  |  | =head3 Construction | 
| 144 |  |  |  |  |  |  |  | 
| 145 |  |  |  |  |  |  | No matter which method you use to send an action (send_action(), simple_action(), or action()), they all accept | 
| 146 |  |  |  |  |  |  | actions in the same format, which is a hash reference. The only exceptions to this rules are when specifying a | 
| 147 |  |  |  |  |  |  | callback and a callback timeout, which only work with send_action. | 
| 148 |  |  |  |  |  |  |  | 
| 149 |  |  |  |  |  |  | To build and send an action you can do the following: | 
| 150 |  |  |  |  |  |  |  | 
| 151 |  |  |  |  |  |  | %action = ( Action => 'Command', | 
| 152 |  |  |  |  |  |  | Command => 'sip show peers' | 
| 153 |  |  |  |  |  |  | ); | 
| 154 |  |  |  |  |  |  |  | 
| 155 |  |  |  |  |  |  | $astman->send_action(\%action); | 
| 156 |  |  |  |  |  |  |  | 
| 157 |  |  |  |  |  |  | Alternatively you can also do the following to the same effect: | 
| 158 |  |  |  |  |  |  |  | 
| 159 |  |  |  |  |  |  | $astman->send_action({  Action => 'Command', | 
| 160 |  |  |  |  |  |  | Command => 'sip show peers' | 
| 161 |  |  |  |  |  |  | }); | 
| 162 |  |  |  |  |  |  |  | 
| 163 |  |  |  |  |  |  | Additionally the value of the hash may be an array reference. When an array reference is used, every value in the | 
| 164 |  |  |  |  |  |  | array is append as a different line to the action. For example: | 
| 165 |  |  |  |  |  |  |  | 
| 166 |  |  |  |  |  |  | { Variable => [ 'var1=1', 'var2=2' ] } | 
| 167 |  |  |  |  |  |  |  | 
| 168 |  |  |  |  |  |  | Will become: | 
| 169 |  |  |  |  |  |  |  | 
| 170 |  |  |  |  |  |  | Variable: var1=1 | 
| 171 |  |  |  |  |  |  | Variable: var2=2 | 
| 172 |  |  |  |  |  |  |  | 
| 173 |  |  |  |  |  |  | When the action is sent. | 
| 174 |  |  |  |  |  |  |  | 
| 175 |  |  |  |  |  |  | =head3 Sending and Retrieving | 
| 176 |  |  |  |  |  |  |  | 
| 177 |  |  |  |  |  |  | More detailed information on these individual methods is available below | 
| 178 |  |  |  |  |  |  |  | 
| 179 |  |  |  |  |  |  | The send_action() method can be used to send an action to the AMI. It will return a positive integer, which is the | 
| 180 |  |  |  |  |  |  | ActionID of the action, on success and will return undef in the event it is unable to send the action. | 
| 181 |  |  |  |  |  |  |  | 
| 182 |  |  |  |  |  |  | After sending an action you can then get its response in one of two methods. | 
| 183 |  |  |  |  |  |  |  | 
| 184 |  |  |  |  |  |  | The method check_response() accepts an actionid and will return 1 if the action was considered successful, 0 if it | 
| 185 |  |  |  |  |  |  | failed and undef if an error occurred or on timeout. | 
| 186 |  |  |  |  |  |  |  | 
| 187 |  |  |  |  |  |  | The method get_response() accepts an actionid and will return a Response object (really just a fancy hash) with the | 
| 188 |  |  |  |  |  |  | contents of the Action Response as well as any associated Events it generated. It will return undef if an error | 
| 189 |  |  |  |  |  |  | occurred or on timeout. | 
| 190 |  |  |  |  |  |  |  | 
| 191 |  |  |  |  |  |  | All responses and events are buffered, therefor you can issue several send_action()s and then retrieve/check their | 
| 192 |  |  |  |  |  |  | responses out of order without losing any information. In-fact, if you are issuing many actions in series you can get | 
| 193 |  |  |  |  |  |  | much better performance sending them all first and then retrieving them later, rather than waiting for responses | 
| 194 |  |  |  |  |  |  | immediately after issuing an action. | 
| 195 |  |  |  |  |  |  |  | 
| 196 |  |  |  |  |  |  | Alternatively you can also use simple_action() and action(). simple_action() combines send_action() and | 
| 197 |  |  |  |  |  |  | check_response(), and therefore returns 1 on success and 0 on failure, and undef on error or timeout. action() | 
| 198 |  |  |  |  |  |  | combines send_action() and get_response(), and therefore returns a Response object or undef. | 
| 199 |  |  |  |  |  |  |  | 
| 200 |  |  |  |  |  |  | =head4 Examples | 
| 201 |  |  |  |  |  |  |  | 
| 202 |  |  |  |  |  |  | Send and retrieve and action: | 
| 203 |  |  |  |  |  |  | my $actionid = $astman->send_action({   Action => 'Command', | 
| 204 |  |  |  |  |  |  | Command => 'sip show peers' | 
| 205 |  |  |  |  |  |  | }); | 
| 206 |  |  |  |  |  |  |  | 
| 207 |  |  |  |  |  |  | my $response = $astman->get_response($actionid) | 
| 208 |  |  |  |  |  |  |  | 
| 209 |  |  |  |  |  |  | This is equivalent to the above: | 
| 210 |  |  |  |  |  |  | my $response = $astman->action({        Action => 'Command', | 
| 211 |  |  |  |  |  |  | Command => 'sip show peers' | 
| 212 |  |  |  |  |  |  | }); | 
| 213 |  |  |  |  |  |  |  | 
| 214 |  |  |  |  |  |  | The following: | 
| 215 |  |  |  |  |  |  | my $actionid1 = $astman->send_action({  Action => 'Command', | 
| 216 |  |  |  |  |  |  | Command => 'sip show peers' | 
| 217 |  |  |  |  |  |  | }); | 
| 218 |  |  |  |  |  |  |  | 
| 219 |  |  |  |  |  |  | my $actionid2 = $astman->send_action({  Action => 'Command', | 
| 220 |  |  |  |  |  |  | Command => 'sip show peers' | 
| 221 |  |  |  |  |  |  | }); | 
| 222 |  |  |  |  |  |  |  | 
| 223 |  |  |  |  |  |  | my $actionid3 = $astman->send_action({  Action => 'Command', | 
| 224 |  |  |  |  |  |  | Command => 'sip show peers' | 
| 225 |  |  |  |  |  |  | }); | 
| 226 |  |  |  |  |  |  |  | 
| 227 |  |  |  |  |  |  | my $response3 = $astman->get_response($actionid3); | 
| 228 |  |  |  |  |  |  | my $response1 = $astman->get_response($actionid1); | 
| 229 |  |  |  |  |  |  | my $response2 = $astman->get_response($actionid2); | 
| 230 |  |  |  |  |  |  |  | 
| 231 |  |  |  |  |  |  | Can be much faster than: | 
| 232 |  |  |  |  |  |  | my $response1 = $astman->action({       Action => 'Command', | 
| 233 |  |  |  |  |  |  | Command => 'sip show peers' | 
| 234 |  |  |  |  |  |  | }); | 
| 235 |  |  |  |  |  |  | my $response2 = $astman->action({       Action => 'Command', | 
| 236 |  |  |  |  |  |  | Command => 'sip show peers' | 
| 237 |  |  |  |  |  |  | }); | 
| 238 |  |  |  |  |  |  | my $response3 = $astman->action({       Action => 'Command', | 
| 239 |  |  |  |  |  |  | Command => 'sip show peers' | 
| 240 |  |  |  |  |  |  | }); | 
| 241 |  |  |  |  |  |  |  | 
| 242 |  |  |  |  |  |  | =head3 Originate Examples | 
| 243 |  |  |  |  |  |  |  | 
| 244 |  |  |  |  |  |  | These don't include non-blocking examples, please read the section on 'Callbacks' below for information | 
| 245 |  |  |  |  |  |  | on using non-blocking callbacks and events. | 
| 246 |  |  |  |  |  |  |  | 
| 247 |  |  |  |  |  |  | NOTE: Please read about the 'OriginateHack' option for the constructor above if you plan on using the 'Async' | 
| 248 |  |  |  |  |  |  | option in your Originate command, as it may be required to properly retrieve the response. | 
| 249 |  |  |  |  |  |  |  | 
| 250 |  |  |  |  |  |  | In these examples we are dialing extension '12345' at a sip peer named 'peer' and when the call connects | 
| 251 |  |  |  |  |  |  | we drop the channel into 'some_context' at priority 1 for extension 100. | 
| 252 |  |  |  |  |  |  |  | 
| 253 |  |  |  |  |  |  | Example 1 - A simple non-ASYNC Originate | 
| 254 |  |  |  |  |  |  |  | 
| 255 |  |  |  |  |  |  | my $response = $astman->action({Action => 'Originate', | 
| 256 |  |  |  |  |  |  | Channel => 'SIP/peer/12345', | 
| 257 |  |  |  |  |  |  | Context => 'some_context', | 
| 258 |  |  |  |  |  |  | Exten => 100, | 
| 259 |  |  |  |  |  |  | Priority => 1}); | 
| 260 |  |  |  |  |  |  |  | 
| 261 |  |  |  |  |  |  | And the contents of respone will look similiar to the following: | 
| 262 |  |  |  |  |  |  |  | 
| 263 |  |  |  |  |  |  | { | 
| 264 |  |  |  |  |  |  | 'Message' => 'Originate successfully queued', | 
| 265 |  |  |  |  |  |  | 'ActionID' => '3', | 
| 266 |  |  |  |  |  |  | 'GOOD' => 1, | 
| 267 |  |  |  |  |  |  | 'COMPLETED' => 1, | 
| 268 |  |  |  |  |  |  | 'Response' => 'Success' | 
| 269 |  |  |  |  |  |  | }; | 
| 270 |  |  |  |  |  |  |  | 
| 271 |  |  |  |  |  |  | Example 2 - Originate with multiple variables | 
| 272 |  |  |  |  |  |  | This will set the channel variables 'var1' and 'var2' to 1 and 2, respectfully. | 
| 273 |  |  |  |  |  |  | The value for the 'Variable' key should be an array reference or an anonymous array in order | 
| 274 |  |  |  |  |  |  | to set multiple variables. | 
| 275 |  |  |  |  |  |  |  | 
| 276 |  |  |  |  |  |  | my $response = $astman->action({Action => 'Originate', | 
| 277 |  |  |  |  |  |  | Channel => 'SIP/peer/12345', | 
| 278 |  |  |  |  |  |  | Context => 'some_context', | 
| 279 |  |  |  |  |  |  | Exten => 100, | 
| 280 |  |  |  |  |  |  | Priority => 1, | 
| 281 |  |  |  |  |  |  | Variable = [ 'var1=1', 'var2=2' ]}); | 
| 282 |  |  |  |  |  |  |  | 
| 283 |  |  |  |  |  |  | Example 3 - An Async Originate | 
| 284 |  |  |  |  |  |  | If your Async Originate never returns please read about the 'OriginateHack' option for the constructor. | 
| 285 |  |  |  |  |  |  |  | 
| 286 |  |  |  |  |  |  | my $response = $astman->action({Action => 'Originate', | 
| 287 |  |  |  |  |  |  | Channel => 'SIP/peer/12345', | 
| 288 |  |  |  |  |  |  | Context => 'some_context', | 
| 289 |  |  |  |  |  |  | Exten => 100, | 
| 290 |  |  |  |  |  |  | Priority => 1, | 
| 291 |  |  |  |  |  |  | Async => 1}); | 
| 292 |  |  |  |  |  |  |  | 
| 293 |  |  |  |  |  |  | And the contents of response will look similiar to the following: | 
| 294 |  |  |  |  |  |  |  | 
| 295 |  |  |  |  |  |  | { | 
| 296 |  |  |  |  |  |  | 'Message' => 'Originate successfully queued', | 
| 297 |  |  |  |  |  |  | 'EVENTS' => [ | 
| 298 |  |  |  |  |  |  | { | 
| 299 |  |  |  |  |  |  | 'Exten' => '100', | 
| 300 |  |  |  |  |  |  | 'CallerID' => '', | 
| 301 |  |  |  |  |  |  | 'Event' => 'OriginateResponse', | 
| 302 |  |  |  |  |  |  | 'Privilege' => 'call,all', | 
| 303 |  |  |  |  |  |  | 'Channel' => 'SIP/peer-009c5510', | 
| 304 |  |  |  |  |  |  | 'Context' => 'some_context', | 
| 305 |  |  |  |  |  |  | 'Response' => 'Success', | 
| 306 |  |  |  |  |  |  | 'Reason' => '4', | 
| 307 |  |  |  |  |  |  | 'CallerIDName' => '', | 
| 308 |  |  |  |  |  |  | 'Uniqueid' => '1276543236.82', | 
| 309 |  |  |  |  |  |  | 'ActionID' => '3', | 
| 310 |  |  |  |  |  |  | 'CallerIDNum' => '' | 
| 311 |  |  |  |  |  |  | } | 
| 312 |  |  |  |  |  |  | ], | 
| 313 |  |  |  |  |  |  | 'ActionID' => '3', | 
| 314 |  |  |  |  |  |  | 'GOOD' => 1, | 
| 315 |  |  |  |  |  |  | 'COMPLETED' => 1, | 
| 316 |  |  |  |  |  |  | 'Response' => 'Success' | 
| 317 |  |  |  |  |  |  | }; | 
| 318 |  |  |  |  |  |  |  | 
| 319 |  |  |  |  |  |  | More Info: | 
| 320 |  |  |  |  |  |  | Check out the voip-info.org page for more information on the Originate action. | 
| 321 |  |  |  |  |  |  | http://www.voip-info.org/wiki/view/Asterisk+Manager+API+Action+Originate | 
| 322 |  |  |  |  |  |  |  | 
| 323 |  |  |  |  |  |  | =head3 Callbacks | 
| 324 |  |  |  |  |  |  |  | 
| 325 |  |  |  |  |  |  | You may also specify a subroutine to callback when using send_action as well as a timeout. | 
| 326 |  |  |  |  |  |  |  | 
| 327 |  |  |  |  |  |  | An example of this would be: | 
| 328 |  |  |  |  |  |  | $astman->send_action({ Action => 'Ping' }, \&somemethod, 7, $somevar); | 
| 329 |  |  |  |  |  |  |  | 
| 330 |  |  |  |  |  |  | In this example once the action 'Ping' finishes we will call somemethod() and pass it the a copy of our AMI object, | 
| 331 |  |  |  |  |  |  | the Response Object for the action, and an optional variable $somevar. If a timeout is not specified | 
| 332 |  |  |  |  |  |  | it will use the default set. A value of 0 means no timeout. When the timeout is reached somemethod() will be called | 
| 333 |  |  |  |  |  |  | and passed a reference to our $astman and the uncompleted Response Object, therefore somemethod() should check the | 
| 334 |  |  |  |  |  |  | state of the object. Checking the key {'GOOD'} is usually a good indication if the response is useable. | 
| 335 |  |  |  |  |  |  |  | 
| 336 |  |  |  |  |  |  | Anonymous subroutines are also acceptable as demostrated in the examples below: | 
| 337 |  |  |  |  |  |  | my $callback = sub { return }; | 
| 338 |  |  |  |  |  |  |  | 
| 339 |  |  |  |  |  |  | $astman->send_action({ Action => 'Ping' }, $callback, 7); | 
| 340 |  |  |  |  |  |  |  | 
| 341 |  |  |  |  |  |  | Or | 
| 342 |  |  |  |  |  |  |  | 
| 343 |  |  |  |  |  |  | $astman->send_action({ Action => 'Ping' }, sub { return }, 7); | 
| 344 |  |  |  |  |  |  |  | 
| 345 |  |  |  |  |  |  |  | 
| 346 |  |  |  |  |  |  |  | 
| 347 |  |  |  |  |  |  | =head3 Callback Caveats | 
| 348 |  |  |  |  |  |  |  | 
| 349 |  |  |  |  |  |  | Callbacks only work if we are processing packets, therefore you must be running an event loop. Alternatively, we run | 
| 350 |  |  |  |  |  |  | mini-event loops for our blocking calls (e.g. action(), get_action()), so in theory if you set callbacks and then | 
| 351 |  |  |  |  |  |  | issue a blocking call those callbacks should also get triggered. However this is an unsupported scenario. | 
| 352 |  |  |  |  |  |  |  | 
| 353 |  |  |  |  |  |  | Timeouts are done using timers and they are set as soon as you send the object. Therefore if you send an action with a | 
| 354 |  |  |  |  |  |  | timeout and then monkey around for a long time before getting back to your event loop (to process input) you can time | 
| 355 |  |  |  |  |  |  | out before ever even attempting to receive the response. | 
| 356 |  |  |  |  |  |  |  | 
| 357 |  |  |  |  |  |  | A very contrived example: | 
| 358 |  |  |  |  |  |  | $astman->send_action({ Action => 'Ping' }, \&somemethod, 3); | 
| 359 |  |  |  |  |  |  |  | 
| 360 |  |  |  |  |  |  | sleep(4); | 
| 361 |  |  |  |  |  |  |  | 
| 362 |  |  |  |  |  |  | #Start loop | 
| 363 |  |  |  |  |  |  | $astman->loop; | 
| 364 |  |  |  |  |  |  | #Oh no we never even tried to get the response yet it will still time out | 
| 365 |  |  |  |  |  |  |  | 
| 366 |  |  |  |  |  |  | =head2 Passing Variables in an Action Response | 
| 367 |  |  |  |  |  |  |  | 
| 368 |  |  |  |  |  |  | Sometimes, when working in an event framework, you want a way to associate/map the response to an action with another | 
| 369 |  |  |  |  |  |  | identifier used in your application. Normally you would have to maintain some sort of separate mapping involving the | 
| 370 |  |  |  |  |  |  | ActionID to accomplish this. This modules provides a generic way to pass any perl scalar (this includes references) | 
| 371 |  |  |  |  |  |  | with your action which is then passed to the callback with the response. | 
| 372 |  |  |  |  |  |  |  | 
| 373 |  |  |  |  |  |  | =head3 Passing | 
| 374 |  |  |  |  |  |  |  | 
| 375 |  |  |  |  |  |  | The variable to be passed to the callback should be passed as the fourth argument to the send_action() method. | 
| 376 |  |  |  |  |  |  |  | 
| 377 |  |  |  |  |  |  | For example to pass a simple scalar value: | 
| 378 |  |  |  |  |  |  |  | 
| 379 |  |  |  |  |  |  | my $vartostore = "Stored"; | 
| 380 |  |  |  |  |  |  |  | 
| 381 |  |  |  |  |  |  | $astman->send_action({ Action => 'Ping' }, \&somemethod, undef, $vartostore }); | 
| 382 |  |  |  |  |  |  |  | 
| 383 |  |  |  |  |  |  | And to pass a reference: | 
| 384 |  |  |  |  |  |  |  | 
| 385 |  |  |  |  |  |  | my @vartostore = ("One", "Two"); | 
| 386 |  |  |  |  |  |  |  | 
| 387 |  |  |  |  |  |  | $astman->send_action({ Action => 'Ping' }, \&somemethod, undef,  \@vartostore }); | 
| 388 |  |  |  |  |  |  |  | 
| 389 |  |  |  |  |  |  | =head3 Retrieving | 
| 390 |  |  |  |  |  |  |  | 
| 391 |  |  |  |  |  |  | The passed variable will be available as the third argument to the callback. | 
| 392 |  |  |  |  |  |  |  | 
| 393 |  |  |  |  |  |  | To retrieve in a callback: | 
| 394 |  |  |  |  |  |  |  | 
| 395 |  |  |  |  |  |  | my ($astman, $resp, $store) = @_; | 
| 396 |  |  |  |  |  |  |  | 
| 397 |  |  |  |  |  |  | print $store . " was stored\n"; | 
| 398 |  |  |  |  |  |  |  | 
| 399 |  |  |  |  |  |  | =head2 Responses and Events | 
| 400 |  |  |  |  |  |  |  | 
| 401 |  |  |  |  |  |  | NOTE: Empty fields sent by Asterisk (e.g. 'Account: ' with no value in an event) are represented by the hash | 
| 402 |  |  |  |  |  |  | value of null string, not undef. This means you need to test for '' | 
| 403 |  |  |  |  |  |  | (e.g. if ($response->{'Account'} ne '')) ) for any values that might be possibly be empty. | 
| 404 |  |  |  |  |  |  |  | 
| 405 |  |  |  |  |  |  | =head3 Responses | 
| 406 |  |  |  |  |  |  |  | 
| 407 |  |  |  |  |  |  | Responses are returned as response objects, which are hash references, structured as follows: | 
| 408 |  |  |  |  |  |  |  | 
| 409 |  |  |  |  |  |  | $response->{'Response'} Response to our packet (Success, Failed, Error, Pong, etc). | 
| 410 |  |  |  |  |  |  | {'ActionID'} ActionID of this Response. | 
| 411 |  |  |  |  |  |  | {'Message'} Message line of the response. | 
| 412 |  |  |  |  |  |  | {'EVENTS'} Array reference containing Event Objects associated with this actionid. | 
| 413 |  |  |  |  |  |  | {'PARSED'} Hash reference of lines we could parse into key->value pairs. | 
| 414 |  |  |  |  |  |  | {'CMD'} Contains command output from 'Action: Command's. It is an array reference. | 
| 415 |  |  |  |  |  |  | {'COMPLETED'} 1 if completed, 0 if not (timeout) | 
| 416 |  |  |  |  |  |  | {'GOOD'} 1 if good, 0 if bad. Good means no errors and COMPLETED. | 
| 417 |  |  |  |  |  |  |  | 
| 418 |  |  |  |  |  |  | =head3 Events | 
| 419 |  |  |  |  |  |  |  | 
| 420 |  |  |  |  |  |  | Events are turned into event objects, these are similar to response objects, but their keys vary much more | 
| 421 |  |  |  |  |  |  | depending on the specific event. | 
| 422 |  |  |  |  |  |  |  | 
| 423 |  |  |  |  |  |  | Some common contents are: | 
| 424 |  |  |  |  |  |  |  | 
| 425 |  |  |  |  |  |  | $event->{'Event'} The type of Event | 
| 426 |  |  |  |  |  |  | {'ActionID'} Only available if this event was caused by an action | 
| 427 |  |  |  |  |  |  |  | 
| 428 |  |  |  |  |  |  | =head3 Event Handlers | 
| 429 |  |  |  |  |  |  |  | 
| 430 |  |  |  |  |  |  | Here is a very simple example of how to use event handlers. Please note that the key for the event handler | 
| 431 |  |  |  |  |  |  | is matched against the event type that asterisk sends. For example if asterisk sends 'Event: Hangup' you use a | 
| 432 |  |  |  |  |  |  | key of 'Hangup' to match it. This works for any event type that asterisk sends. | 
| 433 |  |  |  |  |  |  |  | 
| 434 |  |  |  |  |  |  | my $astman = Asterisk::AMI->new(PeerAddr        =>        '127.0.0.1', | 
| 435 |  |  |  |  |  |  | PeerPort        =>        '5038', | 
| 436 |  |  |  |  |  |  | Username        =>        'admin', | 
| 437 |  |  |  |  |  |  | Secret => 'supersecret', | 
| 438 |  |  |  |  |  |  | Events => 'on', | 
| 439 |  |  |  |  |  |  | Handlers        => { default => \&do_event, | 
| 440 |  |  |  |  |  |  | Hangup => \&do_hangup }; | 
| 441 |  |  |  |  |  |  | ); | 
| 442 |  |  |  |  |  |  |  | 
| 443 |  |  |  |  |  |  | die "Unable to connect to asterisk" unless ($astman); | 
| 444 |  |  |  |  |  |  |  | 
| 445 |  |  |  |  |  |  | sub do_event { | 
| 446 |  |  |  |  |  |  | my ($asterisk, $event) = @_; | 
| 447 |  |  |  |  |  |  |  | 
| 448 |  |  |  |  |  |  | print 'Yeah! Event Type: ' . $event->{'Event'} . "\r\n"; | 
| 449 |  |  |  |  |  |  | } | 
| 450 |  |  |  |  |  |  |  | 
| 451 |  |  |  |  |  |  | sub do_hangup { | 
| 452 |  |  |  |  |  |  | my ($asterisk, $event) = @_; | 
| 453 |  |  |  |  |  |  | print 'Channel ' . $event->{'Channel'} . ' Hungup because ' . $event->{'Cause-txt'} . "\r\n"; | 
| 454 |  |  |  |  |  |  | } | 
| 455 |  |  |  |  |  |  |  | 
| 456 |  |  |  |  |  |  | #Start some event loop | 
| 457 |  |  |  |  |  |  | someloop; | 
| 458 |  |  |  |  |  |  |  | 
| 459 |  |  |  |  |  |  | =head2 How to use in an event-based application | 
| 460 |  |  |  |  |  |  |  | 
| 461 |  |  |  |  |  |  | Getting this module to work with your event based application is really easy so long as you are running an | 
| 462 |  |  |  |  |  |  | event-loop that is supported by AnyEvent. Below is a simple example of how to use this module with your | 
| 463 |  |  |  |  |  |  | preferred event loop. We will use EV as our event loop in this example. I use subroutine references in this | 
| 464 |  |  |  |  |  |  | example, but you could use anonymous subroutines if you want to. | 
| 465 |  |  |  |  |  |  |  | 
| 466 |  |  |  |  |  |  | #Use your preferred loop before our module so that AnyEvent will auto-detect it | 
| 467 |  |  |  |  |  |  | use EV; | 
| 468 |  |  |  |  |  |  | use Asterisk::AMI: | 
| 469 |  |  |  |  |  |  |  | 
| 470 |  |  |  |  |  |  | #Create your connection | 
| 471 |  |  |  |  |  |  | my $astman = Asterisk::AMI->new(PeerAddr => '127.0.0.1', | 
| 472 |  |  |  |  |  |  | PeerPort => '5038', | 
| 473 |  |  |  |  |  |  | Username => 'admin', | 
| 474 |  |  |  |  |  |  | Secret => 'supersecret', | 
| 475 |  |  |  |  |  |  | Events => 'on', | 
| 476 |  |  |  |  |  |  | Handlers => { default => \&eventhandler } | 
| 477 |  |  |  |  |  |  | ); | 
| 478 |  |  |  |  |  |  | #Alternatively you can set Blocking => 0, and set an on_error sub to catch connection errors | 
| 479 |  |  |  |  |  |  | die "Unable to connect to asterisk" unless ($astman); | 
| 480 |  |  |  |  |  |  |  | 
| 481 |  |  |  |  |  |  | #Define the subroutines for events | 
| 482 |  |  |  |  |  |  | sub eventhandler { my ($ami, $event) = @_; print 'Got Event: ',$event->{'Event'},"\r\n"; } | 
| 483 |  |  |  |  |  |  |  | 
| 484 |  |  |  |  |  |  | #Define a subroutine for your action callback | 
| 485 |  |  |  |  |  |  | sub actioncb { my ($ami, $response) = @_; print 'Got Action Reponse: ',$response->{'Response'},"\r\n"; } | 
| 486 |  |  |  |  |  |  |  | 
| 487 |  |  |  |  |  |  | #Send an action | 
| 488 |  |  |  |  |  |  | my $action = $astman->({ Action => 'Ping' }, \&actioncb); | 
| 489 |  |  |  |  |  |  |  | 
| 490 |  |  |  |  |  |  | #Do all of you other eventy stuff here, or before all this stuff, whichever .............. | 
| 491 |  |  |  |  |  |  |  | 
| 492 |  |  |  |  |  |  | #Start our loop | 
| 493 |  |  |  |  |  |  | EV::loop | 
| 494 |  |  |  |  |  |  |  | 
| 495 |  |  |  |  |  |  |  | 
| 496 |  |  |  |  |  |  |  | 
| 497 |  |  |  |  |  |  | That's it, the EV loop will allow us to process input from asterisk. Once the action completes it will | 
| 498 |  |  |  |  |  |  | call the callback, and any events will be dispatched to eventhandler(). As you can see it is fairly | 
| 499 |  |  |  |  |  |  | straight-forward. Most of the work will be in creating subroutines to be called for various events and | 
| 500 |  |  |  |  |  |  | actions that you plan to use. | 
| 501 |  |  |  |  |  |  |  | 
| 502 |  |  |  |  |  |  | =head2 Methods | 
| 503 |  |  |  |  |  |  |  | 
| 504 |  |  |  |  |  |  | send_action ( ACTION, [ [ CALLBACK ], [ TIMEOUT ], [ USERDATA ] ] ) | 
| 505 |  |  |  |  |  |  |  | 
| 506 |  |  |  |  |  |  | Sends the action to asterisk, where ACTION is a hash reference. If no errors occurred while sending it returns | 
| 507 |  |  |  |  |  |  | the ActionID for the action, which is a positive integer above 0. If it encounters an error it will return undef. | 
| 508 |  |  |  |  |  |  | CALLBACK is optional and should be a subroutine reference or any anonymous subroutine. TIMEOUT is optional and | 
| 509 |  |  |  |  |  |  | only has an affect if a CALLBACK is specified. USERDATA is optional and is a perl variable that will be passed to | 
| 510 |  |  |  |  |  |  | the CALLBACK in addition to the response. | 
| 511 |  |  |  |  |  |  |  | 
| 512 |  |  |  |  |  |  | The use of the CALLBACK and TIMEOUT keys in the ACTION has been deprecated. | 
| 513 |  |  |  |  |  |  |  | 
| 514 |  |  |  |  |  |  | check_response( [ ACTIONID ], [ TIMEOUT ] ) | 
| 515 |  |  |  |  |  |  |  | 
| 516 |  |  |  |  |  |  | Returns 1 if the action was considered successful, 0 if it failed, or undef on timeout or error. If no ACTIONID | 
| 517 |  |  |  |  |  |  | is specified the ACTIONID of the last action sent will be used. If no TIMEOUT is given it blocks, reading in | 
| 518 |  |  |  |  |  |  | packets until the action completes. This will remove a response from the buffer. | 
| 519 |  |  |  |  |  |  |  | 
| 520 |  |  |  |  |  |  | get_response ( [ ACTIONID ], [ TIMEOUT ] ) | 
| 521 |  |  |  |  |  |  |  | 
| 522 |  |  |  |  |  |  | Returns the response object for the action. Returns undef on error or timeout. | 
| 523 |  |  |  |  |  |  | If no ACTIONID is specified the ACTIONID of the last action sent will be used. If no TIMEOUT is given it | 
| 524 |  |  |  |  |  |  | blocks, reading in packets until the action completes. This will remove the response from the buffer. | 
| 525 |  |  |  |  |  |  |  | 
| 526 |  |  |  |  |  |  | action ( ACTION [, TIMEOUT ] ) | 
| 527 |  |  |  |  |  |  |  | 
| 528 |  |  |  |  |  |  | Sends the action and returns the response object for the action. Returns undef on error or timeout. | 
| 529 |  |  |  |  |  |  | If no ACTIONID is specified the ACTIONID of the last action sent will be used. | 
| 530 |  |  |  |  |  |  | If no TIMEOUT is given it blocks, reading in packets until the action completes. This will remove the | 
| 531 |  |  |  |  |  |  | response from the buffer. | 
| 532 |  |  |  |  |  |  |  | 
| 533 |  |  |  |  |  |  | simple_action ( ACTION [, TIMEOUT ] ) | 
| 534 |  |  |  |  |  |  |  | 
| 535 |  |  |  |  |  |  | Sends the action and returns 1 if the action was considered successful, 0 if it failed, or undef on error | 
| 536 |  |  |  |  |  |  | and timeout. If no ACTIONID is specified the ACTIONID of the last action sent will be used. If no TIMEOUT is | 
| 537 |  |  |  |  |  |  | given it blocks, reading in packets until the action completes. This will remove the response from the buffer. | 
| 538 |  |  |  |  |  |  |  | 
| 539 |  |  |  |  |  |  | disconnect () | 
| 540 |  |  |  |  |  |  |  | 
| 541 |  |  |  |  |  |  | Logoff and disconnects from the AMI. Returns 1 on success and 0 if any errors were encountered. | 
| 542 |  |  |  |  |  |  |  | 
| 543 |  |  |  |  |  |  | get_event ( [ TIMEOUT ] ) | 
| 544 |  |  |  |  |  |  |  | 
| 545 |  |  |  |  |  |  | This returns the first event object in the buffer, or if no events are in the buffer it reads in packets | 
| 546 |  |  |  |  |  |  | waiting for an event. It will return undef if an error occurs. | 
| 547 |  |  |  |  |  |  | If no TIMEOUT is given it blocks, reading in packets until an event arrives. | 
| 548 |  |  |  |  |  |  |  | 
| 549 |  |  |  |  |  |  | amiver () | 
| 550 |  |  |  |  |  |  |  | 
| 551 |  |  |  |  |  |  | Returns the version of the Asterisk Manager Interface we are connected to. Undef until the connection is made | 
| 552 |  |  |  |  |  |  | (important if you have Blocking => 0). | 
| 553 |  |  |  |  |  |  |  | 
| 554 |  |  |  |  |  |  |  | 
| 555 |  |  |  |  |  |  | connected ( [ TIMEOUT ] ) | 
| 556 |  |  |  |  |  |  |  | 
| 557 |  |  |  |  |  |  | This checks the connection to the AMI to ensure it is still functional. It checks at the socket layer and | 
| 558 |  |  |  |  |  |  | also sends a 'PING' to the AMI to ensure it is still responding. If no TIMEOUT is given this will block | 
| 559 |  |  |  |  |  |  | waiting for a response. | 
| 560 |  |  |  |  |  |  |  | 
| 561 |  |  |  |  |  |  | Returns 1 if the connection is good, 0 if it is not. | 
| 562 |  |  |  |  |  |  |  | 
| 563 |  |  |  |  |  |  | error () | 
| 564 |  |  |  |  |  |  |  | 
| 565 |  |  |  |  |  |  | Returns 1 if there are currently errors on the socket, 0 if everything is ok. | 
| 566 |  |  |  |  |  |  |  | 
| 567 |  |  |  |  |  |  | destroy ( [ FATAL ] ) | 
| 568 |  |  |  |  |  |  |  | 
| 569 |  |  |  |  |  |  | Destroys the contents of all buffers and removes any current callbacks that are set. If FATAL is true | 
| 570 |  |  |  |  |  |  | it will also destroy our IO handle and its associated watcher. Mostly used internally. Useful if you want to | 
| 571 |  |  |  |  |  |  | ensure that our IO handle watcher gets removed. | 
| 572 |  |  |  |  |  |  |  | 
| 573 |  |  |  |  |  |  | loop () | 
| 574 |  |  |  |  |  |  |  | 
| 575 |  |  |  |  |  |  | Starts an eventloop via AnyEvent. | 
| 576 |  |  |  |  |  |  |  | 
| 577 |  |  |  |  |  |  | =head1 See Also | 
| 578 |  |  |  |  |  |  |  | 
| 579 |  |  |  |  |  |  | AnyEvent, Asterisk::AMI::Common, Asterisk::AMI::Common::Dev | 
| 580 |  |  |  |  |  |  |  | 
| 581 |  |  |  |  |  |  | =head1 AUTHOR | 
| 582 |  |  |  |  |  |  |  | 
| 583 |  |  |  |  |  |  | Ryan Bullock (rrb3942@gmail.com) | 
| 584 |  |  |  |  |  |  |  | 
| 585 |  |  |  |  |  |  | =head1 BUG REPORTING AND FEEDBACK | 
| 586 |  |  |  |  |  |  |  | 
| 587 |  |  |  |  |  |  | Please report any bugs or errors to our github issue tracker at http://github.com/rrb3942/perl-Asterisk-AMI/issues or | 
| 588 |  |  |  |  |  |  | the cpan request tracker at https://rt.cpan.org/Public/Bug/Report.html?Queue=perl-Asterisk-AMI | 
| 589 |  |  |  |  |  |  |  | 
| 590 |  |  |  |  |  |  | =head1 LICENSE | 
| 591 |  |  |  |  |  |  |  | 
| 592 |  |  |  |  |  |  | Copyright (C) 2011 by Ryan Bullock (rrb3942@gmail.com) | 
| 593 |  |  |  |  |  |  |  | 
| 594 |  |  |  |  |  |  | This module is free software.  You can redistribute it and/or modify it under the terms of the Artistic License 2.0. | 
| 595 |  |  |  |  |  |  |  | 
| 596 |  |  |  |  |  |  | This program is distributed in the hope that it will be useful, but without any warranty; without even the implied | 
| 597 |  |  |  |  |  |  | warranty of merchantability or fitness for a particular purpose. | 
| 598 |  |  |  |  |  |  |  | 
| 599 |  |  |  |  |  |  | =cut | 
| 600 |  |  |  |  |  |  |  | 
| 601 |  |  |  |  |  |  | package Asterisk::AMI; | 
| 602 |  |  |  |  |  |  |  | 
| 603 |  |  |  |  |  |  | #Register warnings | 
| 604 | 1 |  |  | 1 |  | 31042 | use warnings::register; | 
|  | 1 |  |  |  |  | 4 |  | 
|  | 1 |  |  |  |  | 200 |  | 
| 605 |  |  |  |  |  |  |  | 
| 606 | 1 |  |  | 1 |  | 6 | use strict; | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 80 |  | 
| 607 | 1 |  |  | 1 |  | 7 | use warnings; | 
|  | 1 |  |  |  |  | 6 |  | 
|  | 1 |  |  |  |  | 43 |  | 
| 608 |  |  |  |  |  |  |  | 
| 609 | 1 |  |  | 1 |  | 3918 | use AnyEvent; | 
|  | 1 |  |  |  |  | 7599 |  | 
|  | 1 |  |  |  |  | 43 |  | 
| 610 | 1 |  |  | 1 |  | 1634 | use AnyEvent::Handle; | 
|  | 1 |  |  |  |  | 36708 |  | 
|  | 1 |  |  |  |  | 47 |  | 
| 611 | 1 |  |  | 1 |  | 1456 | use AnyEvent::Socket; | 
|  | 1 |  |  |  |  | 26327 |  | 
|  | 1 |  |  |  |  | 177 |  | 
| 612 | 1 |  |  | 1 |  | 13 | use Digest::MD5; | 
|  | 1 |  |  |  |  | 1 |  | 
|  | 1 |  |  |  |  | 45 |  | 
| 613 | 1 |  |  | 1 |  | 5 | use Scalar::Util qw/weaken/; | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 109 |  | 
| 614 | 1 |  |  | 1 |  | 6 | use Carp qw/carp/; | 
|  | 1 |  |  |  |  | 1 |  | 
|  | 1 |  |  |  |  | 50 |  | 
| 615 |  |  |  |  |  |  |  | 
| 616 |  |  |  |  |  |  | #Duh | 
| 617 | 1 |  |  | 1 |  | 2450 | use version 0.77; our $VERSION = version->declare("v0.2.7_1"); | 
|  | 1 |  |  |  |  | 4711 |  | 
|  | 1 |  |  |  |  | 189 |  | 
| 618 |  |  |  |  |  |  |  | 
| 619 |  |  |  |  |  |  | #Used for storing events while reading command responses Events are stored as hashes in the array Example | 
| 620 |  |  |  |  |  |  | #$self->{EVETNBUFFER}->{'Event'} = Something | 
| 621 |  |  |  |  |  |  |  | 
| 622 |  |  |  |  |  |  | #Buffer for holding action responses and data | 
| 623 |  |  |  |  |  |  | # Structure: $self->{RESPONSEBUFFER}->{'ActionID'}->{'Response'}        = (Success|Failure|Follows|Goodbye|Pong|Etc..) | 
| 624 |  |  |  |  |  |  | # //Reponse Status | 
| 625 |  |  |  |  |  |  | #                             {'Message'} = Message //Message in the response {'EVENTS'} = [%hash1, %hash2, ..]  //Arry | 
| 626 |  |  |  |  |  |  | #                             of Hashes of parsed events and data for this actionID {'PARSED'} = { Hashkey => value, | 
| 627 |  |  |  |  |  |  | #                             ...} {'COMPLETED'} = 0 or 1 //If the command is completed {'GOOD'} = 0 or 1 //if this | 
| 628 |  |  |  |  |  |  | #                             responses is good, no error, can only be 1 if also COMPLETED | 
| 629 |  |  |  |  |  |  |  | 
| 630 |  |  |  |  |  |  | #Create a new object and return it; If required options are missing, returns undef | 
| 631 |  |  |  |  |  |  | sub new { | 
| 632 | 0 |  |  | 0 | 1 |  | my ($class, %values) = @_; | 
| 633 |  |  |  |  |  |  |  | 
| 634 | 0 |  |  |  |  |  | my $self = bless {}, $class; | 
| 635 |  |  |  |  |  |  |  | 
| 636 |  |  |  |  |  |  | #Configure our new object and connect, else return undef | 
| 637 | 0 | 0 | 0 |  |  |  | if ($self->_configure(%values) && $self->_connect()) { | 
| 638 | 0 |  |  |  |  |  | return $self; | 
| 639 |  |  |  |  |  |  | } | 
| 640 |  |  |  |  |  |  |  | 
| 641 | 0 |  |  |  |  |  | return; | 
| 642 |  |  |  |  |  |  | } | 
| 643 |  |  |  |  |  |  |  | 
| 644 |  |  |  |  |  |  | #Used by anyevent to load our read type | 
| 645 |  |  |  |  |  |  | sub anyevent_read_type { | 
| 646 |  |  |  |  |  |  |  | 
| 647 | 0 |  |  | 0 | 0 |  | my ($hdl, $cb) = @_; | 
| 648 |  |  |  |  |  |  |  | 
| 649 |  |  |  |  |  |  | return sub { | 
| 650 | 0 | 0 |  | 0 |  |  | if ($hdl->{rbuf} =~ s/^(.+)(?:\015\012\015\012)//sox) { | 
| 651 | 0 |  |  |  |  |  | $cb->($hdl, $1); | 
| 652 |  |  |  |  |  |  | } | 
| 653 |  |  |  |  |  |  |  | 
| 654 | 0 |  |  |  |  |  | return 0; | 
| 655 |  |  |  |  |  |  | } | 
| 656 | 0 |  |  |  |  |  | } | 
| 657 |  |  |  |  |  |  |  | 
| 658 |  |  |  |  |  |  | #Sets variables for this object Also checks for minimum settings Returns 1 if everything was set, 0 if options were | 
| 659 |  |  |  |  |  |  | #missing | 
| 660 |  |  |  |  |  |  | sub _configure { | 
| 661 | 0 |  |  | 0 |  |  | my ($self, %config) = @_; | 
| 662 |  |  |  |  |  |  |  | 
| 663 |  |  |  |  |  |  | #Required settings | 
| 664 | 0 |  |  |  |  |  | my @required = ( 'USERNAME', 'SECRET' ); | 
| 665 |  |  |  |  |  |  |  | 
| 666 |  |  |  |  |  |  | #Defaults | 
| 667 | 0 |  |  |  |  |  | my %defaults = (        PEERADDR => '127.0.0.1', | 
| 668 |  |  |  |  |  |  | PEERPORT => 5038, | 
| 669 |  |  |  |  |  |  | AUTHTYPE => 'plaintext', | 
| 670 |  |  |  |  |  |  | EVENTS => 'off', | 
| 671 |  |  |  |  |  |  | BUFFERSIZE => 30000, | 
| 672 |  |  |  |  |  |  | BLOCKING => 1 | 
| 673 |  |  |  |  |  |  | ); | 
| 674 |  |  |  |  |  |  |  | 
| 675 |  |  |  |  |  |  | #Create list of all options and acceptable values | 
| 676 | 0 |  |  |  |  |  | my %config_options = (  ORIGINATEHACK => 'bool', | 
| 677 |  |  |  |  |  |  | USESSL => 'bool', | 
| 678 |  |  |  |  |  |  | PEERADDR => '', | 
| 679 |  |  |  |  |  |  | PEERPORT => 'num', | 
| 680 |  |  |  |  |  |  | USERNAME => '', | 
| 681 |  |  |  |  |  |  | SECRET => '', | 
| 682 |  |  |  |  |  |  | EVENTS => '', | 
| 683 |  |  |  |  |  |  | TIMEOUT => 'num', | 
| 684 |  |  |  |  |  |  | KEEPALIVE => 'num', | 
| 685 |  |  |  |  |  |  | TCP_KEEPALIVE => 'bool', | 
| 686 |  |  |  |  |  |  | BUFFERSIZE => 'num', | 
| 687 |  |  |  |  |  |  | HANDLERS => 'HASH', | 
| 688 |  |  |  |  |  |  | BLOCKING => 'bool', | 
| 689 |  |  |  |  |  |  | AUTHTYPE => 'md5|plaintext', | 
| 690 |  |  |  |  |  |  | ON_CONNECT => 'CODE', | 
| 691 |  |  |  |  |  |  | ON_CONNECT_ERR => 'CODE', | 
| 692 |  |  |  |  |  |  | ON_ERROR => 'CODE', | 
| 693 |  |  |  |  |  |  | ON_DISCONNECT => 'CODE', | 
| 694 |  |  |  |  |  |  | ON_TIMEOUT => 'CODE' | 
| 695 |  |  |  |  |  |  | ); | 
| 696 |  |  |  |  |  |  |  | 
| 697 |  |  |  |  |  |  | #Config Validation + Setting | 
| 698 | 0 |  |  |  |  |  | while (my ($key, $val) = each(%config)) { | 
| 699 | 0 |  |  |  |  |  | my $opt = uc($key); | 
| 700 |  |  |  |  |  |  |  | 
| 701 |  |  |  |  |  |  | #Unknown keys | 
| 702 | 0 | 0 |  |  |  |  | if (!exists $config_options{$opt}) { | 
|  |  | 0 |  |  |  |  |  | 
| 703 | 0 | 0 |  |  |  |  | carp "Unknown constructor option: $key" if warnings::enabled('Asterisk::AMI'); | 
| 704 | 0 |  |  |  |  |  | next; | 
| 705 |  |  |  |  |  |  | #Undef values | 
| 706 |  |  |  |  |  |  | } elsif (!defined $val) { | 
| 707 | 0 |  |  |  |  |  | next; | 
| 708 |  |  |  |  |  |  | } | 
| 709 |  |  |  |  |  |  |  | 
| 710 |  |  |  |  |  |  | #Check for correct reference types | 
| 711 | 0 | 0 |  |  |  |  | if (ref($val) ne $config_options{$opt}) { | 
|  |  | 0 |  |  |  |  |  | 
| 712 |  |  |  |  |  |  |  | 
| 713 |  |  |  |  |  |  | #If they are ref types then fail | 
| 714 | 0 | 0 |  |  |  |  | if ($config_options{$opt} eq 'CODE') { | 
|  |  | 0 |  |  |  |  |  | 
| 715 | 0 | 0 |  |  |  |  | carp "Constructor option \'$key\' requires an anonymous subroutine or a subroutine reference" if warnings::enabled('Asterisk::AMI'); | 
| 716 | 0 |  |  |  |  |  | return; | 
| 717 |  |  |  |  |  |  | } elsif ($config_options{$opt} eq 'HASH') { | 
| 718 | 0 | 0 |  |  |  |  | carp "Constructor option \'$key\' requires a hash reference" if warnings::enabled('Asterisk::AMI'); | 
| 719 | 0 |  |  |  |  |  | return; | 
| 720 |  |  |  |  |  |  | } | 
| 721 |  |  |  |  |  |  |  | 
| 722 |  |  |  |  |  |  | #Boolean values | 
| 723 | 0 | 0 |  |  |  |  | if ($config_options{$opt} eq 'bool') { | 
|  |  | 0 |  |  |  |  |  | 
| 724 | 0 | 0 | 0 |  |  |  | if ($val =~ /[^\d]/x || ($val != 0 && $val != 1)) { | 
|  |  |  | 0 |  |  |  |  | 
| 725 | 0 | 0 |  |  |  |  | carp "Constructor option \'$key\' requires a boolean value (0 or 1)" if warnings::enabled('Asterisk::AMI'); | 
| 726 | 0 |  |  |  |  |  | return; | 
| 727 |  |  |  |  |  |  | } | 
| 728 |  |  |  |  |  |  | #Numeric values | 
| 729 |  |  |  |  |  |  | } elsif ($config_options{$opt} eq 'num') { | 
| 730 | 0 | 0 |  |  |  |  | if ($val =~ /[^\d]/x) { | 
| 731 | 0 | 0 |  |  |  |  | carp "Constructor option \'$key\' requires a numeric value" if warnings::enabled('Asterisk::AMI'); | 
| 732 | 0 |  |  |  |  |  | return; | 
| 733 |  |  |  |  |  |  | } | 
| 734 |  |  |  |  |  |  | #Hard coded list of options | 
| 735 |  |  |  |  |  |  | } else { | 
| 736 | 0 |  |  |  |  |  | my $lval = lc($val); | 
| 737 |  |  |  |  |  |  |  | 
| 738 | 0 |  |  |  |  |  | my @match = grep { $lval eq $_ } split /\|/x,$config_options{$opt}; | 
|  | 0 |  |  |  |  |  |  | 
| 739 |  |  |  |  |  |  |  | 
| 740 | 0 | 0 |  |  |  |  | if (!@match) { | 
| 741 | 0 | 0 |  |  |  |  | carp "Constructor option \'$key\' requires one of the following options: $config_options{$opt}" if warnings::enabled('Asterisk::AMI'); | 
| 742 | 0 |  |  |  |  |  | return; | 
| 743 |  |  |  |  |  |  | } else { | 
| 744 |  |  |  |  |  |  | #lowercase it for consistency | 
| 745 | 0 |  |  |  |  |  | $val = $lval; | 
| 746 |  |  |  |  |  |  | } | 
| 747 |  |  |  |  |  |  | } | 
| 748 |  |  |  |  |  |  |  | 
| 749 |  |  |  |  |  |  | #Ensure all handlers are sub refs | 
| 750 |  |  |  |  |  |  | } elsif ($opt eq 'HANDLERS') { | 
| 751 | 0 |  |  |  |  |  | while (my ($event, $handler) = each %{$val}) { | 
|  | 0 |  |  |  |  |  |  | 
| 752 | 0 | 0 |  |  |  |  | if (ref($handler) ne 'CODE') { | 
| 753 | 0 | 0 |  |  |  |  | carp "Handler for event type \'$event\' must be an anonymous subroutine or a subroutine reference" if warnings::enabled('Asterisk::AMI'); | 
| 754 | 0 |  |  |  |  |  | return; | 
| 755 |  |  |  |  |  |  | } | 
| 756 |  |  |  |  |  |  | } | 
| 757 |  |  |  |  |  |  | } | 
| 758 |  |  |  |  |  |  |  | 
| 759 | 0 |  |  |  |  |  | $self->{CONFIG}->{$opt} = $val; | 
| 760 |  |  |  |  |  |  | } | 
| 761 |  |  |  |  |  |  |  | 
| 762 |  |  |  |  |  |  |  | 
| 763 |  |  |  |  |  |  | #Check for required options | 
| 764 | 0 |  |  |  |  |  | foreach my $req (@required) { | 
| 765 | 0 | 0 |  |  |  |  | if (!exists $self->{CONFIG}->{$req}) { | 
| 766 | 0 | 0 |  |  |  |  | carp "Must supply a username and secret for connecting to asterisk" if warnings::enabled('Asterisk::AMI'); | 
| 767 | 0 |  |  |  |  |  | return; | 
| 768 |  |  |  |  |  |  | } | 
| 769 |  |  |  |  |  |  | } | 
| 770 |  |  |  |  |  |  |  | 
| 771 |  |  |  |  |  |  | #Change default port if using ssl | 
| 772 | 0 | 0 |  |  |  |  | if ($self->{CONFIG}->{USESSL}) { | 
| 773 | 0 |  |  |  |  |  | $defaults{PEERPORT} = 5039; | 
| 774 |  |  |  |  |  |  | } | 
| 775 |  |  |  |  |  |  |  | 
| 776 |  |  |  |  |  |  | #Assign defaults for any missing options | 
| 777 | 0 |  |  |  |  |  | while (my ($opt, $val) = each(%defaults)) { | 
| 778 | 0 | 0 |  |  |  |  | if (!defined $self->{CONFIG}->{$opt}) { | 
| 779 | 0 |  |  |  |  |  | $self->{CONFIG}->{$opt} = $val; | 
| 780 |  |  |  |  |  |  | } | 
| 781 |  |  |  |  |  |  | } | 
| 782 |  |  |  |  |  |  |  | 
| 783 |  |  |  |  |  |  | #Make adjustments for Originate Async bullscrap | 
| 784 | 0 | 0 |  |  |  |  | if ($self->{CONFIG}->{ORIGINATEHACK}) { | 
| 785 |  |  |  |  |  |  | #Turn on call events, otherwise we wont get the Async response | 
| 786 | 0 | 0 |  |  |  |  | if (lc($self->{CONFIG}->{EVENTS}) eq 'off') { | 
|  |  | 0 |  |  |  |  |  | 
| 787 | 0 |  |  |  |  |  | $self->{CONFIG}->{EVENTS} = 'call'; | 
| 788 |  |  |  |  |  |  | #Fake event type so that we will discard events, else by turning on events our event buffer | 
| 789 |  |  |  |  |  |  | #Will just continue to fill up. | 
| 790 | 0 | 0 |  | 0 |  |  | $self->{CONFIG}->{HANDLERS} = { 'JUSTMAKETHEHASHNOTEMPTY' => sub {} } unless ($self->{CONFIG}->{HANDLERS}); | 
|  | 0 |  |  |  |  |  |  | 
| 791 |  |  |  |  |  |  | #They already turned events on, just add call types to it, assume they are doing something with events | 
| 792 |  |  |  |  |  |  | #and don't mess with the handlers | 
| 793 |  |  |  |  |  |  | } elsif (lc($self->{CONFIG}->{EVENTS}) !~ /on|call/x) { | 
| 794 | 0 |  |  |  |  |  | $self->{CONFIG}->{EVENTS} .= ',call'; | 
| 795 |  |  |  |  |  |  | } | 
| 796 |  |  |  |  |  |  | } | 
| 797 |  |  |  |  |  |  |  | 
| 798 |  |  |  |  |  |  | #Initialize the seq number | 
| 799 | 0 |  |  |  |  |  | $self->{idseq} = 1; | 
| 800 |  |  |  |  |  |  |  | 
| 801 |  |  |  |  |  |  | #Weaken reference for use in anonsub | 
| 802 | 0 |  |  |  |  |  | weaken($self); | 
| 803 |  |  |  |  |  |  |  | 
| 804 |  |  |  |  |  |  | #Set keepalive | 
| 805 | 0 | 0 |  | 0 |  |  | $self->{CONFIG}->{KEEPALIVE} = AE::timer($self->{CONFIG}->{KEEPALIVE}, $self->{CONFIG}->{KEEPALIVE}, sub { $self->_send_keepalive }) if ($self->{CONFIG}->{KEEPALIVE}); | 
|  | 0 |  |  |  |  |  |  | 
| 806 |  |  |  |  |  |  |  | 
| 807 | 0 |  |  |  |  |  | return 1; | 
| 808 |  |  |  |  |  |  | } | 
| 809 |  |  |  |  |  |  |  | 
| 810 |  |  |  |  |  |  | #Handles connection failures (includes login failure); | 
| 811 |  |  |  |  |  |  | sub _on_connect_err { | 
| 812 |  |  |  |  |  |  |  | 
| 813 | 0 |  |  | 0 |  |  | my ($self, $message) = @_; | 
| 814 |  |  |  |  |  |  |  | 
| 815 | 0 |  |  |  |  |  | warnings::warnif('Asterisk::AMI', "Failed to connect to asterisk - $self->{CONFIG}->{PEERADDR}:$self->{CONFIG}->{PEERPORT}"); | 
| 816 | 0 |  |  |  |  |  | warnings::warnif('Asterisk::AMI', "Error Message: $message"); | 
| 817 |  |  |  |  |  |  |  | 
| 818 |  |  |  |  |  |  | #Dispatch all callbacks as if they timed out | 
| 819 | 0 |  |  |  |  |  | $self->_clear_cbs(); | 
| 820 |  |  |  |  |  |  |  | 
| 821 | 0 | 0 |  |  |  |  | if (exists $self->{CONFIG}->{ON_CONNECT_ERR}) { | 
|  |  | 0 |  |  |  |  |  | 
| 822 | 0 |  |  |  |  |  | $self->{CONFIG}->{ON_CONNECT_ERR}->($self, $message); | 
| 823 |  |  |  |  |  |  | } elsif (exists $self->{CONFIG}->{ON_ERROR}) { | 
| 824 | 0 |  |  |  |  |  | $self->{CONFIG}->{ON_ERROR}->($self, $message); | 
| 825 |  |  |  |  |  |  | } | 
| 826 |  |  |  |  |  |  |  | 
| 827 | 0 |  |  |  |  |  | $self->{SOCKERR} = 1; | 
| 828 |  |  |  |  |  |  |  | 
| 829 | 0 |  |  |  |  |  | $self->destroy(); | 
| 830 |  |  |  |  |  |  |  | 
| 831 | 0 |  |  |  |  |  | return; | 
| 832 |  |  |  |  |  |  | } | 
| 833 |  |  |  |  |  |  |  | 
| 834 |  |  |  |  |  |  | #Handles other errors on the socket | 
| 835 |  |  |  |  |  |  | sub _on_error { | 
| 836 |  |  |  |  |  |  |  | 
| 837 | 0 |  |  | 0 |  |  | my ($self, $message) = @_; | 
| 838 |  |  |  |  |  |  |  | 
| 839 | 0 |  |  |  |  |  | warnings::warnif('Asterisk::AMI', "Received Error on socket - $self->{CONFIG}->{PEERADDR}:$self->{CONFIG}->{PEERPORT}"); | 
| 840 | 0 |  |  |  |  |  | warnings::warnif('Asterisk::AMI', "Error Message: $message"); | 
| 841 |  |  |  |  |  |  |  | 
| 842 |  |  |  |  |  |  | #Call all cbs as if they had timed out | 
| 843 | 0 |  |  |  |  |  | $self->_clear_cbs(); | 
| 844 |  |  |  |  |  |  |  | 
| 845 | 0 | 0 |  |  |  |  | $self->{CONFIG}->{ON_ERROR}->($self, $message) if (exists $self->{CONFIG}->{ON_ERROR}); | 
| 846 |  |  |  |  |  |  |  | 
| 847 | 0 |  |  |  |  |  | $self->{SOCKERR} = 1; | 
| 848 |  |  |  |  |  |  |  | 
| 849 | 0 |  |  |  |  |  | $self->destroy(); | 
| 850 |  |  |  |  |  |  |  | 
| 851 | 0 |  |  |  |  |  | return; | 
| 852 |  |  |  |  |  |  | } | 
| 853 |  |  |  |  |  |  |  | 
| 854 |  |  |  |  |  |  | #Handles the remote end disconnecting | 
| 855 |  |  |  |  |  |  | sub _on_disconnect { | 
| 856 |  |  |  |  |  |  |  | 
| 857 | 0 |  |  | 0 |  |  | my ($self) = @_; | 
| 858 |  |  |  |  |  |  |  | 
| 859 | 0 |  |  |  |  |  | my $message = "Remote end disconnected - $self->{CONFIG}->{PEERADDR}:$self->{CONFIG}->{PEERPORT}"; | 
| 860 | 0 |  |  |  |  |  | warnings::warnif('Asterisk::AMI', "Remote Asterisk Server ended connection - $self->{CONFIG}->{PEERADDR}:$self->{CONFIG}->{PEERPORT}"); | 
| 861 |  |  |  |  |  |  |  | 
| 862 |  |  |  |  |  |  | #Call all callbacks as if they had timed out | 
| 863 | 0 |  |  |  |  |  | _ | 
| 864 |  |  |  |  |  |  | $self->_clear_cbs(); | 
| 865 |  |  |  |  |  |  |  | 
| 866 | 0 | 0 |  |  |  |  | if (exists $self->{CONFIG}->{ON_DISCONNECT}) { | 
|  |  | 0 |  |  |  |  |  | 
| 867 | 0 |  |  |  |  |  | $self->{CONFIG}->{ON_DISCONNECT}->($self, $message); | 
| 868 |  |  |  |  |  |  | } elsif (exists $self->{CONFIG}->{ON_ERROR}) { | 
| 869 | 0 |  |  |  |  |  | $self->{CONFIG}->{ON_ERROR}->($self, $message); | 
| 870 |  |  |  |  |  |  | } | 
| 871 |  |  |  |  |  |  |  | 
| 872 | 0 |  |  |  |  |  | $self->{SOCKERR} = 1; | 
| 873 |  |  |  |  |  |  |  | 
| 874 | 0 |  |  |  |  |  | $self->destroy(); | 
| 875 |  |  |  |  |  |  |  | 
| 876 | 0 |  |  |  |  |  | return; | 
| 877 |  |  |  |  |  |  | } | 
| 878 |  |  |  |  |  |  |  | 
| 879 |  |  |  |  |  |  | #What happens if our keep alive times out | 
| 880 |  |  |  |  |  |  | sub _on_timeout { | 
| 881 | 0 |  |  | 0 |  |  | my ($self, $message) = @_; | 
| 882 |  |  |  |  |  |  |  | 
| 883 | 0 |  |  |  |  |  | warnings::warnif('Asterisk::AMI', $message); | 
| 884 |  |  |  |  |  |  |  | 
| 885 | 0 | 0 |  |  |  |  | if (exists $self->{CONFIG}->{ON_TIMEOUT}) { | 
|  |  | 0 |  |  |  |  |  | 
| 886 | 0 |  |  |  |  |  | $self->{CONFIG}->{ON_TIMEOUT}->($self, $message); | 
| 887 |  |  |  |  |  |  | } elsif (exists $self->{CONFIG}->{ON_ERROR}) { | 
| 888 | 0 |  |  |  |  |  | $self->{CONFIG}->{ON_ERROR}->($self, $message); | 
| 889 |  |  |  |  |  |  | } | 
| 890 |  |  |  |  |  |  |  | 
| 891 | 0 |  |  |  |  |  | $self->{SOCKERR} = 1; | 
| 892 |  |  |  |  |  |  |  | 
| 893 | 0 |  |  |  |  |  | return; | 
| 894 |  |  |  |  |  |  | } | 
| 895 |  |  |  |  |  |  |  | 
| 896 |  |  |  |  |  |  | #Things to do after our initial connect | 
| 897 |  |  |  |  |  |  | sub _on_connect { | 
| 898 |  |  |  |  |  |  |  | 
| 899 | 0 |  |  | 0 |  |  | my ($self, $fh, $line) = @_; | 
| 900 |  |  |  |  |  |  |  | 
| 901 | 0 | 0 |  |  |  |  | if ($line =~ /^Asterisk\ Call\ Manager\/([0-9]\.[0-9])$/ox) { | 
| 902 | 0 |  |  |  |  |  | $self->{AMIVER} = $1; | 
| 903 |  |  |  |  |  |  | } else { | 
| 904 | 0 |  |  |  |  |  | warnings::warnif('Asterisk::AMI', "Unknown Protocol/AMI Version from $self->{CONFIG}->{PEERADDR}:$self->{CONFIG}->{PEERPORT}"); | 
| 905 |  |  |  |  |  |  | } | 
| 906 |  |  |  |  |  |  |  | 
| 907 |  |  |  |  |  |  | #Weak reference for us in anonysub | 
| 908 | 0 |  |  |  |  |  | weaken($self); | 
| 909 |  |  |  |  |  |  |  | 
| 910 | 0 |  |  | 0 |  |  | $self->{handle}->push_read( 'Asterisk::AMI' => sub { $self->_handle_packet(@_); } ); | 
|  | 0 |  |  |  |  |  |  | 
| 911 |  |  |  |  |  |  |  | 
| 912 | 0 |  |  |  |  |  | return 1; | 
| 913 |  |  |  |  |  |  | } | 
| 914 |  |  |  |  |  |  |  | 
| 915 |  |  |  |  |  |  | #Connects to the AMI Returns 1 on success, 0 on failure | 
| 916 |  |  |  |  |  |  | sub _connect { | 
| 917 | 0 |  |  | 0 |  |  | my ($self) = @_; | 
| 918 |  |  |  |  |  |  |  | 
| 919 |  |  |  |  |  |  | #Weaken ref for use in anonysub | 
| 920 | 0 |  |  |  |  |  | weaken($self); | 
| 921 |  |  |  |  |  |  |  | 
| 922 |  |  |  |  |  |  | #Build a hash of our anyevent::handle options | 
| 923 |  |  |  |  |  |  | my %hdl = (     connect => [$self->{CONFIG}->{PEERADDR} => $self->{CONFIG}->{PEERPORT}], | 
| 924 | 0 |  |  | 0 |  |  | on_connect_err => sub { $self->_on_connect_err($_[1]); }, | 
| 925 | 0 |  |  | 0 |  |  | on_error => sub { $self->_on_error($_[2]) }, | 
| 926 | 0 |  |  | 0 |  |  | on_eof => sub { $self->_on_disconnect; }, | 
| 927 | 0 |  |  | 0 |  |  | on_connect => sub { $self->{handle}->push_read( line => sub { $self->_on_connect(@_); } ); }); | 
|  | 0 |  |  |  |  |  |  | 
|  | 0 |  |  |  |  |  |  | 
| 928 |  |  |  |  |  |  |  | 
| 929 |  |  |  |  |  |  | #TLS stuff | 
| 930 | 0 | 0 |  |  |  |  | $hdl{'tls'} = 'connect' if ($self->{CONFIG}->{USESSL}); | 
| 931 |  |  |  |  |  |  | #TCP Keepalive | 
| 932 | 0 | 0 |  |  |  |  | $hdl{'keeplive'} = 1 if ($self->{CONFIG}->{TCP_KEEPALIVE}); | 
| 933 |  |  |  |  |  |  |  | 
| 934 |  |  |  |  |  |  | #Make connection/create handle | 
| 935 | 0 |  |  |  |  |  | $self->{handle} = AnyEvent::Handle->new(%hdl); | 
| 936 |  |  |  |  |  |  |  | 
| 937 |  |  |  |  |  |  | #Return login status if blocking | 
| 938 | 0 | 0 |  |  |  |  | return $self->_login if ($self->{CONFIG}->{BLOCKING}); | 
| 939 |  |  |  |  |  |  |  | 
| 940 |  |  |  |  |  |  | #Queue our login | 
| 941 | 0 |  |  |  |  |  | $self->_login; | 
| 942 |  |  |  |  |  |  |  | 
| 943 |  |  |  |  |  |  | #If we have a handle, SUCCESS! | 
| 944 | 0 | 0 |  |  |  |  | return 1 if (defined $self->{handle}); | 
| 945 |  |  |  |  |  |  |  | 
| 946 | 0 |  |  |  |  |  | return; | 
| 947 |  |  |  |  |  |  | } | 
| 948 |  |  |  |  |  |  |  | 
| 949 |  |  |  |  |  |  | sub _handle_packet { | 
| 950 | 0 |  |  | 0 |  |  | my ($self, $hdl, $buffer) = @_; | 
| 951 |  |  |  |  |  |  |  | 
| 952 | 0 |  |  |  |  |  | foreach my $packet (split /\015\012\015\012/ox, $buffer) { | 
| 953 | 0 |  |  |  |  |  | my %parsed; | 
| 954 |  |  |  |  |  |  |  | 
| 955 | 0 |  |  |  |  |  | foreach my $line (split /\015\012/ox, $packet) { | 
| 956 |  |  |  |  |  |  | #Is this our command output? | 
| 957 | 0 | 0 |  |  |  |  | if ($line =~ s/--END\ COMMAND--$//ox) { | 
| 958 | 0 |  |  |  |  |  | $parsed{'COMPLETED'} = 1; | 
| 959 |  |  |  |  |  |  |  | 
| 960 | 0 |  |  |  |  |  | push(@{$parsed{'CMD'}},split(/\x20*\x0A/ox, $line)); | 
|  | 0 |  |  |  |  |  |  | 
| 961 |  |  |  |  |  |  | } else { | 
| 962 |  |  |  |  |  |  | #Regular output, split on :\ | 
| 963 | 0 |  |  |  |  |  | my ($key, $value) = split /:\ /x, $line, 2; | 
| 964 |  |  |  |  |  |  |  | 
| 965 | 0 |  |  |  |  |  | $parsed{$key} = $value; | 
| 966 |  |  |  |  |  |  |  | 
| 967 |  |  |  |  |  |  | } | 
| 968 |  |  |  |  |  |  | } | 
| 969 |  |  |  |  |  |  |  | 
| 970 |  |  |  |  |  |  | #Dispatch depending on packet type | 
| 971 | 0 | 0 |  |  |  |  | if (exists $parsed{'ActionID'}) { | 
|  |  | 0 |  |  |  |  |  | 
| 972 | 0 |  |  |  |  |  | $self->_handle_action(\%parsed); | 
| 973 |  |  |  |  |  |  | } elsif (exists $parsed{'Event'}) { | 
| 974 | 0 |  |  |  |  |  | $self->_handle_event(\%parsed); | 
| 975 |  |  |  |  |  |  | } | 
| 976 |  |  |  |  |  |  | } | 
| 977 |  |  |  |  |  |  |  | 
| 978 | 0 |  |  |  |  |  | return 1; | 
| 979 |  |  |  |  |  |  | } | 
| 980 |  |  |  |  |  |  |  | 
| 981 |  |  |  |  |  |  | #Used once and action completes | 
| 982 |  |  |  |  |  |  | #Determines goodness and performs any oustanding callbacks | 
| 983 |  |  |  |  |  |  | sub _action_complete { | 
| 984 | 0 |  |  | 0 |  |  | my ($self, $actionid) = @_; | 
| 985 |  |  |  |  |  |  |  | 
| 986 |  |  |  |  |  |  | #Determine 'Goodness' | 
| 987 | 0 | 0 | 0 |  |  |  | if (defined $self->{RESPONSEBUFFER}->{$actionid}->{'Response'} | 
| 988 |  |  |  |  |  |  | && $self->{RESPONSEBUFFER}->{$actionid}->{'Response'} =~ /^(?:Success|Follows|Goodbye|Events Off|Pong)$/ox) { | 
| 989 | 0 |  |  |  |  |  | $self->{RESPONSEBUFFER}->{$actionid}->{'GOOD'} = 1; | 
| 990 |  |  |  |  |  |  | } | 
| 991 |  |  |  |  |  |  |  | 
| 992 |  |  |  |  |  |  | #Do callback and cleanup if callback exists | 
| 993 | 0 | 0 |  |  |  |  | if (defined $self->{CALLBACKS}->{$actionid}->{'cb'}) { | 
| 994 |  |  |  |  |  |  | #Stuff needed to process callback | 
| 995 | 0 |  |  |  |  |  | my $callback = $self->{CALLBACKS}->{$actionid}->{'cb'}; | 
| 996 | 0 |  |  |  |  |  | my $response = $self->{RESPONSEBUFFER}->{$actionid}; | 
| 997 | 0 |  |  |  |  |  | my $store = $self->{CALLBACKS}->{$actionid}->{'store'}; | 
| 998 |  |  |  |  |  |  |  | 
| 999 |  |  |  |  |  |  | #cleanup | 
| 1000 | 0 |  |  |  |  |  | delete $self->{RESPONSEBUFFER}->{$actionid}; | 
| 1001 | 0 |  |  |  |  |  | delete $self->{CALLBACKS}->{$actionid}; | 
| 1002 |  |  |  |  |  |  |  | 
| 1003 |  |  |  |  |  |  | #Delete Originate Async bullshit | 
| 1004 | 0 |  |  |  |  |  | delete $response->{'ASYNC'}; | 
| 1005 |  |  |  |  |  |  |  | 
| 1006 | 0 |  |  |  |  |  | $callback->($self, $response, $store); | 
| 1007 |  |  |  |  |  |  | } | 
| 1008 |  |  |  |  |  |  |  | 
| 1009 | 0 |  |  |  |  |  | return 1; | 
| 1010 |  |  |  |  |  |  | } | 
| 1011 |  |  |  |  |  |  |  | 
| 1012 |  |  |  |  |  |  | #Handles proccessing and callbacks for action responses | 
| 1013 |  |  |  |  |  |  | sub _handle_action { | 
| 1014 | 0 |  |  | 0 |  |  | my ($self, $packet) = @_; | 
| 1015 |  |  |  |  |  |  |  | 
| 1016 |  |  |  |  |  |  | #Snag our actionid | 
| 1017 | 0 |  |  |  |  |  | my $actionid = $packet->{'ActionID'}; | 
| 1018 |  |  |  |  |  |  |  | 
| 1019 |  |  |  |  |  |  | #Discard Unknown ActionIDs | 
| 1020 | 0 | 0 |  |  |  |  | return unless ($self->{EXPECTED}->{$actionid}); | 
| 1021 |  |  |  |  |  |  |  | 
| 1022 |  |  |  |  |  |  | #Event responses | 
| 1023 | 0 | 0 |  |  |  |  | if (exists $packet->{'Event'}) { | 
|  |  | 0 |  |  |  |  |  | 
| 1024 |  |  |  |  |  |  | #EventCompleted Event? | 
| 1025 | 0 | 0 |  |  |  |  | if ($packet->{'Event'} =~ /[cC]omplete/ox) { | 
| 1026 | 0 |  |  |  |  |  | $self->{RESPONSEBUFFER}->{$actionid}->{'COMPLETED'} = 1; | 
| 1027 |  |  |  |  |  |  | } else { | 
| 1028 |  |  |  |  |  |  | #DBGetResponse and Originate Async Exceptions | 
| 1029 | 0 | 0 | 0 |  |  |  | if ($packet->{'Event'} eq 'DBGetResponse' || $packet->{'Event'} eq 'OriginateResponse') { | 
| 1030 | 0 |  |  |  |  |  | $self->{RESPONSEBUFFER}->{$actionid}->{'COMPLETED'} = 1; | 
| 1031 |  |  |  |  |  |  | } | 
| 1032 |  |  |  |  |  |  |  | 
| 1033 |  |  |  |  |  |  | #To the buffer | 
| 1034 | 0 |  |  |  |  |  | push(@{$self->{RESPONSEBUFFER}->{$actionid}->{'EVENTS'}}, $packet); | 
|  | 0 |  |  |  |  |  |  | 
| 1035 |  |  |  |  |  |  | } | 
| 1036 |  |  |  |  |  |  | #Response packets | 
| 1037 |  |  |  |  |  |  | } elsif (exists $packet->{'Response'}) { | 
| 1038 |  |  |  |  |  |  | #If No indication of future packets, mark as completed | 
| 1039 | 0 | 0 |  |  |  |  | if ($packet->{'Response'} ne 'Follows') { | 
| 1040 |  |  |  |  |  |  | #Originate Async Exception is the first test | 
| 1041 | 0 | 0 | 0 |  |  |  | if (!$self->{RESPONSEBUFFER}->{$actionid}->{'ASYNC'} | 
|  |  |  | 0 |  |  |  |  | 
| 1042 |  |  |  |  |  |  | && (!exists $packet->{'Message'} || $packet->{'Message'} !~ /[fF]ollow/ox)) { | 
| 1043 | 0 |  |  |  |  |  | $self->{RESPONSEBUFFER}->{$actionid}->{'COMPLETED'} = 1; | 
| 1044 |  |  |  |  |  |  | } | 
| 1045 |  |  |  |  |  |  | } | 
| 1046 |  |  |  |  |  |  |  | 
| 1047 |  |  |  |  |  |  | #Copy the response into the buffer | 
| 1048 | 0 |  |  |  |  |  | foreach (keys %{$packet}) { | 
|  | 0 |  |  |  |  |  |  | 
| 1049 | 0 | 0 |  |  |  |  | if ($_ =~ /^(?:Response|Message|ActionID|Privilege|CMD|COMPLETED)$/ox) { | 
| 1050 | 0 |  |  |  |  |  | $self->{RESPONSEBUFFER}->{$actionid}->{$_} = $packet->{$_}; | 
| 1051 |  |  |  |  |  |  | } else { | 
| 1052 | 0 |  |  |  |  |  | $self->{RESPONSEBUFFER}->{$actionid}->{'PARSED'}->{$_} = $packet->{$_}; | 
| 1053 |  |  |  |  |  |  | } | 
| 1054 |  |  |  |  |  |  | } | 
| 1055 |  |  |  |  |  |  | } | 
| 1056 |  |  |  |  |  |  |  | 
| 1057 | 0 | 0 |  |  |  |  | if ($self->{RESPONSEBUFFER}->{$actionid}->{'COMPLETED'}) { | 
| 1058 |  |  |  |  |  |  | #This aciton is finished do not accept any more packets for it | 
| 1059 | 0 |  |  |  |  |  | delete $self->{EXPECTED}->{$actionid}; | 
| 1060 |  |  |  |  |  |  |  | 
| 1061 |  |  |  |  |  |  | #Determine goodness, do callback | 
| 1062 | 0 |  |  |  |  |  | $self->_action_complete($actionid); | 
| 1063 |  |  |  |  |  |  | } | 
| 1064 |  |  |  |  |  |  |  | 
| 1065 | 0 |  |  |  |  |  | return 1; | 
| 1066 |  |  |  |  |  |  | } | 
| 1067 |  |  |  |  |  |  |  | 
| 1068 |  |  |  |  |  |  | #Handles proccessing and callbacks for 'Event' packets | 
| 1069 |  |  |  |  |  |  | sub _handle_event { | 
| 1070 | 0 |  |  | 0 |  |  | my ($self, $event) = @_; | 
| 1071 |  |  |  |  |  |  |  | 
| 1072 |  |  |  |  |  |  | #If handlers were configured just dispatch, don't buffer | 
| 1073 | 0 | 0 |  |  |  |  | if ($self->{CONFIG}->{HANDLERS}) { | 
| 1074 | 0 | 0 |  |  |  |  | if (exists $self->{CONFIG}->{HANDLERS}->{$event->{'Event'}}) { | 
|  |  | 0 |  |  |  |  |  | 
| 1075 | 0 |  |  |  |  |  | $self->{CONFIG}->{HANDLERS}->{$event->{'Event'}}->($self, $event); | 
| 1076 |  |  |  |  |  |  | } elsif (exists $self->{CONFIG}->{HANDLERS}->{'default'}) { | 
| 1077 | 0 |  |  |  |  |  | $self->{CONFIG}->{HANDLERS}->{'default'}->($self, $event); | 
| 1078 |  |  |  |  |  |  | } | 
| 1079 |  |  |  |  |  |  | } else { | 
| 1080 |  |  |  |  |  |  | #Someone is waiting on this packet, don't bother buffering | 
| 1081 | 0 | 0 |  |  |  |  | if (exists $self->{CALLBACKS}->{'EVENT'}) { | 
| 1082 | 0 |  |  |  |  |  | $self->{CALLBACKS}->{'EVENT'}->{'cb'}->($event); | 
| 1083 | 0 |  |  |  |  |  | delete $self->{CALLBACKS}->{'EVENT'}; | 
| 1084 |  |  |  |  |  |  | #Save for later | 
| 1085 |  |  |  |  |  |  | } else { | 
| 1086 | 0 |  |  |  |  |  | push(@{$self->{EVENTBUFFER}}, $event); | 
|  | 0 |  |  |  |  |  |  | 
| 1087 |  |  |  |  |  |  | } | 
| 1088 |  |  |  |  |  |  | } | 
| 1089 |  |  |  |  |  |  |  | 
| 1090 | 0 |  |  |  |  |  | return 1; | 
| 1091 |  |  |  |  |  |  | } | 
| 1092 |  |  |  |  |  |  |  | 
| 1093 |  |  |  |  |  |  | #This is used to provide blocking behavior for calls It installs callbacks for an action if it is not in the buffer | 
| 1094 |  |  |  |  |  |  | #and waits for the response before returning it. | 
| 1095 |  |  |  |  |  |  | sub _wait_response { | 
| 1096 | 0 |  |  | 0 |  |  | my ($self, $id, $timeout) = @_; | 
| 1097 |  |  |  |  |  |  |  | 
| 1098 |  |  |  |  |  |  | #Already got it? | 
| 1099 | 0 | 0 |  |  |  |  | if ($self->{RESPONSEBUFFER}->{$id}->{'COMPLETED'}) { | 
| 1100 | 0 |  |  |  |  |  | my $resp = $self->{RESPONSEBUFFER}->{$id}; | 
| 1101 | 0 |  |  |  |  |  | delete $self->{RESPONSEBUFFER}->{$id}; | 
| 1102 | 0 |  |  |  |  |  | delete $self->{CALLBACKS}->{$id}; | 
| 1103 | 0 |  |  |  |  |  | delete $self->{EXPECTED}->{$id}; | 
| 1104 | 0 |  |  |  |  |  | return $resp; | 
| 1105 |  |  |  |  |  |  | } | 
| 1106 |  |  |  |  |  |  |  | 
| 1107 |  |  |  |  |  |  | #Don't Have it, wait for it Install some handlers and use a CV to simulate blocking | 
| 1108 | 0 |  |  |  |  |  | my $process = AE::cv; | 
| 1109 |  |  |  |  |  |  |  | 
| 1110 | 0 |  |  | 0 |  |  | $self->{CALLBACKS}->{$id}->{'cb'} = sub { $process->send($_[1]) }; | 
|  | 0 |  |  |  |  |  |  | 
| 1111 | 0 | 0 |  |  |  |  | $timeout = $self->{CONFIG}->{TIMEOUT} unless (defined $timeout); | 
| 1112 |  |  |  |  |  |  |  | 
| 1113 |  |  |  |  |  |  | #Should not need to weaken here because this is a blocking call Only outcomes can be error, timeout, or | 
| 1114 |  |  |  |  |  |  | #complete, all of which will finish the cb and clear the reference weaken($self) | 
| 1115 |  |  |  |  |  |  |  | 
| 1116 | 0 | 0 |  |  |  |  | if ($timeout) { | 
| 1117 |  |  |  |  |  |  | $self->{CALLBACKS}->{$id}->{'timeout'} = sub { | 
| 1118 | 0 |  |  | 0 |  |  | my $response = $self->{'RESPONSEBUFFER'}->{$id}; | 
| 1119 | 0 |  |  |  |  |  | delete $self->{RESPONSEBUFFER}->{$id}; | 
| 1120 | 0 |  |  |  |  |  | delete $self->{CALLBACKS}->{$id}; | 
| 1121 | 0 |  |  |  |  |  | delete $self->{EXPECTED}->{$id}; | 
| 1122 | 0 |  |  |  |  |  | $process->send($response); | 
| 1123 | 0 |  |  |  |  |  | }; | 
| 1124 |  |  |  |  |  |  |  | 
| 1125 |  |  |  |  |  |  | #Make sure event loop is up to date in case of sleeps | 
| 1126 | 0 |  |  |  |  |  | AE::now_update; | 
| 1127 |  |  |  |  |  |  |  | 
| 1128 | 0 |  |  |  |  |  | $self->{CALLBACKS}->{$id}->{'timer'} = AE::timer $timeout, 0, $self->{CALLBACKS}->{$id}->{'timeout'}; | 
| 1129 |  |  |  |  |  |  | } | 
| 1130 |  |  |  |  |  |  |  | 
| 1131 | 0 |  |  |  |  |  | return $process->recv; | 
| 1132 |  |  |  |  |  |  | } | 
| 1133 |  |  |  |  |  |  |  | 
| 1134 |  |  |  |  |  |  | sub _build_action { | 
| 1135 | 0 |  |  | 0 |  |  | my ($actionhash, $id) = @_; | 
| 1136 |  |  |  |  |  |  |  | 
| 1137 | 0 |  |  |  |  |  | my $action; | 
| 1138 |  |  |  |  |  |  | my $async; | 
| 1139 | 0 |  |  |  |  |  | my $callback; | 
| 1140 | 0 |  |  |  |  |  | my $timeout; | 
| 1141 |  |  |  |  |  |  |  | 
| 1142 |  |  |  |  |  |  | #Create an action out of a hash | 
| 1143 | 0 |  |  |  |  |  | while (my ($key, $value) = each(%{$actionhash})) { | 
|  | 0 |  |  |  |  |  |  | 
| 1144 |  |  |  |  |  |  |  | 
| 1145 | 0 |  |  |  |  |  | my $lkey = lc($key); | 
| 1146 |  |  |  |  |  |  |  | 
| 1147 |  |  |  |  |  |  | #Callbacks | 
| 1148 | 0 | 0 | 0 |  |  |  | if ($key eq 'CALLBACK') { | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 1149 | 0 | 0 |  |  |  |  | carp "Use of the CALLBACK key in an action is deprecated and will be removed in a future release.\n", | 
| 1150 |  |  |  |  |  |  | "Please use the syntax that is available." if warnings::enabled('Asterisk::AMI'); | 
| 1151 |  |  |  |  |  |  |  | 
| 1152 | 0 | 0 |  |  |  |  | $callback = $actionhash->{$key} unless (defined $callback); | 
| 1153 | 0 |  |  |  |  |  | next; | 
| 1154 |  |  |  |  |  |  | #Timeout | 
| 1155 |  |  |  |  |  |  | } elsif ($key eq 'TIMEOUT') { | 
| 1156 | 0 | 0 |  |  |  |  | carp "Use of the TIMEOUT key in an action is deprecated and will be removed in a future release\n", | 
| 1157 |  |  |  |  |  |  | "Please use the syntax that is available." if warnings::enabled('Asterisk::AMI'); | 
| 1158 |  |  |  |  |  |  |  | 
| 1159 | 0 | 0 |  |  |  |  | $timeout = $actionhash->{$key} unless (defined $timeout); | 
| 1160 | 0 |  |  |  |  |  | next; | 
| 1161 |  |  |  |  |  |  | #Exception of Orignate Async | 
| 1162 |  |  |  |  |  |  | } elsif ($lkey eq 'async' && $value == 1) { | 
| 1163 | 0 |  |  |  |  |  | $async = 1; | 
| 1164 |  |  |  |  |  |  | #Clean out user ActionIDs | 
| 1165 |  |  |  |  |  |  | } elsif ($lkey eq 'actionid') { | 
| 1166 | 0 | 0 |  |  |  |  | carp "User supplied ActionID being ignored." if warnings::enabled('Asterisk::AMI'); | 
| 1167 | 0 |  |  |  |  |  | next; | 
| 1168 |  |  |  |  |  |  | } | 
| 1169 |  |  |  |  |  |  |  | 
| 1170 |  |  |  |  |  |  | #Handle multiple values | 
| 1171 | 0 | 0 |  |  |  |  | if (ref($value) eq 'ARRAY') { | 
| 1172 | 0 |  |  |  |  |  | foreach my $var (@{$value}) { | 
|  | 0 |  |  |  |  |  |  | 
| 1173 | 0 |  |  |  |  |  | $action .= $key . ': ' . $var . "\015\012"; | 
| 1174 |  |  |  |  |  |  | } | 
| 1175 |  |  |  |  |  |  | } else { | 
| 1176 | 0 |  |  |  |  |  | $action .= $key . ': ' . $value . "\015\012"; | 
| 1177 |  |  |  |  |  |  | } | 
| 1178 |  |  |  |  |  |  | } | 
| 1179 |  |  |  |  |  |  |  | 
| 1180 |  |  |  |  |  |  | #Append ActionID and End Command | 
| 1181 | 0 |  |  |  |  |  | $action .= 'ActionID: ' . $id . "\015\012\015\012"; | 
| 1182 |  |  |  |  |  |  |  | 
| 1183 | 0 |  |  |  |  |  | return ($action, $async, $callback, $timeout); | 
| 1184 |  |  |  |  |  |  | } | 
| 1185 |  |  |  |  |  |  |  | 
| 1186 |  |  |  |  |  |  | #Sends an action to the AMI Accepts an Array Returns the actionid of the action | 
| 1187 |  |  |  |  |  |  | sub send_action { | 
| 1188 | 0 |  |  | 0 | 0 |  | my ($self, $actionhash, $callback, $timeout, $store) = @_; | 
| 1189 |  |  |  |  |  |  |  | 
| 1190 |  |  |  |  |  |  | #No connection | 
| 1191 | 0 | 0 |  |  |  |  | return unless ($self->{handle}); | 
| 1192 |  |  |  |  |  |  |  | 
| 1193 |  |  |  |  |  |  | #resets id number | 
| 1194 | 0 | 0 |  |  |  |  | if ($self->{idseq} > $self->{CONFIG}->{BUFFERSIZE}) { | 
| 1195 | 0 |  |  |  |  |  | $self->{idseq} = 1; | 
| 1196 |  |  |  |  |  |  | } | 
| 1197 |  |  |  |  |  |  |  | 
| 1198 | 0 |  |  |  |  |  | my $id = $self->{idseq}++; | 
| 1199 |  |  |  |  |  |  |  | 
| 1200 |  |  |  |  |  |  | #Store the Action ID | 
| 1201 | 0 |  |  |  |  |  | $self->{lastid} = $id; | 
| 1202 |  |  |  |  |  |  |  | 
| 1203 |  |  |  |  |  |  | #Delete anything that might be in the buffer | 
| 1204 | 0 |  |  |  |  |  | delete $self->{RESPONSEBUFFER}->{$id}; | 
| 1205 | 0 |  |  |  |  |  | delete $self->{CALLBACKS}->{$id}; | 
| 1206 |  |  |  |  |  |  |  | 
| 1207 | 0 |  |  |  |  |  | my ($action, $hcb, $htimeout); | 
| 1208 |  |  |  |  |  |  |  | 
| 1209 | 0 |  |  |  |  |  | ($action, $self->{RESPONSEBUFFER}->{$id}->{'ASYNC'}, $hcb, $htimeout) = _build_action($actionhash, $id); | 
| 1210 |  |  |  |  |  |  |  | 
| 1211 | 0 | 0 |  |  |  |  | $callback = $hcb unless (defined $callback); | 
| 1212 | 0 | 0 |  |  |  |  | $timeout = $htimeout unless (defined $timeout); | 
| 1213 |  |  |  |  |  |  |  | 
| 1214 | 0 | 0 | 0 |  |  |  | if ($self->{LOGGEDIN} || lc($actionhash->{'Action'}) =~ /login|challenge/x) { | 
| 1215 | 0 |  |  |  |  |  | $self->{handle}->push_write($action); | 
| 1216 |  |  |  |  |  |  | } else { | 
| 1217 | 0 |  |  |  |  |  | $self->{PRELOGIN}->{$id} = $action; | 
| 1218 |  |  |  |  |  |  | } | 
| 1219 |  |  |  |  |  |  |  | 
| 1220 | 0 |  |  |  |  |  | $self->{RESPONSEBUFFER}->{$id}->{'COMPLETED'} = 0; | 
| 1221 | 0 |  |  |  |  |  | $self->{RESPONSEBUFFER}->{$id}->{'GOOD'} = 0; | 
| 1222 | 0 |  |  |  |  |  | $self->{EXPECTED}->{$id} = 1; | 
| 1223 |  |  |  |  |  |  |  | 
| 1224 |  |  |  |  |  |  | #Weaken ref of use in anonsub | 
| 1225 | 0 |  |  |  |  |  | weaken($self); | 
| 1226 |  |  |  |  |  |  |  | 
| 1227 |  |  |  |  |  |  | #Set default timeout if needed | 
| 1228 | 0 | 0 |  |  |  |  | $timeout = $self->{CONFIG}->{TIMEOUT} unless (defined $timeout); | 
| 1229 |  |  |  |  |  |  |  | 
| 1230 |  |  |  |  |  |  | #Setup callback | 
| 1231 | 0 | 0 |  |  |  |  | if (defined $callback) { | 
| 1232 |  |  |  |  |  |  | #Set callback if defined | 
| 1233 | 0 |  |  |  |  |  | $self->{CALLBACKS}->{$id}->{'cb'} = $callback; | 
| 1234 |  |  |  |  |  |  | #Variable to return with Callback | 
| 1235 | 0 |  |  |  |  |  | $self->{CALLBACKS}->{$id}->{'store'} = $store; | 
| 1236 |  |  |  |  |  |  | } | 
| 1237 |  |  |  |  |  |  |  | 
| 1238 |  |  |  |  |  |  | #Start timer for timeouts | 
| 1239 | 0 | 0 | 0 |  |  |  | if ($timeout && defined $self->{CALLBACKS}->{$id}) { | 
| 1240 |  |  |  |  |  |  | $self->{CALLBACKS}->{$id}->{'timeout'} = sub { | 
| 1241 | 0 |  |  | 0 |  |  | my $response = $self->{RESPONSEBUFFER}->{$id}; | 
| 1242 | 0 |  |  |  |  |  | my $cb = $self->{CALLBACKS}->{$id}->{'cb'}; | 
| 1243 | 0 |  |  |  |  |  | my $st = $self->{CALLBACKS}->{$id}->{'store'}; | 
| 1244 | 0 |  |  |  |  |  | delete $self->{RESPONSEBUFFER}->{$id}; | 
| 1245 | 0 |  |  |  |  |  | delete $self->{CALLBACKS}->{$id}; | 
| 1246 | 0 |  |  |  |  |  | delete $self->{EXPECTED}->{$id}; | 
| 1247 | 0 |  |  |  |  |  | delete $self->{PRELOGIN}->{$id}; | 
| 1248 | 0 |  |  |  |  |  | $cb->($self, $response, $st);; | 
| 1249 | 0 |  |  |  |  |  | }; | 
| 1250 | 0 |  |  |  |  |  | $self->{CALLBACKS}->{$id}->{'timer'} = AE::timer $timeout, 0, $self->{CALLBACKS}->{$id}->{'timeout'}; | 
| 1251 |  |  |  |  |  |  | } | 
| 1252 |  |  |  |  |  |  |  | 
| 1253 | 0 |  |  |  |  |  | return $id; | 
| 1254 |  |  |  |  |  |  | } | 
| 1255 |  |  |  |  |  |  |  | 
| 1256 |  |  |  |  |  |  | #Checks for a response to an action If no actionid is given uses last actionid sent Returns 1 if action success, 0 if | 
| 1257 |  |  |  |  |  |  | #failure | 
| 1258 |  |  |  |  |  |  | sub check_response { | 
| 1259 | 0 |  |  | 0 | 0 |  | my ($self, $actionid, $timeout) = @_; | 
| 1260 |  |  |  |  |  |  |  | 
| 1261 |  |  |  |  |  |  | #Check if an actionid was passed, else us last | 
| 1262 | 0 | 0 |  |  |  |  | $actionid = $self->{lastid} unless (defined $actionid); | 
| 1263 |  |  |  |  |  |  |  | 
| 1264 | 0 |  |  |  |  |  | my $resp = $self->_wait_response($actionid, $timeout); | 
| 1265 |  |  |  |  |  |  |  | 
| 1266 | 0 | 0 |  |  |  |  | if ($resp->{'COMPLETED'}) { | 
| 1267 | 0 |  |  |  |  |  | return $resp->{'GOOD'}; | 
| 1268 |  |  |  |  |  |  | } | 
| 1269 |  |  |  |  |  |  |  | 
| 1270 | 0 |  |  |  |  |  | return; | 
| 1271 |  |  |  |  |  |  | } | 
| 1272 |  |  |  |  |  |  |  | 
| 1273 |  |  |  |  |  |  | #Returns the Action with all command data and event Actions are hash references If an actionid is specified returns | 
| 1274 |  |  |  |  |  |  | #that action, otherwise uses last actionid sent Removes the event from the buffer | 
| 1275 |  |  |  |  |  |  | sub get_response { | 
| 1276 | 0 |  |  | 0 | 0 |  | my ($self, $actionid, $timeout) = @_; | 
| 1277 |  |  |  |  |  |  |  | 
| 1278 |  |  |  |  |  |  | #Check if an actionid was passed, else us last | 
| 1279 | 0 | 0 |  |  |  |  | $actionid = $self->{lastid} unless (defined $actionid); | 
| 1280 |  |  |  |  |  |  |  | 
| 1281 |  |  |  |  |  |  | #Wait for the action to complete | 
| 1282 | 0 |  |  |  |  |  | my $resp = $self->_wait_response($actionid, $timeout); | 
| 1283 |  |  |  |  |  |  |  | 
| 1284 | 0 | 0 |  |  |  |  | if ($resp->{'COMPLETED'}) { | 
| 1285 | 0 |  |  |  |  |  | return $resp; | 
| 1286 |  |  |  |  |  |  | } | 
| 1287 |  |  |  |  |  |  |  | 
| 1288 | 0 |  |  |  |  |  | return; | 
| 1289 |  |  |  |  |  |  | } | 
| 1290 |  |  |  |  |  |  |  | 
| 1291 |  |  |  |  |  |  | #Sends an action and returns its data or undef if the command failed | 
| 1292 |  |  |  |  |  |  | sub action { | 
| 1293 | 0 |  |  | 0 | 0 |  | my ($self, $action, $timeout) = @_; | 
| 1294 |  |  |  |  |  |  |  | 
| 1295 |  |  |  |  |  |  | #Send action | 
| 1296 | 0 |  |  |  |  |  | my $actionid = $self->send_action($action); | 
| 1297 | 0 | 0 |  |  |  |  | if (defined $actionid) { | 
| 1298 |  |  |  |  |  |  | #Get response | 
| 1299 | 0 |  |  |  |  |  | return $self->get_response($actionid, $timeout); | 
| 1300 |  |  |  |  |  |  | } | 
| 1301 |  |  |  |  |  |  |  | 
| 1302 | 0 |  |  |  |  |  | return; | 
| 1303 |  |  |  |  |  |  | } | 
| 1304 |  |  |  |  |  |  |  | 
| 1305 |  |  |  |  |  |  | #Sends an action and returns 1 if it was successful and 0 if it failed | 
| 1306 |  |  |  |  |  |  | sub simple_action { | 
| 1307 | 0 |  |  | 0 | 0 |  | my ($self, $action, $timeout) = @_; | 
| 1308 |  |  |  |  |  |  |  | 
| 1309 |  |  |  |  |  |  | #Send action | 
| 1310 | 0 |  |  |  |  |  | my $actionid = $self->send_action($action); | 
| 1311 |  |  |  |  |  |  |  | 
| 1312 | 0 | 0 |  |  |  |  | if (defined $actionid) { | 
| 1313 | 0 |  |  |  |  |  | my $resp = $self->_wait_response($actionid, $timeout); | 
| 1314 | 0 | 0 |  |  |  |  | if ($resp->{'COMPLETED'}) { | 
| 1315 | 0 |  |  |  |  |  | return $resp->{'GOOD'}; | 
| 1316 |  |  |  |  |  |  | } | 
| 1317 |  |  |  |  |  |  | } | 
| 1318 |  |  |  |  |  |  |  | 
| 1319 | 0 |  |  |  |  |  | return; | 
| 1320 |  |  |  |  |  |  | } | 
| 1321 |  |  |  |  |  |  |  | 
| 1322 |  |  |  |  |  |  | #Calculate md5 response to channel | 
| 1323 |  |  |  |  |  |  | sub _md5_resp { | 
| 1324 | 0 |  |  | 0 |  |  | my ($self, $challenge) = @_; | 
| 1325 |  |  |  |  |  |  |  | 
| 1326 | 0 |  |  |  |  |  | my $md5 = Digest::MD5->new(); | 
| 1327 |  |  |  |  |  |  |  | 
| 1328 | 0 |  |  |  |  |  | $md5->add($challenge); | 
| 1329 | 0 |  |  |  |  |  | $md5->add($self->{CONFIG}->{SECRET}); | 
| 1330 |  |  |  |  |  |  |  | 
| 1331 | 0 |  |  |  |  |  | return $md5->hexdigest; | 
| 1332 |  |  |  |  |  |  | } | 
| 1333 |  |  |  |  |  |  |  | 
| 1334 |  |  |  |  |  |  | #Logs into the AMI | 
| 1335 |  |  |  |  |  |  | sub _login { | 
| 1336 | 0 |  |  | 0 |  |  | my ($self) = @_; | 
| 1337 |  |  |  |  |  |  |  | 
| 1338 |  |  |  |  |  |  | #Auth challenge | 
| 1339 | 0 |  |  |  |  |  | my %challenge; | 
| 1340 |  |  |  |  |  |  |  | 
| 1341 |  |  |  |  |  |  | #Timeout to use | 
| 1342 |  |  |  |  |  |  | my $timeout; | 
| 1343 | 0 | 0 |  |  |  |  | $timeout = 5 unless ($self->{CONFIG}->{TIMEOUT}); | 
| 1344 |  |  |  |  |  |  |  | 
| 1345 |  |  |  |  |  |  | #Build login action | 
| 1346 | 0 |  |  |  |  |  | my %action = (  Action => 'login', | 
| 1347 |  |  |  |  |  |  | Username => $self->{CONFIG}->{USERNAME}, | 
| 1348 |  |  |  |  |  |  | Events => $self->{CONFIG}->{EVENTS} ); | 
| 1349 |  |  |  |  |  |  |  | 
| 1350 |  |  |  |  |  |  | #Actions to take for different authtypes | 
| 1351 | 0 | 0 |  |  |  |  | if (lc($self->{CONFIG}->{AUTHTYPE}) eq 'md5') { | 
| 1352 |  |  |  |  |  |  | #Do a challenge | 
| 1353 | 0 |  |  |  |  |  | %challenge = (  Action => 'Challenge', | 
| 1354 |  |  |  |  |  |  | AuthType => $self->{CONFIG}->{AUTHTYPE}); | 
| 1355 |  |  |  |  |  |  | } else { | 
| 1356 | 0 |  |  |  |  |  | $action{'Secret'} = $self->{CONFIG}->{SECRET}; | 
| 1357 |  |  |  |  |  |  | } | 
| 1358 |  |  |  |  |  |  |  | 
| 1359 |  |  |  |  |  |  | #Blocking connect | 
| 1360 | 0 | 0 |  |  |  |  | if ($self->{CONFIG}->{BLOCKING}) { | 
| 1361 | 0 |  |  |  |  |  | return $self->_login_block(\%action, \%challenge, $timeout); | 
| 1362 |  |  |  |  |  |  | } else { | 
| 1363 | 0 |  |  |  |  |  | return $self->_login_noblock(\%action, \%challenge, $timeout); | 
| 1364 |  |  |  |  |  |  | } | 
| 1365 |  |  |  |  |  |  |  | 
| 1366 | 0 |  |  |  |  |  | return; | 
| 1367 |  |  |  |  |  |  | } | 
| 1368 |  |  |  |  |  |  |  | 
| 1369 |  |  |  |  |  |  | #Checks loging responses, prints errors | 
| 1370 |  |  |  |  |  |  | sub _logged_in { | 
| 1371 | 0 |  |  | 0 |  |  | my ($self, $login) = @_; | 
| 1372 |  |  |  |  |  |  |  | 
| 1373 | 0 | 0 |  |  |  |  | if ($login->{'GOOD'}) { | 
| 1374 |  |  |  |  |  |  | #Login was good | 
| 1375 | 0 |  |  |  |  |  | $self->{LOGGEDIN} = 1; | 
| 1376 |  |  |  |  |  |  |  | 
| 1377 | 0 | 0 |  |  |  |  | $self->{CONFIG}->{ON_CONNECT}->($self) if ($self->{CONFIG}->{ON_CONNECT}); | 
| 1378 |  |  |  |  |  |  |  | 
| 1379 |  |  |  |  |  |  | #Flush pre-login buffer | 
| 1380 | 0 |  |  |  |  |  | foreach (values %{$self->{PRELOGIN}}) { | 
|  | 0 |  |  |  |  |  |  | 
| 1381 | 0 |  |  |  |  |  | $self->{handle}->push_write($_); | 
| 1382 |  |  |  |  |  |  | } | 
| 1383 |  |  |  |  |  |  |  | 
| 1384 | 0 |  |  |  |  |  | delete $self->{PRELOGIN}; | 
| 1385 |  |  |  |  |  |  |  | 
| 1386 | 0 |  |  |  |  |  | return 1; | 
| 1387 |  |  |  |  |  |  | } else { | 
| 1388 |  |  |  |  |  |  | #Login failed | 
| 1389 | 0 | 0 |  |  |  |  | if ($login->{'COMPLETED'}) { | 
| 1390 | 0 |  |  |  |  |  | $self->_on_connect_err("Login Failed to Asterisk (bad auth) at $self->{CONFIG}->{PEERADDR}:$self->{CONFIG}->{PEERPORT}"); | 
| 1391 |  |  |  |  |  |  | } else { | 
| 1392 | 0 |  |  |  |  |  | $self->_on_connect_err("Login Failed to Asterisk due to timeout at $self->{CONFIG}->{PEERADDR}:$self->{CONFIG}->{PEERPORT}"); | 
| 1393 |  |  |  |  |  |  | } | 
| 1394 |  |  |  |  |  |  |  | 
| 1395 | 0 |  |  |  |  |  | return; | 
| 1396 |  |  |  |  |  |  | } | 
| 1397 |  |  |  |  |  |  |  | 
| 1398 | 0 |  |  |  |  |  | return; | 
| 1399 |  |  |  |  |  |  | } | 
| 1400 |  |  |  |  |  |  |  | 
| 1401 |  |  |  |  |  |  | #Blocking Login | 
| 1402 |  |  |  |  |  |  | sub _login_block { | 
| 1403 | 0 |  |  | 0 |  |  | my ($self, $action, $challenge, $timeout) = @_; | 
| 1404 |  |  |  |  |  |  |  | 
| 1405 | 0 |  |  |  |  |  | my $resp; | 
| 1406 |  |  |  |  |  |  |  | 
| 1407 |  |  |  |  |  |  | #If a challenge exists do handle it first before the login | 
| 1408 | 0 | 0 |  |  |  |  | if (%{$challenge}) { | 
|  | 0 |  |  |  |  |  |  | 
| 1409 |  |  |  |  |  |  |  | 
| 1410 |  |  |  |  |  |  | #Get challenge response | 
| 1411 | 0 |  |  |  |  |  | my $chresp = $self->action($challenge,$timeout); | 
| 1412 |  |  |  |  |  |  |  | 
| 1413 | 0 | 0 |  |  |  |  | if ($chresp->{'GOOD'}) { | 
| 1414 |  |  |  |  |  |  |  | 
| 1415 | 0 |  |  |  |  |  | $action->{'Key'} = $self->_md5_resp($chresp->{'PARSED'}->{'Challenge'}, $self->{CONFIG}->{SECRET}); | 
| 1416 | 0 |  |  |  |  |  | $action->{'AuthType'} = $self->{CONFIG}->{AUTHTYPE}; | 
| 1417 |  |  |  |  |  |  |  | 
| 1418 |  |  |  |  |  |  | #Login | 
| 1419 | 0 |  |  |  |  |  | $resp = $self->action($action, $timeout); | 
| 1420 |  |  |  |  |  |  |  | 
| 1421 |  |  |  |  |  |  | } else { | 
| 1422 |  |  |  |  |  |  | #Challenge Failed | 
| 1423 | 0 | 0 |  |  |  |  | if ($chresp->{'COMPLETED'}) { | 
| 1424 | 0 |  |  |  |  |  | $self->_on_connect_err("$self->{CONFIG}->{AUTHTYPE} challenge failed"); | 
| 1425 |  |  |  |  |  |  | } else { | 
| 1426 | 0 |  |  |  |  |  | $self->_on_connect_err("Timed out waiting for challenge"); | 
| 1427 |  |  |  |  |  |  | } | 
| 1428 |  |  |  |  |  |  |  | 
| 1429 | 0 |  |  |  |  |  | return; | 
| 1430 |  |  |  |  |  |  | } | 
| 1431 |  |  |  |  |  |  | } else { | 
| 1432 |  |  |  |  |  |  | #Plaintext login | 
| 1433 | 0 |  |  |  |  |  | $resp = $self->action($action, $timeout); | 
| 1434 |  |  |  |  |  |  | } | 
| 1435 |  |  |  |  |  |  |  | 
| 1436 | 0 |  |  |  |  |  | return $self->_logged_in($resp); | 
| 1437 |  |  |  |  |  |  | } | 
| 1438 |  |  |  |  |  |  |  | 
| 1439 |  |  |  |  |  |  | #Non-blocking login | 
| 1440 |  |  |  |  |  |  | sub _login_noblock { | 
| 1441 | 0 |  |  | 0 |  |  | my ($self, $action, $challenge, $timeout) = @_; | 
| 1442 |  |  |  |  |  |  |  | 
| 1443 |  |  |  |  |  |  | #Weaken ref for use in anonsub | 
| 1444 | 0 |  |  |  |  |  | weaken($self); | 
| 1445 |  |  |  |  |  |  |  | 
| 1446 |  |  |  |  |  |  | #Callback for login action | 
| 1447 | 0 |  |  | 0 |  |  | my $login_cb = sub { $self->_logged_in($_[1]) }; | 
|  | 0 |  |  |  |  |  |  | 
| 1448 |  |  |  |  |  |  |  | 
| 1449 |  |  |  |  |  |  | #Do a md5 challenge | 
| 1450 | 0 | 0 |  |  |  |  | if (%{$challenge}) { | 
|  | 0 |  |  |  |  |  |  | 
| 1451 |  |  |  |  |  |  | #Create callbacks for the challenge | 
| 1452 |  |  |  |  |  |  | my $challenge_cb = sub { | 
| 1453 | 0 | 0 |  | 0 |  |  | if ($_[1]->{'GOOD'}) { | 
| 1454 | 0 |  |  |  |  |  | my $md5 = Digest::MD5->new(); | 
| 1455 |  |  |  |  |  |  |  | 
| 1456 | 0 |  |  |  |  |  | $md5->add($_[1]->{'PARSED'}->{'Challenge'}); | 
| 1457 | 0 |  |  |  |  |  | $md5->add($self->{CONFIG}->{SECRET}); | 
| 1458 |  |  |  |  |  |  |  | 
| 1459 | 0 |  |  |  |  |  | $md5 = $md5->hexdigest; | 
| 1460 |  |  |  |  |  |  |  | 
| 1461 | 0 |  |  |  |  |  | $action->{'Key'} = $md5; | 
| 1462 | 0 |  |  |  |  |  | $action->{'AuthType'} = $self->{CONFIG}->{AUTHTYPE}; | 
| 1463 |  |  |  |  |  |  |  | 
| 1464 | 0 |  |  |  |  |  | $self->send_action($action, $login_cb, $timeout); | 
| 1465 |  |  |  |  |  |  |  | 
| 1466 |  |  |  |  |  |  | } else { | 
| 1467 | 0 | 0 |  |  |  |  | if ($_[1]->{'COMPLETED'}) { | 
| 1468 | 0 |  |  |  |  |  | $self->_on_connect_err("$self->{CONFIG}->{AUTHTYPE} challenge failed"); | 
| 1469 |  |  |  |  |  |  | } else { | 
| 1470 | 0 |  |  |  |  |  | $self->_on_connect_err("Timed out waiting for challenge"); | 
| 1471 |  |  |  |  |  |  | } | 
| 1472 |  |  |  |  |  |  |  | 
| 1473 | 0 |  |  |  |  |  | return; | 
| 1474 |  |  |  |  |  |  | } | 
| 1475 | 0 |  |  |  |  |  | }; | 
| 1476 |  |  |  |  |  |  |  | 
| 1477 |  |  |  |  |  |  | #Send challenge | 
| 1478 | 0 |  |  |  |  |  | $self->send_action($challenge, $challenge_cb, $timeout); | 
| 1479 |  |  |  |  |  |  | } else { | 
| 1480 |  |  |  |  |  |  | #Plaintext login | 
| 1481 | 0 |  |  |  |  |  | $self->send_action($action, $login_cb, $timeout); | 
| 1482 |  |  |  |  |  |  | } | 
| 1483 |  |  |  |  |  |  |  | 
| 1484 | 0 |  |  |  |  |  | return 1; | 
| 1485 |  |  |  |  |  |  | } | 
| 1486 |  |  |  |  |  |  |  | 
| 1487 |  |  |  |  |  |  | #Disconnect from the AMI If logged in will first issue a logoff | 
| 1488 |  |  |  |  |  |  | sub disconnect { | 
| 1489 | 0 |  |  | 0 | 0 |  | my ($self) = @_; | 
| 1490 |  |  |  |  |  |  |  | 
| 1491 | 0 |  |  |  |  |  | $self->destroy(); | 
| 1492 |  |  |  |  |  |  |  | 
| 1493 |  |  |  |  |  |  | #No socket? No Problem. | 
| 1494 | 0 |  |  |  |  |  | return 1; | 
| 1495 |  |  |  |  |  |  | } | 
| 1496 |  |  |  |  |  |  |  | 
| 1497 |  |  |  |  |  |  | #Pops the topmost event out of the buffer and returns it Events are hash references | 
| 1498 |  |  |  |  |  |  | sub get_event { | 
| 1499 | 0 |  |  | 0 | 0 |  | my ($self, $timeout) = @_; | 
| 1500 |  |  |  |  |  |  | #my $timeout = $_[1]; | 
| 1501 |  |  |  |  |  |  |  | 
| 1502 | 0 | 0 |  |  |  |  | $timeout = $self->{CONFIG}->{TIMEOUT} unless (defined $timeout); | 
| 1503 |  |  |  |  |  |  |  | 
| 1504 | 0 | 0 |  |  |  |  | unless (defined $self->{EVENTBUFFER}->[0]) { | 
| 1505 |  |  |  |  |  |  |  | 
| 1506 | 0 |  |  |  |  |  | my $process = AE::cv; | 
| 1507 |  |  |  |  |  |  |  | 
| 1508 | 0 |  |  | 0 |  |  | $self->{CALLBACKS}->{'EVENT'}->{'cb'} = sub { $process->send($_[0]) }; | 
|  | 0 |  |  |  |  |  |  | 
| 1509 | 0 |  |  | 0 |  |  | $self->{CALLBACKS}->{'EVENT'}->{'timeout'} = sub { warnings::warnif('Asterisk::AMI', "Timed out waiting for event"); $process->send(undef); }; | 
|  | 0 |  |  |  |  |  |  | 
|  | 0 |  |  |  |  |  |  | 
| 1510 |  |  |  |  |  |  |  | 
| 1511 | 0 | 0 |  |  |  |  | $timeout = $self->{CONFIG}->{TIMEOUT} unless (defined $timeout); | 
| 1512 |  |  |  |  |  |  |  | 
| 1513 | 0 | 0 |  |  |  |  | if ($timeout) { | 
| 1514 |  |  |  |  |  |  |  | 
| 1515 |  |  |  |  |  |  | #Make sure event loop is up to date in case of sleeps | 
| 1516 | 0 |  |  |  |  |  | AE::now_update; | 
| 1517 |  |  |  |  |  |  |  | 
| 1518 | 0 |  |  |  |  |  | $self->{CALLBACKS}->{'EVENT'}->{'timer'} = AE::timer $timeout, 0, $self->{CALLBACKS}->{'EVENT'}->{'timeout'}; | 
| 1519 |  |  |  |  |  |  | } | 
| 1520 |  |  |  |  |  |  |  | 
| 1521 | 0 |  |  |  |  |  | return $process->recv; | 
| 1522 |  |  |  |  |  |  | } | 
| 1523 |  |  |  |  |  |  |  | 
| 1524 | 0 |  |  |  |  |  | return shift @{$self->{EVENTBUFFER}}; | 
|  | 0 |  |  |  |  |  |  | 
| 1525 |  |  |  |  |  |  | } | 
| 1526 |  |  |  |  |  |  |  | 
| 1527 |  |  |  |  |  |  | #Returns server AMI version | 
| 1528 |  |  |  |  |  |  | sub amiver { | 
| 1529 | 0 |  |  | 0 | 0 |  | my ($self) = @_; | 
| 1530 | 0 |  |  |  |  |  | return $self->{AMIVER}; | 
| 1531 |  |  |  |  |  |  | } | 
| 1532 |  |  |  |  |  |  |  | 
| 1533 |  |  |  |  |  |  | #Checks the connection, returns 1 if the connection is good | 
| 1534 |  |  |  |  |  |  | sub connected { | 
| 1535 | 0 |  |  | 0 | 0 |  | my ($self, $timeout) = @_; | 
| 1536 |  |  |  |  |  |  |  | 
| 1537 | 0 | 0 | 0 |  |  |  | if ($self && $self->simple_action({ Action => 'Ping'}, $timeout)) { | 
| 1538 | 0 |  |  |  |  |  | return 1; | 
| 1539 |  |  |  |  |  |  | } | 
| 1540 |  |  |  |  |  |  |  | 
| 1541 | 0 |  |  |  |  |  | return 0; | 
| 1542 |  |  |  |  |  |  | } | 
| 1543 |  |  |  |  |  |  |  | 
| 1544 |  |  |  |  |  |  | #Check whether there was an error on the socket | 
| 1545 |  |  |  |  |  |  | sub error { | 
| 1546 | 0 |  |  | 0 | 0 |  | my ($self) = @_; | 
| 1547 | 0 |  |  |  |  |  | return $self->{SOCKERR}; | 
| 1548 |  |  |  |  |  |  | } | 
| 1549 |  |  |  |  |  |  |  | 
| 1550 |  |  |  |  |  |  | #Sends a keep alive | 
| 1551 |  |  |  |  |  |  | sub _send_keepalive { | 
| 1552 | 0 |  |  | 0 |  |  | my ($self) = @_; | 
| 1553 |  |  |  |  |  |  | #Weaken ref for use in anonysub | 
| 1554 | 0 |  |  |  |  |  | weaken($self); | 
| 1555 |  |  |  |  |  |  | my $cb = sub { | 
| 1556 | 0 | 0 |  | 0 |  |  | unless ($_[1]->{'GOOD'}) { | 
| 1557 | 0 |  |  |  |  |  | $self->_on_timeout("Asterisk failed to respond to keepalive - $self->{CONFIG}->{PEERADDR}:$self->{CONFIG}->{PEERPORT}"); | 
| 1558 |  |  |  |  |  |  | }; | 
| 1559 | 0 |  |  |  |  |  | }; | 
| 1560 |  |  |  |  |  |  |  | 
| 1561 | 0 |  | 0 |  |  |  | my $timeout = $self->{CONFIG}->{TIMEOUT} || 5; | 
| 1562 |  |  |  |  |  |  |  | 
| 1563 | 0 |  |  |  |  |  | return $self->send_action({ Action => 'Ping' }, $cb, $timeout); | 
| 1564 |  |  |  |  |  |  | } | 
| 1565 |  |  |  |  |  |  |  | 
| 1566 |  |  |  |  |  |  | #Calls all callbacks as if they had timed out Used when an error has occured on the socket | 
| 1567 |  |  |  |  |  |  | sub _clear_cbs { | 
| 1568 | 0 |  |  | 0 |  |  | my ($self) = @_; | 
| 1569 |  |  |  |  |  |  |  | 
| 1570 | 0 |  |  |  |  |  | foreach my $id (keys %{$self->{CALLBACKS}}) { | 
|  | 0 |  |  |  |  |  |  | 
| 1571 | 0 |  |  |  |  |  | my $response = $self->{RESPONSEBUFFER}->{$id}; | 
| 1572 | 0 |  |  |  |  |  | my $callback = $self->{CALLBACKS}->{$id}->{'cb'}; | 
| 1573 | 0 |  |  |  |  |  | my $store = $self->{CALLBACKS}->{$id}->{'store'}; | 
| 1574 | 0 |  |  |  |  |  | delete $self->{RESPONSEBUFFER}->{$id}; | 
| 1575 | 0 |  |  |  |  |  | delete $self->{CALLBACKS}->{$id}; | 
| 1576 | 0 |  |  |  |  |  | delete $self->{EXPECTED}->{$id}; | 
| 1577 | 0 |  |  |  |  |  | $callback->($self, $response, $store); | 
| 1578 |  |  |  |  |  |  | } | 
| 1579 |  |  |  |  |  |  |  | 
| 1580 | 0 |  |  |  |  |  | return 1; | 
| 1581 |  |  |  |  |  |  | } | 
| 1582 |  |  |  |  |  |  |  | 
| 1583 |  |  |  |  |  |  | #Cleans up | 
| 1584 |  |  |  |  |  |  | sub destroy { | 
| 1585 | 0 |  |  | 0 | 0 |  | my ($self) = @_; | 
| 1586 |  |  |  |  |  |  |  | 
| 1587 | 0 |  |  |  |  |  | $self->DESTROY; | 
| 1588 |  |  |  |  |  |  |  | 
| 1589 | 0 |  |  |  |  |  | bless $self, "Asterisk::AMI::destroyed"; | 
| 1590 |  |  |  |  |  |  |  | 
| 1591 | 0 |  |  |  |  |  | return 1; | 
| 1592 |  |  |  |  |  |  | } | 
| 1593 |  |  |  |  |  |  |  | 
| 1594 |  |  |  |  |  |  | #Runs the AnyEvent loop | 
| 1595 |  |  |  |  |  |  | sub loop { | 
| 1596 | 0 |  |  | 0 | 0 |  | return AnyEvent->loop; | 
| 1597 |  |  |  |  |  |  | } | 
| 1598 |  |  |  |  |  |  |  | 
| 1599 |  |  |  |  |  |  | #Bye bye | 
| 1600 |  |  |  |  |  |  | sub DESTROY { | 
| 1601 | 0 |  |  | 0 |  |  | my ($self) = @_; | 
| 1602 |  |  |  |  |  |  |  | 
| 1603 |  |  |  |  |  |  | #Logoff if we are not in error | 
| 1604 | 0 | 0 | 0 |  |  |  | if (!$self->{SOCKERR} && $self->{LOGGEDIN}) { | 
| 1605 | 0 |  |  |  |  |  | $self->send_action({ Action => 'Logoff' }); | 
| 1606 | 0 |  |  |  |  |  | undef $self->{LOGGEDIN}; | 
| 1607 |  |  |  |  |  |  | } | 
| 1608 |  |  |  |  |  |  |  | 
| 1609 |  |  |  |  |  |  | #Destroy our handle first to cause it to flush | 
| 1610 | 0 | 0 |  |  |  |  | if ($self->{handle}) { | 
| 1611 | 0 |  |  |  |  |  | $self->{handle}->destroy(); | 
| 1612 |  |  |  |  |  |  | } | 
| 1613 |  |  |  |  |  |  |  | 
| 1614 |  |  |  |  |  |  | #Do our own flushing | 
| 1615 | 0 |  |  |  |  |  | $self->_clear_cbs(); | 
| 1616 |  |  |  |  |  |  |  | 
| 1617 |  |  |  |  |  |  | #Cleanup, remove everything | 
| 1618 | 0 |  |  |  |  |  | %{$self} = (); | 
|  | 0 |  |  |  |  |  |  | 
| 1619 |  |  |  |  |  |  |  | 
| 1620 | 0 |  |  |  |  |  | return 1; | 
| 1621 |  |  |  |  |  |  | } | 
| 1622 |  |  |  |  |  |  |  | 
| 1623 |  |  |  |  |  |  | sub Asterisk::AMI::destroyed::AUTOLOAD { | 
| 1624 |  |  |  |  |  |  | #Everything Fails! | 
| 1625 | 0 |  |  | 0 |  |  | return; | 
| 1626 |  |  |  |  |  |  | } | 
| 1627 |  |  |  |  |  |  |  | 
| 1628 |  |  |  |  |  |  | 1; |