Group
Extension

Terse-Plugin-UA/lib/Terse/Plugin/UA.pm

package Terse::Plugin::UA;
use 5.006; use strict; use warnings;
our $VERSION = '0.03';
use base 'Terse::Plugin';
use LWP::UserAgent; use URI; use Scalar::Util qw/reftype/;

sub connect {
	my ($self, $t) = @_;
	my $connect = $self->SUPER::new();
	$connect->ua = LWP::UserAgent->new(ssl_opts => {verify_hostname => 0});
	$connect->ua->cookie_jar({});
	$connect->context = $t;
	return $connect;
}

sub post {
	my $self  = shift;
	$self->_request(
		method => 'post',
		'Content-Type' => 'application/json',
		Accept => 'application/json',
		@_
	);
}

sub get {
	my $self = shift;
	$self->_request(
		method => 'get',
		'Content-Type' => 'application/x-www-form-urlencoded;charset=utf-8',
		Accept => 'application/json',
		@_
	);
}

sub _request {
	my ($self, %args) = @_;
	$self->request_cb(\%args) if $self->can('request_cb');
	my $request_parameters = delete $args{params} // {};
	if ($self->context->{session} && $self->context->session->{user}) {
		$request_parameters->{userName} = $self->context->session->user->userName;
		$request_parameters->{hashedUserName} = $self->context->session->user->hashedUserName;
	}
	my $url = URI->new(delete $args{path});
	my $method = delete $args{method};
	my $view = $args{view} && $self->context->view(delete $args{view});
	if ($self->can('params_cb')) {
		$self->req_params = $request_parameters = $self->params_cb($request_parameters,\%args, $view);
	} elsif ($view) {
		$self->req_params = $request_parameters = $view->render($self->context, $request_parameters);
	} else {
		$self->req_params = $request_parameters;
		$request_parameters = $self->req_params->serialize();
	}
	my @args;
	if ($method =~ m/get/i) {
		$url->query_form(%{$self->req_params});
		@args = ( 
			$url,
			%args,
		);
	} else {
		@args = (
			$url,
			%args,
			Content => $request_parameters
		);
	}
	my $res = $self->ua->$method(@args);
	$res->{uri} = $url;
	$self->_parse_response($res, $view);
}

sub _parse_response {
	my ($self, $res, $view) = @_;
	unless ($res->is_success) {
		my $response = eval { $self->graft('response', $res->decoded_content) };
		return $self->_return_error($@ ? undef : $response, $res, $res->code());
	}
	if ($self->can('response_cb')) {
		return $self->response_cb($res);
	} elsif ($view && $view->can('parse')) {
		return $view->parse($self->context, $res);
	} elsif ($res->content_type eq 'application/json') {
		my $response = $self->graft('response', $res->decoded_content);
		return $self->_return_error('Invalid JSON content returned', $res) if !$response;
		return $response
	}
	return $self->_return_error('Invalid UA call', $res);
}

sub _return_error {
	my ($self, $error, $res, $status) = @_;
	$status ||= 500;
	if ($self->can('error_cb')) {
		return $self->error_cb($error, $res, $status);
	}
	$self->context->logError($error || 'PAYMENT API call failed', 500);
	return;
}

1;

__END__

=head1 NAME

Terse::Plugin::UA - Terse LWP::UserAgent plugin.

=head1 VERSION

Version 0.03

=cut

=head1 SYNOPSIS

Quick summary of what the module does.

Perhaps a little code snippet.

	package MyApp::Plugin::UA;

	use base 'Terse::Plugin::UA';

	1;

	...

	package MyApp::Model::Orange;

	use base 'Terse::Model';

	sub one {
		my ($self, $t, $params) = @_;

		return $t->plugin('ua')->post(
			path => $t->plugin('config')->find('path/to/url'),
			params => $params
		);
	}

	sub two {
		my ($self, $t, $params) = @_;

		return $t->plugin('ua')->get(
			path => $t->plugin('config')->find('path/to/other/url'),
			params => $params
		);
	}

	1;

	...

	package MyApp::Controller::Orange;
	
	use base 'Terse::Controller';

	sub demo {
		my ($self, $t) = @_;	

		my $secret_teller = $t->model('orange')->one({
			...
		});
	}

	1;


=head1 AUTHOR

LNATION, C<< <email at lnation.org> >>

=head1 BUGS

Please report any bugs or feature requests to C<bug-terse-plugin-ua at rt.cpan.org>, or through
the web interface at L<https://rt.cpan.org/NoAuth/ReportBug.html?Queue=Terse-Plugin-UA>.  I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.

=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc Terse::Plugin::UA

You can also look for information at:

=over 4

=item * RT: CPAN's request tracker (report bugs here)

L<https://rt.cpan.org/NoAuth/Bugs.html?Dist=Terse-Plugin-UA>

=item * CPAN Ratings

L<https://cpanratings.perl.org/d/Terse-Plugin-UA>

=item * Search CPAN

L<https://metacpan.org/release/Terse-Plugin-UA>

=back

=head1 ACKNOWLEDGEMENTS


=head1 LICENSE AND COPYRIGHT

This software is Copyright (c) 2023 by LNATION.

This is free software, licensed under:

  The Artistic License 2.0 (GPL Compatible)


=cut

1; # End of Terse::Plugin::UA


Powered by Groonga
Maintained by Kenichi Ishigaki <ishigaki@cpan.org>. If you find anything, submit it on GitHub.