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     # 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         $logger->info("retrieve() not implemented. how'd we get here?"); # XXX
 301         return;
 302 }
 303
 304 #sub retrieve {
 305 #    my $self   = shift or return;
 306 #    my $client = rpc_client();
 307 #    my $resp   = $client->send_request('retrieve');
 308 #    unless ($resp and ref $resp) {
 309 #         $logger->error(
 310 #             __PACKAGE__ . ": Mediator Error: " .
 311 #             ($resp ? 'Bad' : 'No') . " response to retrieve request"
 312 #         );
 313 #         return;
 314 #    }
 315 #
 316 #    # my $count   = $resp{match_count}; # how many files we should have
 317 #    # my @rm_list = ();
 318 #    my @files   = _files($resp);
 319 #    foreach (@files) {
 320 #        my $content  = $resp->{$_}->content;
 321 #        my $filename = $resp->{$_}->filename;
 322 #        unless ($content) {
 323 #            $logger->error(__PACKAGE__ .
 324 #                ": Mediator sent incomplete/unintelligible message for " .
 325 #                "filename " . ($filename || 'UNKNOWN'));
 326 #            next;
 327 #        }
 328 #        my $feedback = feedback_hash($content);
 329 #        my $output   = $e->retrieve_action_trigger_event_output(
 330 #            $feedback->{event_output}
 331 #        );
 332 #        if ($content == $output->data) {
 333 #            $logger->error(
 334 #                __PACKAGE__ . ": Mediator sent duplicate file "
 335 #                . $resp->{$_}->filename . " for event_output " .
 336 #                $feedback->{event_output}
 337 #            );
 338 #        } else {
 339 #            $output->data($content);
 340 #        }
 341 #        $e->commit;     # defer until after loop? probably not
 342 #        my $clean = $client->send_request('cleanup', $filename);
 343 #        # TODO: deletion by (comma-separated) filenames in chunks
 344 #        # instead of individually?
 345 #        # push @rm_list, $_; $client->send_request('cleanup', join(',',@rm_list));
 346 #        unless ($clean and ref $clean) {
 347 #            $logger->error(
 348 #                __PACKAGE__ . ": Mediator Error: " .
 349 #                ($clean ? 'Bad' : 'No') .
 350 #                " response to cleanup $filename request");
 351 #            next;
 352 #        }
 353 #        unless ($clean->{code}->value == 200 and $clean->{delete_count}) {
 354 #            $logger->error(__PACKAGE__ . ": cleanup $filename returned " . (
 355 #                $resp->{faultcode} ? $resp->{faultcode}->value :
 356 #                    $resp->{     code} ? $resp->{     code}->value :
 357 #                        " -- UNKNOWN response '$resp'"
 358 #            ) . " with delete_count " .
 359 #            (defined $clean->{delete_count} ? $clean->{delete_count} : 'UNDEF'));
 360 #        }
 361 #    }
 362 #    return @files;
 363 #}
 364
 365 1;