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 4     4   145592 use strict;
  4         28  
  4         122  
4 4     4   21 use warnings;
  4         8  
  4         133  
5 4     4   40 use Carp 'croak';
  4         8  
  4         201  
6 4     4   22 use Exporter 'import';
  4         8  
  4         129  
7 4     4   2057 use Module::Runtime 'require_module';
  4         6919  
  4         23  
8 4     4   1874 use Role::Tiny ();
  4         12832  
  4         122  
9 4     4   28 use Scalar::Util 'blessed';
  4         8  
  4         219  
10 4     4   2014 use WWW::Form::UrlEncoded 'build_urlencoded_utf8', 'parse_urlencoded_arrayref';
  4         6115  
  4         2132  
11              
12             our $VERSION = '1.000';
13              
14             our @EXPORT_OK = qw(form_urlencode form_urldecode oauth_request);
15              
16             sub form_urldecode {
17 13     13 1 5400 my $string = shift;
18 13 100       46 return [] unless defined $string;
19 12         67 my $form = parse_urlencoded_arrayref $string;
20 12         57 utf8::decode $_ for @$form;
21 12         87 return $form;
22             }
23              
24             sub form_urlencode {
25 11     11 1 722 my $form = shift;
26 11 100       40 if (ref $form eq 'ARRAY') {
    50          
27 9 50       33 croak 'Form to urlencode must be even-sized' if @$form % 2;
28             } elsif (ref $form eq 'HASH') {
29 2         11 $form = [map { ($_ => $form->{$_}) } sort keys %$form];
  3         8  
30             } else {
31 0         0 croak 'Form to urlencode must be hash or array reference';
32             }
33 11         233 return build_urlencoded_utf8 $form, '&';
34             }
35              
36             sub oauth_request {
37 12 100   12 1 11114 my $class = ref $_[0] ? undef : shift;
38 12         22 my $proto = shift;
39 12         19 my %args;
40 12 100       59 if (blessed $proto) { # Request object
    50          
41 8 100       21 return $proto if Role::Tiny::does_role($proto, 'WWW::OAuth::Request'); # already in container
42 4 100       73 unless (defined $class) {
43 2 100       13 if ($proto->isa('HTTP::Request')) {
    50          
44 1         6 $class = 'HTTP_Request';
45             } elsif ($proto->isa('Mojo::Message::Request')) {
46 1         15 $class = 'Mojo';
47             } else {
48 0         0 $class = blessed $proto;
49 0         0 $class =~ s/::/_/g;
50             }
51             }
52 4         11 %args = (request => $proto);
53             } elsif (ref $proto eq 'HASH') { # Hashref
54 4 100       16 $class = 'Basic' unless defined $class;
55 4         19 %args = %$proto;
56             } else {
57 0         0 croak 'No request or request parameters passed';
58             }
59            
60 8 50       44 $class = "WWW::OAuth::Request::$class" unless $class =~ /::/;
61 8         36 require_module $class;
62 8 50       224 croak "Class $class does not perform the role WWW::OAuth::Request"
63             unless Role::Tiny::does_role($class, 'WWW::OAuth::Request');
64            
65 8         168 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