move ua handling to a role for reuse

metacpan · Mar 24, 2017 · 9db93cc · 9db93cc
1 parent 1a4c31a
commit 9db93cc
Show file tree

Hide file tree

Showing 2 changed files with 90 additions and 76 deletions.
diff --git a/lib/MetaCPAN/Client/Request.pm b/lib/MetaCPAN/Client/Request.pm
@@ -6,12 +6,13 @@ package MetaCPAN::Client::Request;
 use Moo;
 use Carp;
 use JSON::MaybeXS qw<decode_json encode_json>;
-use HTTP::Tiny;
 use Ref::Util qw< is_arrayref is_hashref is_ref >;
 
 use MetaCPAN::Client::Scroll;
 use MetaCPAN::Client::Types qw< HashRef Int >;
 
+with 'MetaCPAN::Client::Role::HasUA';
+
 has _clientinfo => (
     is      => 'ro',
     isa     => HashRef,
@@ -36,26 +37,6 @@ has base_url => (
     },
 );
 
-has _user_ua => (
-    init_arg  => 'ua',
-    is        => 'ro',
-    predicate => '_has_user_ua',
-);
-
-has ua => (
-    init_arg => undef,
-    is       => 'ro',
-    lazy     => 1,
-    builder  => '_build_ua',
-);
-
-has ua_args => (
-    is      => 'ro',
-    default => sub {
-        [ agent => 'MetaCPAN::Client/'.($MetaCPAN::Client::VERSION||'xx') ]
-    },
-);
-
 has _is_agg => (
     is      => 'ro',
     default => 0,
@@ -74,24 +55,6 @@ sub BUILDARGS {
     return \%args;
 }
 
-sub _build_ua {
-    my $self = shift;
-
-    # This level of indirection is so that if a user has not specified a custom UA
-    # MetaCPAN::Client will have its own UA's
-    #
-    # But if the user **has** specified a custom UA, that UA is used for both.
-    if ( $self->_has_user_ua ) {
-        my $ua = $self->_user_ua;
-        croak "cannot use given ua (must support 'get' and 'post' methods)"
-            unless $ua->can("get") and $ua->can("post");
-
-        return $self->_user_ua;
-    }
-
-    return HTTP::Tiny->new( @{ $self->ua_args } );
-}
-
 sub _build_clientinfo {
     my $self = shift;
 
@@ -314,43 +277,6 @@ The C<base_url> will be set appropriately automatically.
 
 Default: I<https://$domain>.
 
-=head2 ua
-
-    my $mcpan = MetaCPAN::Client->new( ua => HTTP::Tiny->new(...) );
-
-The user agent object for running requests.
-
-It must provide an interface that matches L<HTTP::Tiny>. Explicitly:
-
-=over 4
-
-=item * Implement post()
-
-Method C<post> must be available that accepts a request URL and a hashref of
-options.
-
-=item * Implement get()
-
-Method C<get> must be available that accepts a request URL.
-
-=item * Return result hashref
-
-Must return a result hashref which has key C<success> and key C<content>.
-
-=back
-
-Default: L<HTTP::Tiny>,
-
-=head2 ua_args
-
-    my $mcpan = MetaCPAN::Client->new(
-        ua_args => [ agent => 'MyAgent' ],
-    );
-
-Arguments sent to the user agent.
-
-Default: user agent string: B<MetaCPAN::Client/$version>.
-
 =head2 debug
 
 debug-mode for more detailed error messages.

diff --git a/lib/MetaCPAN/Client/Role/HasUA.pm b/lib/MetaCPAN/Client/Role/HasUA.pm
@@ -0,0 +1,88 @@
+use strict;
+use warnings;
+package MetaCPAN::Client::Role::HasUA;
+# ABSTRACT: Role for supporting user-agent attribute
+
+use Moo::Role;
+use Carp;
+use HTTP::Tiny;
+
+has _user_ua => (
+    init_arg  => 'ua',
+    is        => 'ro',
+    predicate => '_has_user_ua',
+);
+
+has ua => (
+    init_arg => undef,
+    is       => 'ro',
+    lazy     => 1,
+    builder  => '_build_ua',
+);
+
+has ua_args => (
+    is      => 'ro',
+    default => sub {
+        [ agent => 'MetaCPAN::Client/'.($MetaCPAN::Client::VERSION||'xx') ]
+    },
+);
+
+sub _build_ua {
+    my $self = shift;
+
+    # This level of indirection is so that if a user has not specified a custom UA
+    # MetaCPAN::Client will have its own UA's
+    #
+    # But if the user **has** specified a custom UA, that UA is used for both.
+    if ( $self->_has_user_ua ) {
+        my $ua = $self->_user_ua;
+        croak "cannot use given ua (must support 'get' and 'post' methods)"
+            unless $ua->can("get") and $ua->can("post");
+
+        return $self->_user_ua;
+    }
+
+    return HTTP::Tiny->new( @{ $self->ua_args } );
+}
+
+1;
+__END__
+
+=head1 ATTRIBUTES
+
+=head2 ua
+
+    my $mcpan = MetaCPAN::Client->new( ua => HTTP::Tiny->new(...) );
+
+The user agent object for running requests.
+
+It must provide an interface that matches L<HTTP::Tiny>. Explicitly:
+
+=over 4
+
+=item * Implement post()
+
+Method C<post> must be available that accepts a request URL and a hashref of
+options.
+
+=item * Implement get()
+
+Method C<get> must be available that accepts a request URL.
+
+=item * Return result hashref
+
+Must return a result hashref which has key C<success> and key C<content>.
+
+=back
+
+Default: L<HTTP::Tiny>,
+
+=head2 ua_args
+
+    my $mcpan = MetaCPAN::Client->new(
+        ua_args => [ agent => 'MyAgent' ],
+    );
+
+Arguments sent to the user agent.
+
+Default: user agent string: B<MetaCPAN::Client/$version>.