File Coverage

blib/lib/WWW/OAuth/Util.pm
Criterion Covered Total %
statement 51 55 92.7
branch 22 28 78.5
condition n/a
subroutine 11 11 100.0
pod 3 3 100.0
total 87 97 89.6


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