=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});
$opts{v} and print $msg . "\n";
}
-sub still_valid {
- my ($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.
-
- print STDERR "filename is $filename\n"; # XXX
-
- return 1;
-}
-
### MAIN ###
getopts('htvc:', \%opts) or pod2usage(2);
$opts{t} or syslog LOG_NOTICE, "Queue is full ($limit)";
}
- # Take as many files from @incoming as it takes to fill up @actually
- # with files whose contents describe still-valid events.
- for (my $i = 0; $i < $available; $i++) {
- while (@incoming) {
- my $candidate = shift @incoming;
- if (still_valid($candidate)) {
- unshift @actually, $candidate;
- last;
+ 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 should still filter by still_valid() in theory,
+# 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}) {
queue($_);
}
+1;
--- /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;