File: Mojo.pm

package info (click to toggle)
libwww-oauth-perl 1.003-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid
  • size: 228 kB
  • sloc: perl: 480; makefile: 2
file content (206 lines) | stat: -rw-r--r-- 4,922 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
package WWW::OAuth::Request::Mojo;

use strict;
use warnings;
use Class::Tiny::Chained 'request';

use Carp 'croak';
use Scalar::Util 'blessed';

use Role::Tiny::With;
with 'WWW::OAuth::Request';

our $VERSION = '1.003';

sub method {
	my $self = shift;
	return $self->request->method unless @_;
	$self->request->method(shift);
	return $self;
}

sub url {
	my $self = shift;
	return $self->request->url->to_string unless @_;
	require Mojo::URL;
	$self->request->url(Mojo::URL->new(shift));
	return $self;
}

sub content {
	my $self = shift;
	return $self->request->body unless @_;
	$self->request->body(shift);
	return $self;
}

sub content_is_form {
	my $self = shift;
	return 0 if $self->request->content->is_multipart;
	my $content_type = $self->request->headers->content_type;
	return 0 unless defined $content_type and $content_type =~ m!application/x-www-form-urlencoded!i;
	return 1;
}

sub query_pairs { shift->request->query_params->pairs }

sub body_pairs { require Mojo::Parameters; Mojo::Parameters->new(shift->request->body)->pairs }

sub header {
	my $self = shift;
	my $name = shift;
	croak 'No header to set/retrieve' unless defined $name;
	return $self->request->headers->header($name) unless @_;
	my @values = ref $_[0] eq 'ARRAY' ? @{$_[0]} : $_[0];
	$self->request->headers->header($name => @values);
	return $self;
}

sub request_with {
	my ($self, $ua, $cb) = @_;
	croak 'Unknown user-agent object' unless blessed $ua and $ua->isa('Mojo::UserAgent');
	return $ua->start($self->_build_tx($ua), $cb);
}

sub request_with_p {
	my ($self, $ua) = @_;
	croak 'Unknown user-agent object' unless blessed $ua and $ua->isa('Mojo::UserAgent');
	my $has_promises = do { local $@; eval { require Mojolicious; Mojolicious->VERSION('7.54'); 1 } };
	croak 'Mojolicious 7.54 required for request_with_p' unless $has_promises;
	return $ua->start_p($self->_build_tx($ua));
}

sub _build_tx {
	my ($self, $ua) = @_;
	return $ua->build_tx($self->method, $self->url, $self->request->headers->to_hash, $self->content);
}

1;

=head1 NAME

WWW::OAuth::Request::Mojo - HTTP Request container for Mojo::Message::Request

=head1 SYNOPSIS

 my $req = WWW::OAuth::Request::Mojo->new(request => $mojo_request);
 my $ua = Mojo::UserAgent->new;
 my $tx = $req->request_with($ua);
 $req->request_with_p($ua)->then(sub {
   my $tx = shift;
 });

=head1 DESCRIPTION

L<WWW::OAuth::Request::Mojo> is a request container for L<WWW::OAuth> that
wraps a L<Mojo::Message::Request> object, which is used by L<Mojo::UserAgent>.
It performs the role L<WWW::OAuth::Request>.

=head1 ATTRIBUTES

L<WWW::OAuth::Request::Mojo> implements the following attributes.

=head2 request

 my $mojo_request = $req->request;
 $req             = $req->request($mojo_request);

L<Mojo::Message::Request> object to authenticate.

=head1 METHODS

L<WWW::OAuth::Request::Mojo> composes all methods from L<WWW::OAuth::Request>,
and implements the following new ones.

=head2 body_pairs

 my $pairs = $req->body_pairs;

Return body parameters from L</"request"> as an even-sized arrayref of keys and
values.

=head2 content

 my $content = $req->content;
 $req        = $req->content('foo=1&bar=2');

Set or return request content from L</"request">.

=head2 content_is_form

 my $bool = $req->content_is_form;

Check whether L</"request"> has single-part content and a C<Content-Type>
header of C<application/x-www-form-urlencoded>.

=head2 header

 my $header = $req->header('Content-Type');
 $req       = $req->header(Authorization => 'foo bar');

Set or return a request header from L</"request">.

=head2 method

 my $method = $req->method;
 $req       = $req->method('GET');

Set or return request method from L</"request">.

=head2 query_pairs

 my $pairs = $req->query_pairs;

Return query parameters from L</"request"> as an even-sized arrayref of keys
and values.

=head2 request_with

 my $tx = $req->request_with($ua);
 $req->request_with($ua, sub {
   my ($ua, $tx) = @_;
   ...
 });

Run request with passed L<Mojo::UserAgent> user-agent object, and return
L<Mojo::Transaction> object, as in L<Mojo::UserAgent/"start">. A callback can
be passed to perform the request non-blocking.

=head2 request_with_p

 my $p = $req->request_with_p($ua)->then(sub {
   my $tx = shift;
   ...
 });

Run non-blocking request with passed L<Mojo::UserAgent> user-agent object, and
return a L<Mojo::Promise> which will be resolved with the successful
transaction or rejected on a connection error, as in
L<Mojo::UserAgent/"start_p">.

=head2 url

 my $url = $req->url;
 $req    = $req->url('http://example.com/api/');

Set or return request URL from L</"request">.

=head1 BUGS

Report any issues on the public bugtracker.

=head1 AUTHOR

Dan Book <dbook@cpan.org>

=head1 COPYRIGHT AND LICENSE

This software is Copyright (c) 2015 by Dan Book.

This is free software, licensed under:

  The Artistic License 2.0 (GPL Compatible)

=head1 SEE ALSO

L<Mojo::UserAgent>