File Coverage

blib/lib/OAuth/Lite2/ParamMethod/URIQueryParameter.pm
Criterion Covered Total %
statement 61 62 98.3
branch 11 12 91.6
condition 8 13 61.5
subroutine 12 12 100.0
pod 4 4 100.0
total 96 103 93.2


line stmt bran cond sub pod time code
1             package OAuth::Lite2::ParamMethod::URIQueryParameter;
2              
3 3     3   18 use strict;
  3         5  
  3         95  
4 3     3   14 use warnings;
  3         8  
  3         69  
5              
6 3     3   14 use parent 'OAuth::Lite2::ParamMethod';
  3         5  
  3         59  
7 3     3   137 use HTTP::Request;
  3         5  
  3         66  
8 3     3   22 use HTTP::Headers;
  3         4  
  3         58  
9 3     3   14 use bytes ();
  3         4  
  3         49  
10 3     3   14 use Params::Validate;
  3         6  
  3         159  
11 3     3   14 use OAuth::Lite2::Util qw(build_content);
  3         3  
  3         1638  
12              
13             =head1 NAME
14              
15             OAuth::Lite2::ParamMethod::URIQueryParameter - builder/parser for OAuth 2.0 uri-query type of parameter
16              
17             =head1 SYNOPSIS
18              
19             my $meth = OAuth::Lite2::ParamMethod::URIQueryParameter->new;
20              
21             # server side
22             if ($meth->match( $plack_request )) {
23             my ($token, $params) = $meth->parse( $plack_request );
24             }
25              
26             # client side
27             my $http_req = $meth->request_builder(...);
28              
29             =head1 DESCRIPTION
30              
31             builder/parser for OAuth 2.0 uri-query type of parameter
32              
33             =head1 METHODS
34              
35             =head2 new
36              
37             Constructor
38              
39             =head2 match( $plack_request )
40              
41             Returns true if passed L object is matched for the type of this method.
42              
43             if ( $meth->match( $plack_request ) ) {
44             ...
45             }
46              
47             =cut
48              
49             sub match {
50 12     12 1 23 my ($self, $req) = @_;
51 12   66     54 return (exists $req->query_parameters->{oauth_token}
52             || exists $req->query_parameters->{access_token});
53             }
54              
55             =head2 parse( $plack_request )
56              
57             Parse the L, and returns access token and oauth parameters.
58              
59             my ($token, $params) = $meth->parse( $plack_request );
60              
61             =cut
62              
63             sub parse {
64 12     12 1 563 my ($self, $req) = @_;
65 12         34 my $params = $req->query_parameters;
66 12         100 my $token = $params->{access_token};
67 12         40 $params->remove('access_token');
68 12 100       300 if($params->{oauth_token}){
69 6         14 $token = $params->{oauth_token};
70 6         19 $params->remove('oauth_token');
71             }
72 12         204 return ($token, $params);
73             }
74              
75             =head2 build_request( %params )
76              
77             Build L object.
78              
79             my $req = $meth->build_request(
80             url => $url,
81             method => $http_method,
82             token => $access_token,
83             oauth_params => $oauth_params,
84             params => $params,
85             content => $content,
86             headers => $headers,
87             );
88              
89             =cut
90              
91             sub build_request {
92 7     7 1 9966 my $self = shift;
93 7         273 my %args = Params::Validate::validate(@_, {
94             url => 1,
95             method => 1,
96             token => 1,
97             oauth_params => 1,
98             params => { optional => 1 },
99             content => { optional => 1 },
100             headers => { optional => 1 },
101             });
102              
103 7   50     74 my $oauth_params = $args{oauth_params} || {};
104 7         18 $oauth_params->{access_token} = $args{token};
105              
106 7   100     26 my $params = $args{params} || {};
107 7         16 my $method = uc $args{method};
108 7         12 my $headers = $args{headers};
109 7 100       17 if (defined $headers) {
110 1 50       6 if (ref($headers) eq 'ARRAY') {
111 1         7 $headers = HTTP::Headers->new(@$headers);
112             } else {
113 0         0 $headers = $headers->clone;
114             }
115             } else {
116 6         27 $headers = HTTP::Headers->new;
117             }
118              
119 7 100 66     115 if ($method eq 'GET' || $method eq 'DELETE') {
120 4         31 my $query = build_content({%$params, %$oauth_params});
121 4         25 my $url = sprintf q{%s?%s}, $args{url}, $query;
122 4         25 my $req = HTTP::Request->new($method, $url, $headers);
123 4         807 return $req;
124             } else {
125 3         12 my $query = build_content($oauth_params);
126 3         10 my $url = sprintf q{%s?%s}, $args{url}, $query;
127 3 100       12 unless ($headers->header("Content-Type")) {
128 2         59 $headers->header("Content-Type",
129             "application/x-www-form-urlencoded");
130             }
131 3         95 my $content_type = $headers->header("Content-Type");
132 3 100 33     113 my $content = ($content_type eq "application/x-www-form-urlencoded")
133             ? build_content($params)
134             : $args{content} || build_content($params);
135 3         14 $headers->header("Content-Length", bytes::length($content));
136 3         117 my $req = HTTP::Request->new($method, $url, $headers, $content);
137 3         508 return $req;
138             }
139             }
140              
141             =head2 is_legacy( $plack_request )
142              
143             Returns true if passed L object is based draft version 10.
144              
145             if ( $meth->is_legacy( $plack_request ) ) {
146             ...
147             }
148              
149             =cut
150              
151             sub is_legacy {
152 12     12 1 868 my ($self, $req) = @_;
153 12         41 return (exists $req->query_parameters->{oauth_token});
154             }
155              
156             =head1 SEE ALSO
157              
158             L
159             L
160             L
161             L
162              
163             =head1 AUTHOR
164              
165             Lyo Kato, Elyo.kato@gmail.comE
166              
167             =head1 COPYRIGHT AND LICENSE
168              
169             Copyright (C) 2010 by Lyo Kato
170              
171             This library is free software; you can redistribute it and/or modify
172             it under the same terms as Perl itself, either Perl version 5.8.8 or,
173             at your option, any later version of Perl 5 you may have available.
174              
175             =cut
176              
177             1;