use strict;
use warnings;

package MooseX::Role::REST::Consumer;

use MooseX::Role::Parameterized;
use MooseX::Role::REST::Consumer::Response;
use File::Spec;
use REST::Consumer;
use Try::Tiny;
use URI::Escape;
use Module::Load;

our $VERSION = '0.001';

my @HTTP_METHODS = qw(get put post delete);

parameter service_host => (
 lazy    => 1,
 default => '',
);

parameter service_port => ();

parameter resource_path => (
 lazy    => 1,
 default => sub { undef },
);

parameter content_type => (
 isa      => 'Str',
 required => 1,
 default  => 'application/json',
);

parameter header_exclude => (
 isa     => 'HashRef',
 default => sub {{}},
);

parameter retry   => (
 required => 1,
 default  => 0,
);

parameter timeout => (
 default => 1,
);

parameter query_params_mapping => (
 isa     => 'HashRef',
 default => sub {{}},
);

parameter useragent_class => (
 isa => 'Str',
);

role {
 my $p = shift;

 my $service_host         = $p->service_host;
 my $service_port         = $p->service_port;
 my $resource_path        = $p->resource_path;
 my $content_type         = $p->content_type;
 my $retry                = $p->retry;
 my $timeout              = $p->timeout;
 my $query_params_mapping = $p->query_params_mapping;
 my $useragent_class      = $p->useragent_class;

 #Note: since this is a parametrized role then only one class will be closing
 #over this variable and this instance only depends on role parameters
 my $consumer_instance;

 #Note: $class varible in methods of this role can be an instance and a class name
 #For GET requests this is usually a class name, for POST requests
 #this would usually be an instance.
 #Be carefull!

 method 'consumer' => sub {
   my ($class) = @_;
   return $consumer_instance if($consumer_instance);

   my $user_agent;

   if($useragent_class) {
     Module::Load::load($useragent_class);
     $user_agent = $useragent_class->new;
   };

   my $client = REST::Consumer->new(
     host    => $service_host,
     timeout => $timeout,
     ($user_agent ? (ua => $user_agent) : ()),
     ($service_port ? (port => $service_port) : ())
   );

   $client->user_agent->use_eval(0);

   $consumer_instance = $client;
   return $client;
 };

 method 'call' => sub {
   my ($class, $method, %params) = @_;

   my %request_headers = $class->request_headers(
     header_exclude => $p->header_exclude,
     headers        => $params{headers},
     content_type   => $p->content_type,
     method         => $method,
   );

   $content_type = delete $request_headers{'Content-Type'};
   if ($params{access_token}) {
     $request_headers{Authorization} = 'Bearer ' . $params{access_token};
   }

   my %query_params = $class->query_params(
     params               => $params{params},
     query_params_mapping => $query_params_mapping,
   );

   my $path = $class->request_path(
     resource_path => $resource_path,
     route_params  => delete $params{route_params},
     path          => delete $params{path},
   );

   my ($data, $error, $timeout_error) = (undef, '', 0);

   my %request = (
     params       => \%query_params,
     content      => $params{content},
     path         => $path,
     content_type => $content_type,
     headers      => ( %request_headers ? [ %request_headers ] : undef ),
   );

   #my $logger = $class->get_logger
   #$logger->start_request(
   #  type      => $method,
   #  path      => $path,
   #  response  => $data,
   #  request   => \%request
   #);

   my $consumer = $class->consumer; #we want same instance throughout the whole process
   $consumer->host(delete $params{host}) if $params{host};

   if (my $timeout_override = delete $params{timeout} ) {
     $consumer->timeout($timeout_override);
   }

   my $try = 0;
   while ($try <= $retry) {
     my $is_success;
     try {
       $try++;
       $data          = $consumer->$method(%request);
       $is_success    = 1;
     } catch {
       $error = $_;
       $timeout_error++ if $error =~ /read timeout/;
     };
     last if $is_success;
  }

   $consumer->timeout($timeout);
   $consumer->host($service_host);

   #$logger->finish($log_entry, {
   #  type      => $method,
   #  path      => $path,
   #  response  => $data,
   #  request   => \%request
   #});

   # TODO: It's confusing as to how we handle errors.
   # ie: message should be called "error_message" and
   # we should inspect the response content for possible error messages
   return MooseX::Role::REST::Consumer::Response->new(
     data          => $data,
     is_success    => !$error,
     error_message => "$error",
     request       => $consumer->last_request,
     content_type  => $content_type,
     response      => $consumer->last_response,
   );
 };

 # Note: REST::Consumer doesn't support OPTIONS/PATCH
 for my $method ( @HTTP_METHODS ) {
     method $method => sub {
       my $class = shift;
       $class->call($method, @_);
     }
 }

 method 'request_headers' => sub {
     my ($class, %params) = @_;
     my %request_headers = ($params{headers} ? %{delete $params{headers}} : ());
     # Strange mutation going on here:
     # 1. First we set the content_type in the headers if we have one set in parameter definition
     # 2. However, we won't override anything that is passed explicitly into a method call Class->post
     # 3. Next we delete anything that needs to be removed from the header
     # 4. Finally we explicltly pull out content-type from the request_headers
     #    to make REST::Consumer happy
     $request_headers{'Content-Type'} = $params{content_type} unless $request_headers{'Content-Type'};
     delete @request_headers{@{$params{header_exclude}->{$params{method}}}} if $params{header_exclude}->{$params{method}};
     return %request_headers;
 };
 method 'request_path' => sub {
   my ($class, %params) = @_;

   my $resource_path = $params{resource_path};
   my $route_params  = $params{route_params};
   my $params_path   = $params{path};
   my @path          = (defined $resource_path ? $resource_path : ());

   if($params_path) {
     if(ref($params_path) eq 'ARRAY') {
       push(@path, @$params_path);
     } else {
       push(@path, $params_path);
     }
   }
   my $path = File::Spec->catfile(@path) . ( $resource_path && $resource_path =~ m{[^/]+/$} ? '/' : '');
   #We support two ways of substituting params here:
   # /:param/ - name has to have '/' or end of string after it
   # /has_:{param}_value - surround param name with '{}'
   #Note: we go through complete incremental parsing/fetching url params to avoid
   #params substituted values being mached against other params names
   #We also verify that all parameters have been substituted
   my $result = '';
   while($path =~ /\G(.*?)(:(?:\{([^}]+?)\}|(\w+)(?=\W|$)))/gc) {
     $result .= $1;
     if($2) {
       my $name = $3 || $4; # only one of them could match
       if(exists $route_params->{$name}) {
         $result .= URI::Escape::uri_escape_utf8($route_params->{$name} // '');
       }
       else {
         die "Found parameter $name in path but it wasn't set in parameters hash";
       }
     }
   }
   if($path =~ /\G(.+)$/g) {
     $result .= $1;
   }
   return $result;
 };

 method 'query_params' => sub {
   my ($class, %params) = @_;

   my %query_params;
   if($params{params}) {
     # TODO: I don't think having this strict mapping in place
     # makes a lot of sense. Ideally we should be able to pass in
     # any query params that we want
     if ( $params{query_params_mapping} ) {
       while(my ($name, $url_name) = each(%{$params{query_params_mapping}})) {
         # Check for method canness here probably
         $query_params{$url_name} = delete($params{params}->{$name});
       }
     } else {
       %query_params = %{$params{params}};
     }
   }
   return %query_params;
 };

 method 'parameters' => sub { $p };

};

