=cut
+package RevalidatorClient;
+
+use Sys::Syslog qw/:standard :macros/;
+use RPC::XML;
+use RPC::XML::Client;
+use Data::Dumper;
+
+sub new {
+ my $self = bless {}, shift;
+
+ $self->setup(@_);
+ return $self;
+}
+
+sub setup {
+ my ($self, %config) = @_;
+
+ # XXX error_handler, fault_handler, combined_handler
+ # such handlers should syslog and die
+
+ $self->{client} = new RPC::XML::Client($config{revalidator_uri});
+ $self->{config} = \%config;
+}
+
+sub get_event_ids {
+ my ($self, $filename) = @_;
+
+ if (not open FH, "<$filename") {
+ syslog LOG_ERR, "revalidator client could not open $filename";
+ die "revalidator client could not open $filename";
+ }
+
+ my $result = 0;
+ while (<FH>) {
+ next unless /event_ids = ([\d,]+)$/;
+
+ $result = [ map int, split(/,/, $1) ];
+ }
+
+ close FH;
+ return $result;
+}
+
+sub still_valid {
+ my ($self, $filename) = @_;
+ # Here we want to contact Evergreen's open-ils.trigger service and get
+ # a revalidation of the event described in a given file.
+ # We'll return 1 for valid, 0 for invalid.
+
+ my $event_ids = $self->get_event_ids($filename) or return 0;
+
+ print STDERR (Dumper($event_ids), "\n") if $self->{config}->{t};
+
+ return $self->{client}->simple_request("revalidate", $event_ids);
+}
+
+1;
+
+package main;
+
use warnings;
use strict;
use Sys::Syslog qw/:standard :macros/;
use Cwd qw/getcwd/;
-our %config;
-our %opts = (
+my %config;
+my %opts = (
c => "/etc/eg-pbx-daemon.conf",
v => 0,
t => 0,
);
-our $universal_prefix = 'EG';
+my $universal_prefix = 'EG';
sub load_config {
%config = ParseConfig($opts{c});
my $limit = $config{queue_limit} || 0;
my $available = 0;
+my @actually = ();
+
if ($limit) {
$available = $limit - $out_count;
- if ($in_count > $available) {
- @incoming = @incoming[0..($available-1)]; # slice down to correct size
- }
if ($available == 0) {
$opts{t} or syslog LOG_NOTICE, "Queue is full ($limit)";
}
+
+ if ($config{revalidator_uri}) { # USE REVALIDATOR
+ # Take as many files from @incoming as it takes to fill up @actually
+ # with files whose contents describe still-valid events.
+
+ my $revalidator = new RevalidatorClient(%config, %opts);
+
+ for (my $i = 0; $i < $available; $i++) {
+ while (@incoming) {
+ my $candidate = shift @incoming;
+
+ if ($revalidator->still_valid($candidate)) {
+ unshift @actually, $candidate;
+ last;
+ } else {
+ my $newpath = ($config{done_path} || "/tmp") .
+ "/SKIPPED_" . basename($candidate);
+
+ if ($opts{t}) {
+ print "rename $candidate $newpath\n";
+ } else {
+ rename($candidate, $newpath);
+ }
+ }
+ }
+ }
+ } else { # DON'T USE REVALIDATOR
+ if ($in_count > $available) {
+ # slice down to correct size
+ @actually = @incoming[0..($available-1)];
+ }
+ }
}
+# XXX Even without a limit we could still filter by still_valid() in theory,
+# but in practive the user should always use a limit.
+
if ($opts{v}) {
- printf "incoming (total ): %3d\n", $raw_count;
- printf "incoming (future): %3d\n", scalar @future;
- printf "incoming (active): %3d\n", $in_count;
- printf "queued already : %3d\n", $out_count;
- printf "queue_limit : %3d\n", $limit;
- printf "available spots : %3s\n", ($limit ? $available : 'unlimited');
+ printf "incoming (total) : %3d\n", $raw_count;
+ printf "incoming (future) : %3d\n", scalar @future;
+ printf "incoming (active) : %3d\n", $in_count;
+ printf "incoming (filtered): %3d\n", scalar @actually;
+ printf "queued already : %3d\n", $out_count;
+ printf "queue_limit : %3d\n", $limit;
+ printf "available spots : %3s\n", ($limit ? $available : 'unlimited');
}
-foreach (@incoming) {
+foreach (@actually) {
# $opts{v} and print `ls -l $_`; # ' ', (stat($_))[9], " - $now = ", (stat($_))[9] - $now, "\n";
queue($_);
}
+1;
universal_prefix EG01
queue_limit 30
use_allocator 1
+# revalidator_uri http://somehost:12080/
--- /dev/null
+Improvement for telephony: just-in-time event revalidation
+
+One of the shortcomings with using the Action/Trigger based telephony in
+Evergreen until now was that while you might have overdue notices
+generated and sent to a system where Asterisk runs for later calling,
+but if the notice was generated on a Saturday night, and you have Asterisk
+set up not to place any calls again until Monday morning, Asterisk has
+no way of revalidating that call at the last minute. That is, the
+system could not determine whether the items that were overdue on
+Saturday night are still overdue on Monday morning, and whether the call
+should still be made.
+
+Now we have a workable solution to that.
+
+The eg-pbx-allocator.pl script, which takes call files for Asterisk from
+a "staging" directory and slowly drips them onto Asterisk's spool can
+now consult an XML RPC service which in turn asks open-ils.trigger
+whether given events, enumerated within the call files themselves, are
+still valid.
+
+Why the indirection? Why not just ask open-ils.trigger directly?
+Evergreen Telephony with Action/Trigger was designed so that Asterisk can
+be run on a machine separate from your Evergreen servers, if desired,
+and not on the OpenSRF network with them. If open-ils.trigger were a
+public service, we could access it via the HTTP gateway or other methods,
+but since it's a sensitive service not designed to be public, the XML
+RPC server introduced here allows only the necessary narrow access to
+one new open-ils.trigger method for event revalidation. This means that
+if you want to use this feature, your Asterisk server does need minimal
+network connectivity into your Evergreen system, but with conservative
+network configuration, you can limit that connectivity to a single TCP
+port on a utility server, and not full blown access.
+
+If you don't plan to segregate Asterisk on a system that's not on the
+OpenSRF network, then you don't care about the preceding paragraph, and
+everything still works.
+
+The XML RPC server I've been talking about (revalidator-daemon.pl) could
+potentially be extended to offer other just-in-time information to the
+allocator right before a call goes onto Asterisk's spool. For example,
+that might be a good time to check the time of day and make a late
+decision on which phone number to use for a given user (day_phone,
+evening_phone,other_phone).
+
+To use the revalidator, run it on a system where open-ils.trigger runs, and
+then on the system where Asterisk runs, uncomment the revalidator_uri variable
+in eg-pbx-daemon.conf and set it appropriately.
--- /dev/null
+#!/usr/bin/perl
+
+use warnings;
+use strict;
+
+{
+ no strict;
+ no warnings;
+ require "/openils/bin/oils_header.pl";
+};
+
+use RPC::XML::Server;
+#use Config::General qw/ParseConfig/;
+use Getopt::Long;
+use Data::Dumper;
+$Data::Dumper::Indent = 0;
+
+use OpenSRF::Utils::Logger qw/:logger/;
+
+my %opts = (
+ "config-file" => "/openils/conf/opensrf_core.xml",
+ "port" => 12080
+);
+
+my $failure = sub {
+ my $msg = shift;
+
+ $logger->error($msg);
+
+ return new RPC::XML::fault(faultCode => 500, faultString => $msg);
+};
+
+my $bad_request = sub {
+ my $msg = shift;
+
+ $logger->warn($msg);
+
+ return new RPC::XML::fault(faultCode => 400, faultString => $msg);
+};
+
+
+sub revalidate {
+ my $r = simplereq(
+ "open-ils.trigger",
+ "open-ils.trigger.event_group.revalidate.test",
+ @_
+ );
+
+ if (oils_is_event($r)) {
+ $logger->warn(
+ "open-ils.trigger.event_group.revalidate.test returned event: " .
+ Dumper($r)
+ );
+ return 0;
+ }
+
+ return $r;
+}
+
+sub main {
+ GetOptions(\%opts, qw/config-file=s port=i/);
+
+ {
+ no warnings;
+ no strict;
+ osrf_connect($opts{"config-file"});
+ };
+
+ my $server;
+
+ if (!($server = new RPC::XML::Server(port => $opts{port}))) {
+ my $msg = "Failed to get new RPC::XML::Server: $!";
+ $logger->error($msg);
+ die $msg;
+ }
+
+ $logger->info("RPC::XML::Server started");
+
+ # Regarding signatures:
+ # ~ the first datatype is for RETURN value,
+ # ~ any other datatypes are for INCOMING args
+ #
+ # Everything here returns a struct.
+
+ $server->add_proc({
+ name => 'revalidate',
+ code => \&revalidate,
+ signature => ['int array']
+ });
+
+ $server->add_default_methods;
+ $server->server_loop;
+ 0;
+}
+
+main @ARGV;
argc => 1
);
+sub revalidate_event_group_test {
+ my $self = shift;
+ my $client = shift;
+ my $events = shift;
+
+ my $e = OpenILS::Application::Trigger::EventGroup->new(@$events);
+
+ my $result = $e->revalidate_test;
+
+ $e->editor->disconnect;
+ OpenILS::Application::Trigger::Event->ClearObjectCache();
+
+ return $result;
+}
+__PACKAGE__->register_method(
+ api_name => 'open-ils.trigger.event_group.revalidate.test',
+ method => 'revalidate_event_group_test',
+ api_level=> 1,
+ argc => 1,
+ signature => {
+ desc => q/revalidate a group of events.
+ This does not actually update the events (so there will be no change
+ of atev.state or anything else in the database, unless an event's
+ validator makes changes out-of-band).
+
+ This returns 1 or 0. It returns 1 if **ANY** event in the group tests
+ as valid. Otherwise it return 0.
+ /,
+ params => [
+ {name => "events", type => "array", desc => "list of event ids"}
+ ]
+ }
+);
+
+
sub pending_events {
my $self = shift;
my $client = shift;
return $self;
}
+sub revalidate_test {
+ my $self = shift;
+
+ if ($self->build_environment->environment->{complete}) {
+ try {
+ $self->valid(
+ OpenILS::Application::Trigger::ModRunner::Validator->new(
+ $self->event->event_def->validator,
+ $self->environment
+ )->run->final_result
+ );
+ } otherwise {
+ $log->error("Event revalidation failed with ". shift());
+ };
+
+ return 1 if defined $self->valid and $self->valid;
+ return 0;
+ }
+
+ $logger->error(
+ "revalidate: could not build environment for event " .
+ $self->event->id
+ );
+ return 0;
+}
+
sub cleanedup {
my $self = shift;
return undef unless (ref $self);
return $self;
}
+sub revalidate_test {
+ my $self = shift;
+
+ $self->editor->xact_begin;
+
+ my @valid_events;
+ try {
+ for my $event ( @{ $self->events } ) {
+ push @valid_events, $event if $event->revalidate_test;
+ }
+ $self->editor->xact_rollback;
+ } otherwise {
+ $log->error("Event group validation failed with ". shift());
+ $self->editor->xact_rollback;
+ };
+
+ # If any member of the group is valid, return true
+ return (scalar(@valid_events) > 0 ? 1 : 0);
+}
+
sub cleanedup {
my $self = shift;
return undef unless (ref $self);