[openssl-commits] [tools] master update
Richard Levitte
levitte at openssl.org
Wed Jun 14 08:32:06 UTC 2017
The branch master has been updated
via 851081ea0b61dfbc4f5b8cfffe5ea97ee388a715 (commit)
via 5297816332bda684feabba0441269ca0d5c37165 (commit)
from 604dd16ed723ee1ce23762f2f06b0fd73065a92b (commit)
- Log -----------------------------------------------------------------
commit 851081ea0b61dfbc4f5b8cfffe5ea97ee388a715
Author: Richard Levitte <richard at levitte.org>
Date: Wed Jun 14 10:27:57 2017 +0200
OpenSSL-Query: Implement late evaluation further in the REST client
In the base class, take note of all implementions, not just the first
that initiated successfully. Instead, use all impllementations in the
methods, and return the value from the first successful one.
For the REST implementations, this means moving the check of server
errors to the implementation methods instead of doing so when building
the object.
commit 5297816332bda684feabba0441269ca0d5c37165
Author: Richard Levitte <richard at levitte.org>
Date: Wed Jun 14 10:27:05 2017 +0200
QueryApp: standardise entirely on Carp in the lib
-----------------------------------------------------------------------
Summary of changes:
OpenSSL-Query/lib/OpenSSL/Query.pm | 57 +++++++++++++++++++++------
OpenSSL-Query/lib/OpenSSL/Query/ClaREST.pm | 21 +++++-----
OpenSSL-Query/lib/OpenSSL/Query/PersonREST.pm | 24 ++++++-----
QueryApp/lib/OpenSSL/Query/PersonDB.pm | 1 +
QueryApp/lib/OpenSSL/Query/Role/Bureau.pm | 4 +-
5 files changed, 74 insertions(+), 33 deletions(-)
diff --git a/OpenSSL-Query/lib/OpenSSL/Query.pm b/OpenSSL-Query/lib/OpenSSL/Query.pm
index 94b0cab..3d884bc 100644
--- a/OpenSSL-Query/lib/OpenSSL/Query.pm
+++ b/OpenSSL-Query/lib/OpenSSL/Query.pm
@@ -49,15 +49,15 @@ sub _new_type {
my @packages =
map { (sort keys %{$register_impl{$type}->{$_}}) }
sort keys %{$register_impl{$type}};
- my $obj = undef;
+ my @objs = ();
while (@packages) {
- $obj = (shift @packages)->new(@args);
- last if $obj;
+ my $obj = (shift @packages)->new(@args);
+ push @objs, $obj if $obj;
}
- croak "No implementation for $type queries" unless $obj;
+ croak "No implementation for $type queries" unless @objs;
- return $obj;
+ return @objs;
}
sub new {
@@ -68,44 +68,77 @@ sub new {
bless $self, $class;
foreach (('person', 'cla')) {
- $self->{$_} = $self->_new_type($_, @args);
+ $self->{$_} = [ $self->_new_type($_, @args) ];
}
return $self;
}
+sub _perform {
+ my $self = shift;
+ my $sub = shift;
+ my $opts = shift;
+
+ croak "\$opts MUST be a HASHref" unless ref($opts) eq "HASH";
+
+ my @errors = ();
+ foreach (@{$self->{person}}) {
+ my @result = eval { $sub->($_, $opts, @_) };
+ return @result unless $@;
+ push @errors, $@;
+ }
+
+ croak join("\n", @errors);
+}
+
# Person methods
sub find_person {
my $self = shift;
- return wantarray
- ? ($self->{person}->find_person(@_)) : $self->{person}->find_person(@_);
+ $self->_perform(sub { my $obj = shift;
+ my $opts = shift;
+ return $opts->{wantarray}
+ ? ($obj->find_person(@_))
+ : $obj->find_person(@_); },
+ { wantarray => wantarray }, @_);
}
sub find_person_tag {
my $self = shift;
- $self->{person}->find_person_tag(@_);
+ $self->_perform(sub { my $obj = shift;
+ my $opts = shift;
+ $obj->find_person_tag(@_) },
+ { wantarray => wantarray }, @_);
}
sub is_member_of {
my $self = shift;
- $self->{person}->is_member_of(@_);
+ $self->_perform(sub { my $obj = shift;
+ my $opts = shift;
+ $obj->is_member_of(@_) },
+ { wantarray => wantarray }, @_);
}
# Group methods
sub members_of {
my $self = shift;
- $self->{person}->members_of(@_);
+ $self->_perform(sub { my $obj = shift;
+ my $opts = shift;
+ $obj->members_of(@_) },
+ { wantarray => wantarray }, @_);
}
# Cla methods
sub has_cla {
my $self = shift;
- $self->{cla}->has_cla(@_);
+ $self->_perform(sub { my $obj = shift;
+ my $opts = shift;
+ $obj->has_cla(@_) },
+ { wantarray => wantarray }, @_);
}
1;
diff --git a/OpenSSL-Query/lib/OpenSSL/Query/ClaREST.pm b/OpenSSL-Query/lib/OpenSSL/Query/ClaREST.pm
index e643f24..a92ef8c 100644
--- a/OpenSSL-Query/lib/OpenSSL/Query/ClaREST.pm
+++ b/OpenSSL-Query/lib/OpenSSL/Query/ClaREST.pm
@@ -22,18 +22,18 @@ has base_url => ( is => 'ro', default => 'https://api.openssl.org' );
has _clahandler => ( is => 'ro', builder => 1 );
sub _build__clahandler {
- return LWP::UserAgent->new();
+ return LWP::UserAgent->new( keep_alive => 1 );
}
-# Validation
-sub BUILD {
- my $self = shift;
-
- # print STDERR Dumper(@_);
- my $ua = $self->_clahandler;
- my $resp = $ua->get($self->base_url);
- croak "Server error: ", $resp->message if $resp->is_server_error;
-}
+## Validation
+#sub BUILD {
+# my $self = shift;
+#
+# # print STDERR Dumper(@_);
+# my $ua = $self->_clahandler;
+# my $resp = $ua->get($self->base_url);
+# croak "Server error: ", $resp->message if $resp->is_server_error;
+#}
sub has_cla {
my $self = shift;
@@ -42,6 +42,7 @@ sub has_cla {
my $ua = $self->_clahandler;
my $json = $ua->get($self->base_url . '/0/HasCLA/'
. uri_encode($id, {encode_reserved => 1}));
+ croak "Server error: ", $json->message if $json->is_server_error;
return $json->code == 200;
}
diff --git a/OpenSSL-Query/lib/OpenSSL/Query/PersonREST.pm b/OpenSSL-Query/lib/OpenSSL/Query/PersonREST.pm
index 729fb4e..082c877 100644
--- a/OpenSSL-Query/lib/OpenSSL/Query/PersonREST.pm
+++ b/OpenSSL-Query/lib/OpenSSL/Query/PersonREST.pm
@@ -22,18 +22,18 @@ has base_url => ( is => 'ro', default => 'https://api.openssl.org' );
has _personhandler => ( is => 'lazy', builder => 1 );
sub _build__personhandler {
- return LWP::UserAgent->new();
+ return LWP::UserAgent->new( keep_alive => 1 );
}
-# Validation
-sub BUILD {
- my $self = shift;
-
- # print STDERR Dumper(@_);
- my $ua = $self->_personhandler;
- my $resp = $ua->get($self->base_url);
- croak "Server error: ", $resp->message if $resp->is_server_error;
-}
+## Validation
+#sub BUILD {
+# my $self = shift;
+#
+# # print STDERR Dumper(@_);
+# my $ua = $self->_personhandler;
+# my $resp = $ua->get($self->base_url);
+# croak "Server error: ", $resp->message if $resp->is_server_error;
+#}
sub find_person {
my $self = shift;
@@ -42,6 +42,7 @@ sub find_person {
my $ua = $self->_personhandler;
my $json = $ua->get($self->base_url . '/0/Person/'
. uri_encode($id, {encode_reserved => 1}));
+ croak "Server error: ", $json->message if $json->is_server_error;
return () unless $json->code == 200;
my $decoded = decode_json $json->decoded_content;
@@ -60,6 +61,7 @@ sub find_person_tag {
. uri_encode($id, {encode_reserved => 1})
. '/ValueOfTag/'
. uri_encode ($tag, {encode_reserved => 1}));
+ croak "Server error: ", $json->message if $json->is_server_error;
return undef unless $json->code == 200;
my $decoded = decode_json $json->decoded_content;
@@ -78,6 +80,7 @@ sub is_member_of {
. uri_encode($id, {encode_reserved => 1})
. '/IsMemberOf/'
. uri_encode ($group, {encode_reserved => 1}));
+ croak "Server error: ", $json->message if $json->is_server_error;
return 0 unless $json->code == 200;
my $decoded = decode_json $json->decoded_content;
@@ -95,6 +98,7 @@ sub members_of {
. '/0/Group/'
. uri_encode($group, {encode_reserved => 1})
. '/Members');
+ croak "Server error: ", $json->message if $json->is_server_error;
return () unless $json->code == 200;
my $decoded = decode_json $json->decoded_content;
diff --git a/QueryApp/lib/OpenSSL/Query/PersonDB.pm b/QueryApp/lib/OpenSSL/Query/PersonDB.pm
index 7c6e677..4d9ede3 100644
--- a/QueryApp/lib/OpenSSL/Query/PersonDB.pm
+++ b/QueryApp/lib/OpenSSL/Query/PersonDB.pm
@@ -10,6 +10,7 @@
use strict;
package OpenSSL::Query::PersonDB;
+
use Carp;
use Moo;
use OpenSSL::Query qw(-register-person OpenSSL::Query::PersonDB -priority 0);
diff --git a/QueryApp/lib/OpenSSL/Query/Role/Bureau.pm b/QueryApp/lib/OpenSSL/Query/Role/Bureau.pm
index a574556..f4771b5 100644
--- a/QueryApp/lib/OpenSSL/Query/Role/Bureau.pm
+++ b/QueryApp/lib/OpenSSL/Query/Role/Bureau.pm
@@ -8,9 +8,11 @@
# https://www.openssl.org/source/license.html
use strict;
+use warnings;
package OpenSSL::Query::Role::Bureau;
+use Carp;
use File::Spec::Functions;
use Moo::Role;
@@ -28,7 +30,7 @@ sub _find_file {
foreach (@paths) {
return $_ if -r $_;
}
- die "$filename not found in any of ", join(", ", @paths), "\n";
+ croak "$filename not found in any of ", join(", ", @paths), "\n";
}
1;
More information about the openssl-commits
mailing list