__END__

=pod

=head1 NAME

MooseX::Role::REST::Consumer

=head1 VERSION

version 0.001

=head1 SYNOPSIS

 package Foo;
 use Moose;
 with 'MooseX::Role::REST::Consumer' => {
   service_host => 'somewhere.over.the.rainbow',
   resource_path => '/path/to/my/resource/:id',
 };

 my $object = Foo->get(route_params => {id => 1});

 if ($object->is_success) {
  print $object->data->{something_that_came_back};
 }

=head2 DESCRIPTION

 At Shutterstock we love REST and we take it so seriously that we think
 our code should be RESTfully lazy. Now one can have a Moose model
 without needing to deal with all the marshalling details.

=head3 Schema Definitions/Configuration

 When setting up a class the following are the supported
 parameters that L<MooseX::Role::REST::Consumer> will support.

 For example a typical configuration would looke like the following:

 with 'MooseX::Role::REST::Consumer' => {
   service_host  => 'host.name',
   resource_path => '/path/to/my/resource/:id'
   timeout       => 10,
 };

=over

=item content_type

 By default the content type is set to "application/json"

=item header_exclude

 Acts as a filter, will exclude any header information.

 header_exclude => {
   post => 'X-Foo',
 }

=item resource_path

 This is the path of the resource. IE:

 /foo/bar/:id

 The :id is a route parameter which will be filled in as specified by the
 "route_params" hashref.

