summaryrefslogtreecommitdiff
path: root/lib/Net/HTTP/API/Role
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Net/HTTP/API/Role')
-rw-r--r--lib/Net/HTTP/API/Role/Authentication.pm67
-rw-r--r--lib/Net/HTTP/API/Role/Format.pm65
-rw-r--r--lib/Net/HTTP/API/Role/Request.pm79
-rw-r--r--lib/Net/HTTP/API/Role/Serialization.pm104
-rw-r--r--lib/Net/HTTP/API/Role/UserAgent.pm36
5 files changed, 351 insertions, 0 deletions
diff --git a/lib/Net/HTTP/API/Role/Authentication.pm b/lib/Net/HTTP/API/Role/Authentication.pm
new file mode 100644
index 0000000..27728c3
--- /dev/null
+++ b/lib/Net/HTTP/API/Role/Authentication.pm
@@ -0,0 +1,67 @@
+package Net::HTTP::API::Role::Authentication;
+
+# ABSTRACT: Add authentication informations to request header
+
+use Moose::Role;
+
+has api_username => (
+ is => 'rw',
+ isa => 'Str',
+ predicate => 'has_api_username',
+);
+
+has api_password => (
+ is => 'rw',
+ isa => 'Str',
+ predicate => 'has_api_password',
+);
+
+# ugly :(
+after BUILDALL => sub {
+ my $self = shift;
+
+ for (qw/api_username api_password/) {
+ my $predicate = 'has_' . $_;
+ my $value = $self->meta->get_api_option($_);
+ $self->$_($value) if $value && !$self->$predicate;
+ }
+
+ if ( $self->meta->get_api_option('authentication')
+ || $self->meta->get_api_option('authentication_method'))
+ {
+ my $auth_method = $self->meta->get_api_option('authentication_method');
+ if ($auth_method) {
+ $self->api_useragent->add_handler(
+ request_prepare => sub { $self->$auth_method(@_) });
+ }
+ else {
+ if ($self->has_api_username && $self->has_api_password) {
+ $self->api_useragent->add_handler(
+ request_prepare => sub {
+ my $req = shift;
+ $req->headers->authorization_basic($self->api_username,
+ $self->api_password);
+ }
+ );
+ }
+ }
+ }
+};
+
+1;
+
+=head1 SYNOPSIS
+
+=head1 DESCRIPTION
+
+=head2 ATTRIBUTES
+
+=over 4
+
+=item B<api_password>
+
+=item B<api_username>
+
+=back
+64: hit eof while in pod documentation (no =cut seen)
+ this can cause trouble with some pod utilities
diff --git a/lib/Net/HTTP/API/Role/Format.pm b/lib/Net/HTTP/API/Role/Format.pm
new file mode 100644
index 0000000..1d8c10f
--- /dev/null
+++ b/lib/Net/HTTP/API/Role/Format.pm
@@ -0,0 +1,65 @@
+package Net::HTTP::API::Role::Format;
+
+# ABSTRACT: Set appropriate format to request header
+
+use Moose::Role;
+use Moose::Util::TypeConstraints;
+
+sub content_type {
+ { json => {value => 'application/json', module => 'JSON',},
+ yaml => {value => 'text/x-yaml', module => 'YAML'},
+ xml => {value => 'text/xml', module => 'XML::Simple'},
+ };
+}
+
+subtype Format => as 'Str' => where {
+ my $format = shift;
+ grep {/^$format$/} keys %{content_type()};
+};
+
+enum 'FormatMode' => qw(content-type append);
+
+has api_format => (
+ is => 'rw',
+ isa => 'Format',
+ lazy => 1,
+ default => sub {
+ my $self = shift;
+ $self->meta->get_api_option('api_format');
+ }
+);
+
+has api_format_mode => (
+ is => 'rw',
+ isa => 'FormatMode',
+ lazy => 1,
+ default => sub {
+ my $self = shift;
+ my $mode = $self->meta->get_api_option('api_format_mode') || 'append';
+ $mode;
+ }
+);
+
+1;
+
+=head1 SYNOPSIS
+
+=head1 DESCRIPTION
+
+=head2 METHODS
+
+=over 4
+
+=item B<content_type>
+
+=back
+
+=head2 ATTRIBUTES
+
+=over 4
+
+=item B<api_format>
+
+=item B<api_format_mode>
+
+=back
diff --git a/lib/Net/HTTP/API/Role/Request.pm b/lib/Net/HTTP/API/Role/Request.pm
new file mode 100644
index 0000000..c972b77
--- /dev/null
+++ b/lib/Net/HTTP/API/Role/Request.pm
@@ -0,0 +1,79 @@
+package Net::HTTP::API::Role::Request;
+
+# ABSTRACT: make HTTP request
+
+use Moose::Role;
+use HTTP::Request;
+use Net::HTTP::API::Error;
+use MooseX::Types::URI qw(Uri);
+
+has api_base_url => (
+ is => 'rw',
+ isa => Uri,
+ coerce => 1,
+ lazy => 1,
+ default => sub {
+ my $self = shift;
+ my $api_base_url = $self->meta->get_api_option('api_base_url');
+ if (!$api_base_url) {
+ die Net::HTTP::API::Error->new(
+ reason => "'api_base_url' have not been defined");
+ }
+ $api_base_url;
+ }
+);
+
+sub http_request {
+ my ($self, $method, $uri, $params_in_url, $args) = @_;
+
+ my $request;
+
+ if ($method =~ /^(?:GET|DELETE)$/) {
+ $uri->query_form(%$args);
+ $request = HTTP::Request->new($method => $uri);
+ }
+ elsif ($method =~ /^(?:POST|PUT)$/) {
+ my $params = {};
+ foreach my $key (@$params_in_url) {
+ $params->{$key} = $args->{$key} if exists $args->{$key};
+ }
+ $uri->query_form(%$params) if $params;
+
+ $request = HTTP::Request->new($method => $uri);
+ my $content = $self->serialize($args);
+ $request->content($content);
+ }
+ else {
+ die Net::HTTP::API::Error->new(reason => "$method is not defined");
+ }
+
+ $request->header(
+ 'Content-Type' => $self->content_type->{$self->api_format}->{value})
+ if $self->api_format_mode eq 'content-type';
+
+ # XXX lwp hook!
+ my $result = $self->api_useragent->request($request);
+ return $result;
+}
+
+1;
+
+=head1 SYNOPSIS
+
+=head1 DESCRIPTION
+
+=head2 METHODS
+
+=over 4
+
+=item B<http_request>
+
+=back
+
+=head2 ATTRIBUTES
+
+=over 4
+
+=item B<api_base_url>
+
+=back
diff --git a/lib/Net/HTTP/API/Role/Serialization.pm b/lib/Net/HTTP/API/Role/Serialization.pm
new file mode 100644
index 0000000..37d2603
--- /dev/null
+++ b/lib/Net/HTTP/API/Role/Serialization.pm
@@ -0,0 +1,104 @@
+package Net::HTTP::API::Role::Serialization;
+
+# ABSTRACT: do (de)serialization
+
+use 5.010;
+
+use Try::Tiny;
+use Moose::Role;
+use Net::HTTP::API::Error;
+
+has serializers => (
+ traits => ['Hash'],
+ is => 'rw',
+ isa => 'HashRef[Net::HTTP::API::Parser]',
+ default => sub { {} },
+ auto_deref => 1,
+ handles => {
+ _add_serializer => 'set',
+ _get_serializer => 'get',
+ },
+);
+
+sub get_content {
+ my ($self, $result) = @_;
+
+ return undef unless $result->content;
+
+ my $content_type = $self->api_format // $result->header('Content-Type');
+ $content_type =~ s/(;.+)$//;
+
+ my $content;
+ if ($result->is_success && $result->code != 204) {
+ my @deserialize_order = ($content_type, $self->api_format);
+ $content = $self->deserialize($result->content, \@deserialize_order);
+
+ if (!$content) {
+ die Net::HTTP::API::Error->new(
+ reason => "can't deserialize content",
+ http_error => $result,
+ );
+ }
+ }
+ $content;
+}
+
+sub deserialize {
+ my ($self, $content, $list_of_formats) = @_;
+
+ foreach my $format (@$list_of_formats) {
+ my $s = $self->_get_serializer($format)
+ || $self->_load_serializer($format);
+ next unless $s;
+ my $result;
+ try { $result = $s->decode($content) };
+ return $result if $result;
+ }
+}
+
+sub serialize {
+ my ($self, $content) = @_;
+ my $s = $self->_get_serializer($self->api_format)
+ || $self->_load_serializer();
+ my $result = try { $s->encode($content) };
+ return $result if $result;
+}
+
+sub _load_serializer {
+ my $self = shift;
+ my $format = shift || $self->api_format;
+ my $parser = "Net::HTTP::API::Parser::" . uc($format);
+ if (Class::MOP::load_class($parser)) {
+ my $o = $parser->new;
+ $self->_add_serializer($format => $o);
+ return $o;
+ }
+}
+
+1;
+
+=head1 SYNOPSIS
+
+=head1 DESCRIPTION
+
+=head2 ATTRIBUTES
+
+=over 4
+
+=item B<serializers>
+
+=back
+
+=head2 METHODS
+
+=over 4
+
+=item B<get_content>
+
+=item B<serialize>
+
+=item B<deserialize>
+
+=back
+99: hit eof while in pod documentation (no =cut seen)
+ this can cause trouble with some pod utilities
diff --git a/lib/Net/HTTP/API/Role/UserAgent.pm b/lib/Net/HTTP/API/Role/UserAgent.pm
new file mode 100644
index 0000000..84f618d
--- /dev/null
+++ b/lib/Net/HTTP/API/Role/UserAgent.pm
@@ -0,0 +1,36 @@
+package Net::HTTP::API::Role::UserAgent;
+
+# ABSTRACT: create UserAgent
+
+use Moose::Role;
+use LWP::UserAgent;
+
+has api_useragent => (
+ is => 'rw',
+ isa => 'LWP::UserAgent',
+ lazy => 1,
+ default => sub {
+ my $self = shift;
+ my $ua = $self->meta->get_api_option('useragent');
+ return $ua->() if $ua;
+ $ua = LWP::UserAgent->new();
+ $ua->agent(
+ "Net::HTTP::API " . $Net::HTTP::API::VERSION . " (Perl)");
+ $ua->env_proxy;
+ return $ua;
+ }
+);
+
+1;
+
+=head1 SYNOPSIS
+
+=head1 DESCRIPTION
+
+=head2 ATTRIBUTES
+
+=over 4
+
+=item B<api_useragent>
+
+=back
generated by cgit v1.2.3 (git 2.25.1) at 2025-12-06 22:37:28 +0000