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