Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

redis is a bit smarter now

  • Loading branch information...
commit af7a79f457757c22cb0a3a2477b21f2227751898 1 parent dbf7f8c
Gatlin C Johnson authored
Showing with 51 additions and 96 deletions.
  1. +3 −3 config.sample
  2. +48 −93 pass
View
6 config.sample
@@ -1,4 +1,4 @@
---
-port: 6379
-host: "localhost"
-timeout: 100
+port: ####
+host: "####"
+timeout: ###
View
141 pass
@@ -3,114 +3,69 @@
use v5.16;
use strict;
use warnings;
-use Carp;
-use FindBin qw($Bin);
-use lib "$Bin/lib";
-use Redis;
-use Redis::Handle;
+use EV;
+use AnyEvent;
+use AnyEvent::Redis;
use YAML qw(Load Dump LoadFile);
-use feature qw(say);
use Data::UUID;
+use Data::Dump qw(pp);
-sub pipe_to_child ($) {
- no strict 'refs';
- my $parent = shift;
- pipe my $child, $parent or die;
- my $pid = fork;
- die "fork() failed: $!" unless defined $pid;
- if ($pid) {
- close $child;
- }
- else {
- close $parent;
- open(STDIN, "<&=" . fileno($child)) or die "$!";
- }
- $pid;
-}
+my %pid_of; my %dispatch;
+my $config = LoadFile("config");
+$config->{host} //= "localhost";
+$config->{port} //= 6379;
+$config->{timeout} //= 100;
-my %pid_of;
+my $redis = AnyEvent::Redis->new(
+ host => $config->{host},
+ port => $config->{port},
+ encoding => 'utf8',
+ on_error => sub { warn @_ },
+ on_cleanup => sub { warn "Connection closed: @_" },
+);
-$SIG{CHLD} = sub {
- local ($!, $?);
- my $pid = waitpid -1, 0;
- return if $pid == -1;
- my %children = reverse %pid_of;
- my $id = $children{$pid};
- return unless $id;
- tie local *APPERR, q(Redis::Handle), qq($id:err);
- print APPERR "${id}KILL by signal $?";
- close APPERR;
- delete $pid_of{$id};
-};
+open my $problemClassFile, "<", $ARGV[0]; my $class;
+do { local $/; $class = <$problemClassFile>; };
-my $problemClass;
-my %dispatch = (
+%dispatch = (
solve => sub {
my %op = %{+shift};
- my ($id,$instance,$classKey) = @op{qw(id instance classKey)};
-
- if (my $pid = pipe_to_child(q(CHILD))) {
- $pid_of{$id} = $pid;
- print CHILD "$id\n";
- print CHILD "$classKey\n";
- print CHILD "$instance\n";
- close CHILD;
- }
- else {
- my $id = <STDIN>;
- chomp $id;
+ my ($id,$instance) = @op{qw(id instance)};
+ chomp $instance;
- my $classKey = <STDIN>;
- chomp $classKey;
+ use File::Temp qw(tempfile);
+ my ($fh,$filename) = tempfile;
- my $instance;
- do { local $/; $instance = <STDIN>; };
- chomp $instance;
-
- my $class = Redis->new->get($classKey);
- use File::Temp qw(tempfile);
- my ($fh,$filename) = tempfile;
- print $fh "$class$instance";
- close $fh;
+ my $res = `clingo 100 $filename`;
+ my @answers = ($res =~ m/Answer: \d+\n(.+)\n/g);
+ $redis->lpush("$id:result" => Dump(\@answers), sub {});
+ },
- tie local *STDOUT, q(Redis::Handle), "$id:result"
- or croak "Couldn't tie STDOUT to [$id]: $!";
- tie local *STDERR, q(Redis::Handle), "$id:err"
- or croak "Couldn't tie STDERR to [$id]: $!";
+ test => sub {
+ say "command ran";
+ my %op = %{+shift};
+ my ($id, $instance) = @op{qw(id instance)};
+ chomp $instance;
- my $res = `clingo 100 $filename`;
- my @answers = ($res =~ m/Answer: \d+\n(.+)\n/g);
- say Dump(\@answers);
- exit(0);
- }
+ my @answers = (1..2);
+ say "output printed to $id:result";
+ $redis->lpush("$id:result" => Dump(\@answers));
},
);
-# MAIN
-my $config = LoadFile("config");
-$config->{host} //= "localhost";
-$config->{port} //= 6379;
-$config->{timeout} //= 100;
-
-open my $problemClassFile, "<", $ARGV[0];
-do { local $/; $problemClass = <$problemClassFile>; };
-my $classKey = Data::UUID->new->create_str;
-Redis->new->set($classKey => $problemClass);
+sub handle {
+ my $result = shift;
+ my $op = Load($result->[1]);
+ say "received job: $op->{id}";
+ $redis->rpush('jobkeys', $op->{id}, sub {});
+ $dispatch{$op->{command}}->($op);
+}
while (1) {
- tie local *QUEUE, q(Redis::Handle), q(command),
- timeout => $config->{timeout},
- host => $config->{host},
- port => $config->{port}
- or die $!;
-
- while (<QUEUE>) {
- my $op = Load($_);
- say "received job:\n",$op->{instance};
- $op->{classKey} = $classKey;
- Redis->new->rpush(q(jobkeys) , $op->{id});
- $dispatch{$op->{command}}->($op);
- }
- close QUEUE;
+ my $cv = $redis->brpop('command',1000);
+ my $res; eval {
+ $res = $cv->recv;
+ handle($res);
+ };
+ warn $@ if $@;
}
-close QUEUE;
Please sign in to comment.
Something went wrong with that request. Please try again.