view release on metacpan or  search on metacpan

lib/JSON/RPC/LWP.pm  view on Meta::CPAN

  },
);
around 'agent', sub{
    my($orig,$self,$agent) = @_;
    $agent = $self->$orig() unless @_ > 2;

    unless( defined $agent ){
      $agent = $self->_agent;
    }
    if( length $agent ){
      if( substr($agent,-1) eq ' ' ){
        $agent .= $self->_agent;
      }
    }
    $self->ua->agent($agent) if $self->has_ua;
    $self->marshal->user_agent($agent) if $self->has_marshal;
    $self->$orig($agent);
};

has _agent => (
  is => 'ro',
  isa => 'Str',
  builder => '_build_agent',
  init_arg => undef,
);
sub _build_agent{
  my($self) = @_;
  my $class = blessed($self) || $self;

  no strict qw'vars refs';
  if( $class eq __PACKAGE__ ){
    return "JSON-RPC-LWP/$VERSION"
  }else{
    my $version = ${$class.'::VERSION'};
    if( $version ){
      return "$class/$version";
    }else{
      return $class;
    }
  }
}

my @ua_handles = qw{
  timeout
  proxy
  no_proxy
  env_proxy
  from
  credentials
};

has ua => (
  is => 'rw',
  isa => 'LWP::UserAgent',
  lazy => 1,
  predicate => 'has_ua',
  default => sub{
    my($self) = @_;
    my $lwp = LWP::UserAgent->new(
      env_proxy => 1,
      keep_alive => 1,
      parse_head => 0,
      agent => $self->agent,
    );
  },
  handles => \@ua_handles,
);

my @marshal_handles = qw{
  prefer_get
  rest_style_methods
  prefer_encoded_get
};

has marshal => (
  is => 'rw',
  isa => 'JSON::RPC::Common::Marshal::HTTP',
  lazy => 1,
  predicate => 'has_marshal',
  default => sub{
    my($self) = @_;
    JSON::RPC::Common::Marshal::HTTP->new(
      user_agent => $self->agent,
    );
  },
  handles => \@marshal_handles,
);

my %from = (
  map( { $_, 'ua' } @ua_handles ),
  map( { $_, 'marshal' } @marshal_handles ),
);

sub BUILD{
  my($self,$args) = @_;

  while( my($key,$value) = each %$args ){
    if( exists $from{$key} ){
      my $attr = $from{$key};
      $self->$attr->$key($value);
    }
  }
}

has version => (
  is => 'rw',
  isa => 'JSON.RPC.Version',
  default => '2.0',
  coerce => 1,
);

has previous_id => (
  is => 'ro',
  isa => JSONValue,
  init_arg => undef,
  writer => '_previous_id',
  predicate => 'has_previous_id',
  clearer => 'clear_previous_id',
);

has id_generator => (