=item retry

 This is an explicit retry. Even if the service times out, it will retry
 using this value. This retry is different than what L<REST::Consumer> offers.

=item service_host

 The hostname to the service

=item service_port

 The port for the hostname.

=item timeout

 Configuration level timeout. This is global on each request.

=item useragent_class

 Experimental way of overriding L<REST::Consumer>'s useragent. Right now
 MooseX::REST::Consumer uses L<LWP::UserAgent>

=back

=head3 METHODS

=over

=item get( route_params => {...}, params => {...} )

Will use REST::Consumer::get to lookup a resource by
supplied resource_path and substitution of route_params

=item post( route_params => {...}, content => '...' )

Will perform a POST request with REST::Consumer::post.
The data will the Content-Type of application/json by default.

=item Other supported HTTP methods

 DELETE and PUT: delete(%params) and put(%params)

=back

=head3 Supported Method Parameters

=over

=item route_params => {...}

These will be substituted into the package route definition.

=item params => {...}

Passed into L<REST::Consumer> as a set of key/value
query parameters.

=item headers => {...}

 Any extra HTTP request headers to send.

=item content => ''

 Passed into L<REST::Consumer>. This is the body content of a request.

=item timeout => ''

 Timeout override per request.

 Note that the 'timeout' is subject to interpretation
 by your underlying UserAgent class.  For example,
 LWP::UserAgent treats the timeout as being
 C<per-request>. This means that if you specify a timeout
 of 5 seconds and issue a request using LWP::UserAgent,
 each request that the UserAgent makes to fulfill your
 request will have its own timeout of 5 seconds.

 This becomes important if the API that you are talking to
 starts giving you 3xx redirects: while you might expect a
 timeout to occur within 5 seconds, the API might instruct
 your UserAgent to make a few subsequent requests, and each
 one will have your initial timeout applied to it.

 Different UserAgent classes implement timeouts
 differently. L<LWP::UserAgent::Paranoid>, for example,
 has a global timeout value, where all requests must be
 fulfilled within C<timeout> clock seconds.

=back

=head3 Response Object

=over

 The response object is created and passed back whenever
 any of the supported HTTP methods are called.
 See L<MooseX::Role::REST::Consumer::Response>.

=back

=head2

=head1 SEE ALSO

L<REST::Consumer>, L<MooseX::Role::Parameterized>, L<Moose>

=head2 AUTHORS

 The Shutterstock Webstack Team and alumni (Logan Bell,
 Jon Hogue, Vishal Kajjam, Belden Lyman, Nikolay Martynov, and
 Kurt Starsinic).

=head2  COPYRIGHT AND LICENSE

This software is copyright (c) 2014 by Shutterstock Inc.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut

You are viewing proxied material from ftp.icm.edu.pl. The copyright of proxied material belongs to its original authors. Any comments or complaints in relation to proxied material should be directed to the original authors of the content concerned. Please see the disclaimer for more details.