Foundations of Action/Triger-based telephony,
[working/Evergreen.git] / Open-ILS / src / perlmods / OpenILS / Application / Trigger / Reactor / AstCall.pm
1 package OpenILS::Application::Trigger::Reactor::AstCall;
2 use base 'OpenILS::Application::Trigger::Reactor';
3 use OpenSRF::Utils::Logger qw($logger);
4 # use OpenILS::Application::AppUtils;
5 use OpenILS::Utils::CStoreEditor qw/:funcs/;
6
7 use strict; use warnings;
8 use Error qw/:try/;
9 use Data::Dumper;
10
11 use OpenSRF::Utils::SettingsClient;
12 use RPC::XML::Client;
13 $Data::Dumper::Indent = 0;
14
15 my $U = 'OpenILS::Application::AppUtils';
16
17 my $e = new_editor(xact => 1);
18
19 # $last_channel_used is:
20 # ~ index (not literal value) of last channel used in a callfile
21 # ~ index is of position in @channels (zero-based)
22 # ~ cached at package level
23 # ~ typically for Zap (PSTN), not VOIP
24
25 our @channels;
26 our $last_channel_used = 0;
27 our $telephony;
28
29 sub ABOUT {
30     return <<ABOUT;
31
32     The AstCall reactor module creates a callfile for Asterisk, given a
33     template describing the message and an environment defining
34     necessary information for contacting the Asterisk server and scheduling
35     a call with it.
36
37 ABOUT
38 }
39
40 sub get_conf {
41    # $logger->info(__PACKAGE__ . ": get_conf()");
42     $telephony and return $telephony;
43     my $config = OpenSRF::Utils::SettingsClient->new;
44     # config object cached by package
45     $telephony = $config->config_value('notifications', 'telephony');
46     return $telephony;
47 }
48
49 sub get_channels {
50     @channels and return @channels;
51     my $config = get_conf();    # populated $telephony object
52     @channels = @{ $config->{channels} };
53     return @channels;
54 }
55
56 sub next_channel {
57     # Increments $last_channel_used, or resets it to zero, as necessary.
58     # Returns appropriate value from channels array.
59     my @chans = get_channels();
60     unless(@chans) {
61         $logger->error(__PACKAGE__ . ": Cannot build call using " .
62             (shift ||'driver') .
63             ", no notifications.telephony.channels found in config!");
64         return;
65     }
66     if (++$last_channel_used > $#chans) {
67         $last_channel_used = 0;
68     }
69     return $chans[$last_channel_used];     # say, 'Zap/1' or 'Zap/12'
70 }
71
72 sub channel {
73     my $tech = get_conf()->{driver} || 'SIP';
74     if ($tech !~ /^SIP/) {
75         return next_channel($tech);
76     }
77     return $tech;                          #  say, 'SIP' or 'SIP/ubab33'
78 }
79
80 sub get_extra_lines {
81     my $lines = get_conf()->{callfile_lines} or return '';
82     my @fixed;
83     foreach (split "\n", $lines) {
84         s/^\s*//g;      # strip leading spaces
85         /\S/ or next;   # skip empty lines
86         push @fixed, $_;
87     }
88     (scalar @fixed) or return '';
89     return join("\n", @fixed) . "\n";
90 }
91
92 sub host_string {
93     my $conf = get_conf();
94     my $host = $conf->{host};
95     unless ($host) {
96         $logger->error(__PACKAGE__ . ": No telephony/host in config.");
97         return;
98     }
99
100     # prepend http:// if no protocol specified
101     $host =~ /^\S+:\/\// or $host  = 'http://' . $host;
102     # append port number if specified
103     $conf->{port} and $host .= ":" . $conf->{port};
104
105     return $host;
106 }
107 sub rpc_client {
108     # TODO: caching? (would take testing to ensure memory and
109     # connections are clean/stable)
110     my $host = (@_ ? shift : host_string()) or return;
111     return new RPC::XML::Client($host);
112 }
113
114 sub handler {
115     my ($self, $env) = @_;
116
117     $logger->info(__PACKAGE__ . ": entered handler");
118
119     # assignment, not comparison
120     unless ($env->{channel_prefix} = channel()) {
121         $logger->error(__PACKAGE__ . ": Cannot find tech/resource in config");
122         return 0;
123     }
124
125     $env->{extra_lines} = get_extra_lines() || '';
126     my $tmpl_output = $self->run_TT($env);
127     if (not $tmpl_output) {
128         $logger->error(__PACKAGE__ . ": no template input");
129         return 0;
130     }
131
132     my @eventids = map {$_->id} @{$env->{event}};
133     @eventids or push @eventids, '';
134
135     my $eo = Fieldmapper::action_trigger::event_output->new;
136
137     # XXX we have to actually create this in the DB now if we expect to use the
138     # ID later
139     $eo->data("");
140     $eo = $e->create_action_trigger_event_output($eo) or return $e->die_event;
141     if ($env->{"extra_lines"}) {
142         $tmpl_output .= ";; added by handler:\n";
143         $tmpl_output .= $env->{"extra_lines"};
144     }
145
146     # or would we prefer distinct lines instead of comma-separated?
147     $tmpl_output .= "; event_ids = " . join(",",@eventids) . "\n";
148     $tmpl_output .= "; event_output = " . $eo->id . "\n";
149
150     #my $filename_fragment = $userid . '_' . $eventids[0] . 'uniq' . time;
151     # not $noticetype,
152     # the event_output.id tells us all we need to know
153     # XXX why is id in here twice?
154     my $filename_fragment = $eo->id . '_' . $eo->id;
155
156     # TODO: add scheduling intelligence and use it here... or not if
157     # relying only on crontab
158     my $client = rpc_client();
159     my $resp = $client->send_request(
160         'inject', $tmpl_output, $filename_fragment, 0
161     ); # FIXME: 0 could be seconds-from-epoch UTC if deferred call needed
162
163     $logger->debug(
164         ref $resp ? ("Response: " . Dumper($resp->value)) : "Error: $resp"
165     );
166
167     if ($resp->{code} and $resp->{code}->value == 200) {
168         $eo->is_error('f');
169         $eo->data('filename: ' . $resp->{spooled_filename}->value);
170         # could look for the file that replaced it
171     } else {
172         $eo->is_error('t');
173         my $msg = $resp->{faultcode} ? $resp->{faultcode}->value :
174                     $resp->{     code} ? $resp->{     code}->value :
175                         " -- UNKNOWN response '$resp'";
176         $msg .= " for $filename_fragment";
177         $eo->data("Error " . $msg);
178         $logger->error(__PACKAGE__ . ": Mediator Error " . $msg);
179     }
180
181     # Now point all our events' async_output to the newly made row
182 #    $eo = $env->{EventProcessor}->editor->
183 #        create_action_trigger_event_output( $eo );
184     $e->update_action_trigger_event_output($eo) or return $e->die_event;
185     foreach (@eventids) {
186         my $event = $e->retrieve_action_trigger_event($_);
187         $event->async_output($eo->id);
188         $e->update_action_trigger_event($event);
189     }
190     $e->commit;    # defer till after loop?
191
192     # TODO: a sub for saving async_output might belong in Trigger.pm
193     1;
194 }
195
196 sub _files {
197     my $response = shift or return;
198     return map {$response->{$_}} sort grep {/^file_\d*/} keys %$response;
199 }
200
201 =head1 EXAMPLE CALFILES
202
203 Note: all lines start flush left (no leading whitespace)
204
205 =head2 Example callfile (successful)
206
207     Channel: SIP/ubab33/17707775555
208     Context: overdue-test
209     MaxRetries: 1
210     RetryTime: 60
211     WaitTime: 30
212     Extension: 10
213     Archive: 1
214     Set: items=1
215     Set: titlestring=chez nos gens;; added by OpenILS::Application::Trigger::Reactor::AstCall handler:
216     ; event_ids = 123,145
217     ; event_output = 14;; added by inject() in the mediator
218     Set: callfilename=EG_1258060382_6.call
219
220     StartRetry: 2139 1 (1258060442)
221     Status: Completed
222     Channel: SIP/ubab33/17707775555
223
224 =head2 Example callfile (FAILED)
225
226     CallerID: "Jack Jackson" <17707775555>
227     Context: overdue-test
228     MaxRetries: 1
229     RetryTime: 60
230     WaitTime: 30
231     Extension: 10
232     Archive: 1
233     Set: items=1
234     Set: titlestring=Land Before Time;; added by OpenILS::Application::Trigger::Reactor::AstCall handler:
235     Set: LOOP=1
236     Set: callfilename=EG_joe_20091109145355.call
237
238     StartRetry: 2139 1 (1257907526)
239     ; FAILED: 0
240
241     EndRetry: 2139 1 (1257907496)
242
243     StartRetry: 2139 2 (1257907617)
244     ; FAILED: 0
245     Status: Expired
246
247 =head2 Possible data structure:
248
249  $feedback = {
250      status => val,
251      attempts => [ $attempt1, $attempt2 ... $attemptN ],
252      anything_else => scalar,
253  }
254  ...
255  $attempt = {
256      time => secs from epoch (UTC) for the BEGINNING of the call,
257      duration => secs,
258      failed => code,
259  }
260
261 =cut
262
263 sub feedback_hash {
264     # parses the done callfile comments from Mediator
265     # return ref to hash
266     my $content  = shift or return;
267     my %hash     = ();
268     # my @attempts = ();
269     my @lines    = split "\n", $content;
270     foreach (shift @lines) {
271         s/^\s*(Set:\s*)?//i;   # strip leading whitespace, and possible "Set:"
272         if (/^StartRetry: \d+ (\d+) \((\d+)\)/) {
273             # go parse  an attempt;
274             # go record an attempt;
275         }
276         if (/^(Status):\s*(\S+)/i or /^;+\s*(FAILED):\s*(\S*)/i) {
277             $hash{lc $1} = $2;
278             next;
279         }
280
281         /^;+\s*(\S+)\s*[=:]\s*([^;]*)$/ and $hash{lc $1} = $2;
282     }
283     if (exists $hash{failed}) {
284         $hash{failcode} = $hash{failed};
285         # b/c "0" is a common failcode and we want a more binary indicator
286         $hash{failed}   = 1;
287     }
288     return \%hash;
289 }
290
291 sub cleanup {
292     my $self   = shift or return;
293     my $files  = join(',',@_) or return;
294     my $client = rpc_client();
295     return $client->send_request('cleanup', $files);
296     # TODO: more error checking
297 }
298
299 sub retrieve {
300     my $self   = shift or return;
301     my $client = rpc_client();
302     my $resp   = $client->send_request('retrieve');
303     unless ($resp and ref $resp) {
304          $logger->error(
305              __PACKAGE__ . ": Mediator Error: " .
306              ($resp ? 'Bad' : 'No') . " response to retrieve request"
307          );
308          return;
309     }
310
311     # my $count   = $resp{match_count}; # how many files we should have
312     # my @rm_list = ();
313     my @files   = _files($resp);
314     foreach (@files) {
315         my $content  = $resp->{$_}->content;
316         my $filename = $resp->{$_}->filename;
317         unless ($content) {
318             $logger->error(__PACKAGE__ .
319                 ": Mediator sent incomplete/unintelligible message for " .
320                 "filename " . ($filename || 'UNKNOWN'));
321             next;
322         }
323         my $feedback = feedback_hash($content);
324         my $output   = $e->retrieve_action_trigger_event_output(
325             $feedback->{event_output}
326         );
327         if ($content == $output->data) {
328             $logger->error(
329                 __PACKAGE__ . ": Mediator sent duplicate file "
330                 . $resp->{$_}->filename . " for event_output " .
331                 $feedback->{event_output}
332             );
333         } else {
334             $output->data($content);
335         }
336         $e->commit;     # defer until after loop? probably not
337         my $clean = $client->send_request('cleanup', $filename);
338         # TODO: deletion by (comma-separated) filenames in chunks
339         # instead of individually?
340         # push @rm_list, $_; $client->send_request('cleanup', join(',',@rm_list));
341         unless ($clean and ref $clean) {
342             $logger->error(
343                 __PACKAGE__ . ": Mediator Error: " .
344                 ($clean ? 'Bad' : 'No') .
345                 " response to cleanup $filename request");
346             next;
347         }
348         unless ($clean->{code}->value == 200 and $clean->{delete_count}) {
349             $logger->error(__PACKAGE__ . ": cleanup $filename returned " . (
350                 $resp->{faultcode} ? $resp->{faultcode}->value :
351                     $resp->{     code} ? $resp->{     code}->value :
352                         " -- UNKNOWN response '$resp'"
353             ) . " with delete_count " .
354             (defined $clean->{delete_count} ? $clean->{delete_count} : 'UNDEF'));
355         }
356     }
357     return @files;
358 }
359
360 1;