Skip to content

Comparing changes

Choose two branches to see what’s changed or to start a new pull request. If you need to, you can also .

Open a pull request

Create a new pull request by comparing changes across two branches. If you need to, you can also .
...
  • 2 commits
  • 12 files changed
  • 0 commit comments
  • 1 contributor
Showing with 32 additions and 174 deletions.
  1. +1 −0 Changes
  2. +1 −5 MANIFEST
  3. +0 −2 Makefile.PL
  4. +25 −26 lib/Clutch/Client.pm
  5. +1 −1 lib/Clutch/Worker.pm
  6. +1 −3 t/001_basic.t
  7. +1 −3 t/002_request_background.t
  8. +1 −4 t/003_request_multi.t
  9. +1 −3 t/004_request_background_multi.t
  10. +0 −9 xt/podcoverage.t
  11. +0 −111 xt/podspell.t
  12. +0 −7 xt/podsynopsis.t
View
1 Changes
@@ -4,6 +4,7 @@ Revision history for Perl extension Clutch
- change protocol
- support request_multi(_background)
- remove Clutch::Admin
+ - no use DWR
0.03 2012/01/25
- more fixed some dist problem.
View
6 MANIFEST
@@ -1,16 +1,15 @@
.dim.pl
.shipit
-bin/clutch-admin.pl
Changes
inc/Module/Install.pm
inc/Module/Install/AuthorTests.pm
inc/Module/Install/Base.pm
inc/Module/Install/Makefile.pm
inc/Module/Install/Metadata.pm
inc/Module/Install/Repository.pm
-inc/Module/Install/Scripts.pm
inc/Module/Install/WriteAll.pm
lib/Clutch.pm
+lib/Clutch/.Worker.pm.swp
lib/Clutch/Client.pm
lib/Clutch/Util.pm
lib/Clutch/Worker.pm
@@ -28,6 +27,3 @@ t/004_request_background_multi.t
t/lib/Worker.pm
xt/perlcritic.t
xt/pod.t
-xt/podcoverage.t
-xt/podspell.t
-xt/podsynopsis.t
View
2 Makefile.PL
@@ -33,8 +33,6 @@ test_requires 'Test::More' => '0.88';
test_requires 'Test::Requires' => '0.06';
test_requires 'Test::TCP' => '1.14';
-install_script 'bin/clutch-admin.pl';
-
auto_set_repository;
tests_recursive;
View
51 lib/Clutch/Client.pm
@@ -2,36 +2,23 @@ package Clutch::Client;
use strict;
use warnings;
use Clutch::Util;
-use Data::WeightedRoundRobin;
use IO::Select;
use Carp ();
sub new {
my $class = shift;
my %args = @_ == 1 ? %{$_[0]} : @_;
-
Carp::croak "Mandatory parameter 'servers'" unless $args{servers};
- %args = (
+ my $rr = delete $args{rr} || 'Clutch::Client::RR';
+
+ bless {
servers => undef,
timeout => 10,
+ rr => $rr->new($args{servers}),
%args,
- );
-
- my $self = bless \%args, $class;
-
- my @servers;
- for my $row (@{$self->{servers}}) {
- if (ref($row) eq 'HASH') {
- push @servers, +{ value => $row->{address}, weight => $row->{weight} };
- }
- else {
- push @servers, $row;
- }
- }
- $self->{dwr} = Data::WeightedRoundRobin->new(\@servers);
- $self;
+ }, $class;
}
sub request_background {
@@ -47,7 +34,7 @@ sub request {
sub _request {
my ($self, $cmd_name, $function, $args) = @_;
- my $server = $self->{dwr}->next;
+ my $server = $self->{rr}->next;
my $sock = Clutch::Util::new_client($server);
my $json_args = Clutch::Util::json->encode($args);
@@ -99,7 +86,7 @@ sub _request_multi {
my %sockets_map;
for my $i (0 .. ($request_count - 1)) {
- my $server = $self->{dwr}->next;
+ my $server = $self->{rr}->next;
my $sock = Clutch::Util::new_client($server);
$is->add($sock);
$sockets_map{$sock}=$i;
@@ -137,6 +124,22 @@ sub _request_multi {
wantarray ? @res : \@res;
}
+package
+ Clutch::Client::RR;
+
+sub new {
+ my ($class, $servers) = @_;
+ bless +{
+ servers => $servers,
+ }, $class;
+}
+
+sub next {
+ my $self = shift;
+ push(@{$self->{servers}}, shift(@{$self->{servers}}));
+ $self->{servers}[0];
+}
+
1;
__END__
@@ -153,9 +156,7 @@ Clutch::Client - distributed job system's client class
use Clutch::Client;
my $args = shift || die 'missing args';
my $client = Clutch::Client->new(
- servers => [
- +{ address => "$worker_ip:$worker_port" },
- ],
+ servers => [ "$worker_ip:$worker_port" ],
);
my $res = $client->request('echo', $args);
print $res, "\n";
@@ -170,11 +171,9 @@ Clutch::Client - distributed job system's client class
The value is a reference to an array of worker addresses.
-If hash reference, the keys are address (scalar), weight (positive rational number)
-
The server address is in the form host:port for network TCP connections
-Client will distribute Data::WeightedRoundRobin.
+Client will distribute basic RoundRobin.
=item $opts{timeout}
View
2 lib/Clutch/Worker.pm
@@ -177,7 +177,7 @@ sub do_request_background {
return;
}
-sub register_function ($$) {
+sub register_function ($$) { ## no critic
my ($function, $code) = @_;
$FUNCTIONS->{$function} = $code;
}
View
4 t/001_basic.t
@@ -10,9 +10,7 @@ test_tcp(
client => sub {
my ($port, $server_pid) = @_;
my $client = Clutch::Client->new(
- servers => [
- +{ address => '127.0.0.1:'.$port },
- ],
+ servers => ['127.0.0.1:'.$port]
);
my $res;
View
4 t/002_request_background.t
@@ -10,9 +10,7 @@ test_tcp(
client => sub {
my ($port, $server_pid) = @_;
my $client = Clutch::Client->new(
- servers => [
- +{ address => '127.0.0.1:'.$port },
- ],
+ servers => ['127.0.0.1:'.$port],
);
my $res;
View
5 t/003_request_multi.t
@@ -14,10 +14,7 @@ test_tcp(
client => sub {
my ($port2, $server_pid2) = @_;
my $client = Clutch::Client->new(
- servers => [
- +{ address => '127.0.0.1:'.$port },
- +{ address => '127.0.0.1:'.$port2 },
- ],
+ servers => ['127.0.0.1:'.$port, '127.0.0.1:'.$port2],
);
my $res;
View
4 t/004_request_background_multi.t
@@ -10,9 +10,7 @@ test_tcp(
client => sub {
my ($port, $server_pid) = @_;
my $client = Clutch::Client->new(
- servers => [
- +{ address => '127.0.0.1:'.$port },
- ],
+ servers => ['127.0.0.1:'.$port],
);
my $res;
View
9 xt/podcoverage.t
@@ -1,9 +0,0 @@
-#!perl -w
-use Test::More;
-eval q{use Test::Pod::Coverage 1.04};
-plan skip_all => 'Test::Pod::Coverage 1.04 required for testing POD coverage'
- if $@;
-
-all_pod_coverage_ok({
- also_private => [qw(unimport BUILD DEMOLISH init_meta)],
-});
View
111 xt/podspell.t
@@ -1,111 +0,0 @@
-#!perl -w
-use strict;
-use Test::More;
-
-eval q{ use Test::Spelling };
-plan skip_all => q{Test::Spelling is not available.}
- if $@;
-
-my @stopwords;
-while(my $line = <DATA>) {
- $line =~ s/ \# [^\n]+ //xms;
- push @stopwords, $line =~ /(\w+)/g;
-}
-add_stopwords(@stopwords);
-
-$ENV{LC_ALL} = 'C';
-all_pod_files_spelling_ok('lib');
-
-__DATA__
-Atsushi Kobayashi
-nekokak@gmail.com
-Clutch
-
-# computer terms
-API
-APIs
-arrayrefs
-arity
-Changelog
-codebase
-committer
-committers
-compat
-cpan
-extention
-datetimes
-dec
-definedness
-destructor
-destructors
-destructuring
-dev
-DWIM
-GitHub
-hashrefs
-hotspots
-immutabilize
-immutabilizes
-immutabilized
-inline
-inlines
-invocant
-invocant's
-irc
-IRC
-isa
-JSON
-login
-namespace
-namespaced
-namespaces
-namespacing
-OO
-OOP
-ORM
-overridable
-parameterizable
-parameterization
-parameterize
-parameterized
-parameterizes
-params
-pluggable
-prechecking
-prepends
-rebase
-rebased
-rebasing
-reblesses
-refactored
-refactoring
-rethrows
-RT
-runtime
-serializer
-stacktrace
-subclassable
-subname
-subtyping
-TODO
-unblessed
-unexport
-unimporting
-Unported
-unsets
-unsettable
-utils
-whitelist
-Whitelist
-workflow
-XS
-MacOS
-MacOSX
-CLI
-HTTP
-
-versa # vice versa
-ish # something-ish
-ness # something-ness
-pre # pre-something
-maint # co-maint
View
7 xt/podsynopsis.t
@@ -1,7 +0,0 @@
-#!perl -w
-use strict;
-use Test::More;
-eval q{use Test::Synopsis};
-plan skip_all => 'Test::Synopsis required for testing SYNOPSIS'
- if $@;
-all_synopsis_ok();

No commit comments for this range

Something went wrong with that request. Please try again.