line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package WWW::OAuth::Util; |
2
|
|
|
|
|
|
|
|
3
|
5
|
|
|
5
|
|
106391
|
use strict; |
|
5
|
|
|
|
|
12
|
|
|
5
|
|
|
|
|
179
|
|
4
|
5
|
|
|
5
|
|
26
|
use warnings; |
|
5
|
|
|
|
|
7
|
|
|
5
|
|
|
|
|
156
|
|
5
|
5
|
|
|
5
|
|
21
|
use Carp 'croak'; |
|
5
|
|
|
|
|
8
|
|
|
5
|
|
|
|
|
394
|
|
6
|
5
|
|
|
5
|
|
25
|
use Exporter 'import'; |
|
5
|
|
|
|
|
9
|
|
|
5
|
|
|
|
|
164
|
|
7
|
5
|
|
|
5
|
|
3118
|
use Module::Runtime 'require_module'; |
|
5
|
|
|
|
|
8954
|
|
|
5
|
|
|
|
|
31
|
|
8
|
5
|
|
|
5
|
|
2514
|
use Role::Tiny (); |
|
5
|
|
|
|
|
13567
|
|
|
5
|
|
|
|
|
125
|
|
9
|
5
|
|
|
5
|
|
32
|
use Scalar::Util 'blessed'; |
|
5
|
|
|
|
|
7
|
|
|
5
|
|
|
|
|
507
|
|
10
|
5
|
|
|
5
|
|
2930
|
use WWW::Form::UrlEncoded 'build_urlencoded_utf8', 'parse_urlencoded_arrayref'; |
|
5
|
|
|
|
|
8281
|
|
|
5
|
|
|
|
|
2562
|
|
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
our $VERSION = '0.005'; |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
our @EXPORT_OK = qw(form_urlencode form_urldecode oauth_request); |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
sub form_urldecode { |
17
|
15
|
|
|
15
|
1
|
3020
|
my $string = shift; |
18
|
15
|
100
|
|
|
|
87
|
return [] unless defined $string; |
19
|
14
|
|
|
|
|
84
|
my $form = parse_urlencoded_arrayref $string; |
20
|
14
|
|
|
|
|
92
|
utf8::decode $_ for @$form; |
21
|
14
|
|
|
|
|
73
|
return $form; |
22
|
|
|
|
|
|
|
} |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
sub form_urlencode { |
25
|
13
|
|
|
13
|
1
|
485
|
my $form = shift; |
26
|
13
|
100
|
|
|
|
56
|
if (ref $form eq 'ARRAY') { |
|
|
50
|
|
|
|
|
|
27
|
11
|
50
|
|
|
|
62
|
croak 'Form to urlencode must be even-sized' if @$form % 2; |
28
|
|
|
|
|
|
|
} elsif (ref $form eq 'HASH') { |
29
|
2
|
|
|
|
|
13
|
$form = [map { ($_ => $form->{$_}) } sort keys %$form]; |
|
3
|
|
|
|
|
6
|
|
30
|
|
|
|
|
|
|
} else { |
31
|
0
|
|
|
|
|
0
|
croak 'Form to urlencode must be hash or array reference'; |
32
|
|
|
|
|
|
|
} |
33
|
13
|
|
|
|
|
420
|
return build_urlencoded_utf8 $form, '&'; |
34
|
|
|
|
|
|
|
} |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
sub oauth_request { |
37
|
12
|
100
|
|
12
|
1
|
6678
|
my $class = ref $_[0] ? undef : shift; |
38
|
12
|
|
|
|
|
18
|
my $proto = shift; |
39
|
12
|
|
|
|
|
15
|
my %args; |
40
|
12
|
100
|
|
|
|
63
|
if (blessed $proto) { # Request object |
|
|
50
|
|
|
|
|
|
41
|
8
|
100
|
|
|
|
23
|
return $proto if Role::Tiny::does_role($proto, 'WWW::OAuth::Request'); # already in container |
42
|
4
|
100
|
|
|
|
63
|
unless (defined $class) { |
43
|
2
|
100
|
|
|
|
7
|
if ($proto->isa('HTTP::Request')) { |
|
|
50
|
|
|
|
|
|
44
|
1
|
|
|
|
|
6
|
$class = 'HTTP_Request'; |
45
|
|
|
|
|
|
|
} elsif ($proto->isa('Mojo::Message::Request')) { |
46
|
1
|
|
|
|
|
10
|
$class = 'Mojo'; |
47
|
|
|
|
|
|
|
} else { |
48
|
0
|
|
|
|
|
0
|
$class = blessed $proto; |
49
|
0
|
|
|
|
|
0
|
$class =~ s/::/_/g; |
50
|
|
|
|
|
|
|
} |
51
|
|
|
|
|
|
|
} |
52
|
4
|
|
|
|
|
10
|
%args = (request => $proto); |
53
|
|
|
|
|
|
|
} elsif (ref $proto eq 'HASH') { # Hashref |
54
|
4
|
100
|
|
|
|
14
|
$class = 'Basic' unless defined $class; |
55
|
4
|
|
|
|
|
21
|
%args = %$proto; |
56
|
|
|
|
|
|
|
} else { |
57
|
0
|
|
|
|
|
0
|
croak 'No request or request parameters passed'; |
58
|
|
|
|
|
|
|
} |
59
|
|
|
|
|
|
|
|
60
|
8
|
50
|
|
|
|
39
|
$class = "WWW::OAuth::Request::$class" unless $class =~ /::/; |
61
|
8
|
|
|
|
|
26
|
require_module $class; |
62
|
8
|
50
|
|
|
|
170
|
croak "Class $class does not perform the role WWW::OAuth::Request" |
63
|
|
|
|
|
|
|
unless Role::Tiny::does_role($class, 'WWW::OAuth::Request'); |
64
|
|
|
|
|
|
|
|
65
|
8
|
|
|
|
|
140
|
return $class->new(%args); |
66
|
|
|
|
|
|
|
} |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
1; |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
=head1 NAME |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
WWW::OAuth::Util - Utility functions for WWW::OAuth |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
=head1 SYNOPSIS |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
use WWW::OAuth::Util 'form_urldecode', 'form_urlencode'; |
77
|
|
|
|
|
|
|
my $body_string = form_urlencode({foo => 'a b c', bar => [1, 2, 3]}); |
78
|
|
|
|
|
|
|
# bar=1&bar=2&bar=3&foo=a+b+c |
79
|
|
|
|
|
|
|
my $ordered_pairs = form_urldecode($body_string); |
80
|
|
|
|
|
|
|
# ['bar', '1', 'bar', '2', 'bar', '3', 'foo', 'a b c'] |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
use WWW::OAuth::Util 'oauth_request'; |
83
|
|
|
|
|
|
|
my $container = oauth_request($http_request); |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
=head1 DESCRIPTION |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
L contains utility functions for use with L. All |
88
|
|
|
|
|
|
|
functions are exportable on demand. |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
=head1 FUNCTIONS |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
=head2 form_urldecode |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
my $param_pairs = form_urldecode($body_string); |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
Decodes an C string and returns an |
97
|
|
|
|
|
|
|
even-sized arrayref of key-value pairs. Order is preserved and repeated keys |
98
|
|
|
|
|
|
|
are not combined. |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
=head2 form_urlencode |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
my $body_string = form_urlencode([foo => 2, bar => 'baz', foo => 1]); |
103
|
|
|
|
|
|
|
# foo=2&bar=baz&foo=1 |
104
|
|
|
|
|
|
|
my $body_string = form_urlencode({foo => [2, 1], bar => 'baz'}); |
105
|
|
|
|
|
|
|
# bar=baz&foo=2&foo=1 |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
Converts a hash or array reference into an C |
108
|
|
|
|
|
|
|
string suitable for a query string or request body. If a value is an array |
109
|
|
|
|
|
|
|
reference, the key is repeated with each value. Order is preserved if |
110
|
|
|
|
|
|
|
parameters are passed in an array reference; the parameters are sorted by key |
111
|
|
|
|
|
|
|
for consistency if passed in a hash reference. |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
=head2 oauth_request |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
my $container = oauth_request($http_request); |
116
|
|
|
|
|
|
|
my $container = oauth_request({ method => 'GET', url => $url }); |
117
|
|
|
|
|
|
|
my $container = oauth_request(Basic => { method => 'POST', url => $url, content => $content }); |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
Constructs an HTTP request container performing the L |
120
|
|
|
|
|
|
|
role. The input should be a recognized request object or hashref of arguments |
121
|
|
|
|
|
|
|
optionally preceded by a container class name. The class name is appended to |
122
|
|
|
|
|
|
|
C if it does not contain C<::>. Currently, |
123
|
|
|
|
|
|
|
L and L objects are recognized, and |
124
|
|
|
|
|
|
|
hashrefs are used to construct a L object if no |
125
|
|
|
|
|
|
|
container class is specified. |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
# Longer forms to construct WWW::OAuth::Request::HTTP_Request |
128
|
|
|
|
|
|
|
my $container = oauth_request(HTTP_Request => $http_request); |
129
|
|
|
|
|
|
|
my $container = oauth_request(HTTP_Request => { request => $http_request }); |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
=head1 BUGS |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
Report any issues on the public bugtracker. |
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
=head1 AUTHOR |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
Dan Book |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
This software is Copyright (c) 2015 by Dan Book. |
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
This is free software, licensed under: |
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
The Artistic License 2.0 (GPL Compatible) |
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
=head1 SEE ALSO |
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
L, L |