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
|
package OAuth::Lite2::Agent::PSGIMock;
use strict;
use warnings;
use Params::Validate qw(CODEREF);
use HTTP::Response;
use HTTP::Message::PSGI;
use Try::Tiny qw/try catch/;
=head1 NAME
OAuth::Lite2::Agent::PSGIMock - Agent class for test which use PSGI App
=head2 SYNOPSIS
use Test::More;
my $endpoint = OAuth::Lite2::Server::Endpoint::Token->new(
data_handler => 'YourApp::DataHandler',
);
my $agent = OAuth::Lite2::Agent::PSGIMock->new( app => $endpoint );
my $client = OAuth::Lite2::Client::UsernameAndPassword->new(
client_id => q{foo},
client_secret => q{bar},
agent => $agent,
);
my $res = $client->get_access_token(
username => q{buz},
password => q{huga},
scope => q{email},
);
is($res->access_token, ...);
is($res->refresh_token, ...);
=head1 DESCRIPTION
This class is useful for test to check if your PSGI based
server application acts as expected.
=head1 METHODS
=head2 new (%args)
parameters
=over 4
=item app (PSGI application)
=back
=cut
sub new {
my $class = shift;
my %args = Params::Validate::validate(@_, {
app => 1,
});
my $self = bless {
app => $args{app},
}, $class;
return $self;
}
=head2 request ($req)
handle request with PSIG application you set at constructor
=cut
sub request {
my ($self, $req) = @_;
my $res = try {
HTTP::Response->from_psgi($self->{app}->($req->to_psgi));
} catch {
HTTP::Response->from_psgi([500, [ "Content-Type" => "text/plain" ], [ $_ ] ]);
};
return $res;
}
1;
=head1 SEE ALSO
L<OAuth::Lite2::Client::Agent>,
L<OAuth::Lite2::Client::Agent::Strict>
L<OAuth::Lite2::Client::Agent::Dump>
=head1 AUTHOR
Lyo Kato, C<lyo.kato _at_ gmail.com>
=head1 COPYRIGHT AND LICENSE
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.8 or,
at your option, any later version of Perl 5 you may have available.
=cut
|
