File Coverage

blib/lib/Reddit/Client/Request.pm
Criterion Covered Total %
statement 79 138 57.2
branch 15 48 31.2
condition 12 26 46.1
subroutine 14 16 87.5
pod 4 6 66.6
total 124 234 52.9


line stmt bran cond sub pod time code
1             package Reddit::Client::Request;
2              
3 5     5   126715 use strict;
  5         18  
  5         148  
4 5     5   26 use warnings;
  5         9  
  5         113  
5 5     5   24 use Carp;
  5         11  
  5         276  
6              
7 5     5   754 use JSON qw/encode_json decode_json/;
  5         10827  
  5         35  
8 5     5   4277 use LWP::UserAgent qw//;
  5         198418  
  5         156  
9 5     5   50 use HTTP::Request qw//;
  5         138  
  5         151  
10 5     5   2710 use URI::Encode qw/uri_encode/;
  5         82223  
  5         350  
11 5     5   48 use URI::Escape qw/uri_escape/; # next update, also line 122
  5         13  
  5         240  
12 5     5   33 use Data::Dumper;
  5         10  
  5         379  
13              
14             require Reddit::Client;
15              
16             use fields (
17 5         42 'user_agent',
18             'method',
19             'url',
20             'query',
21             'post_data',
22             'cookie',
23             'modhash',
24             'token',
25             'tokentype',
26             'request_errors',
27             'print_response',
28             'print_request',
29             'print_request_on_error',
30             'last_token',
31 5     5   527 );
  5         1745  
32              
33             sub new {
34 3     3 1 3644 my ($class, %param) = @_;
35 3         16 my $self = fields::new($class);
36 3   66     4290 $self->{user_agent} = $param{user_agent} || croak 'Expected "user_agent"';
37 2   66     102 $self->{url} = $param{url} || croak 'Expected "url"';
38 1         3 $self->{query} = $param{query};
39 1         3 $self->{post_data} = $param{post_data};
40 1         2 $self->{cookie} = $param{cookie};
41 1         3 $self->{modhash} = $param{modhash};
42 1         3 $self->{token} = $param{token};
43 1         2 $self->{tokentype} = $param{tokentype};
44 1   50     8 $self->{request_errors} = $param{request_errors} || 0;
45 1   50     7 $self->{print_response} = $param{print_response} || 0;
46 1   50     6 $self->{print_request} = $param{print_request} || 0;
47 1   50     6 $self->{print_request_on_error} = $param{print_request_on_error} || 0;
48 1         4 $self->{last_token} = $param{last_token};
49              
50 1 50       5 if (defined $self->{query}) {
51 1 50       6 ref $self->{query} eq 'HASH' || croak 'Expected HASH ref for "query"';
52 1         4 $self->{url} = sprintf('%s?%s', $self->{url}, build_query($self->{query}))
53             }
54              
55 1 50       2710 if (defined $self->{post_data}) {
56 1 50       7 ref $self->{post_data} eq 'HASH' || croak 'Expected HASH ref for "post_data"';
57             }
58              
59 1   50     5 $self->{method} = $param{method} || 'GET';
60 1         3 $self->{method} = uc $self->{method};
61              
62 1         6 return $self;
63             }
64              
65             sub build_query {
66 8 100   8 1 2616 my $param = shift or return '';
67 7         23 my $opt = { encode_reserved => 1 };
68 7         49 join '&', map {uri_encode($_, $opt) . '=' . uri_encode($param->{$_}, $opt)} sort keys %$param;
  13         17528  
69             }
70              
71             sub build_request {
72 3     3 1 376 my $self = shift;
73 3         30 my $request = HTTP::Request->new();
74              
75 3         581 $request->uri($self->{url});
76 3 0 33     8074 $request->header("Authorization"=> "$self->{tokentype} $self->{token}") if $self->{tokentype} && $self->{token};
77              
78 3 50       16 if ($self->{method} eq 'POST') {
    0          
    0          
79 3   50     14 my $post_data = $self->{post_data} || {};
80 3 50       15 $post_data->{modhash} = $self->{modhash} if $self->{modhash};
81 3 50       12 $post_data->{uh} = $self->{modhash} if $self->{modhash};
82              
83 3         11 $request->method('POST');
84 3         57 $request->content_type('application/x-www-form-urlencoded');
85 3         116 $request->content(build_query($post_data));
86             } elsif ($self->{method} eq 'DELETE') {
87 0         0 $request->method('DELETE');
88             } elsif ($self->{method} eq 'PUT') {
89 0   0     0 my $post_data = $self->{post_data} || {};
90 0 0       0 $post_data->{modhash} = $self->{modhash} if $self->{modhash};
91 0 0       0 $post_data->{uh} = $self->{modhash} if $self->{modhash};
92              
93 0         0 $request->method('PUT');
94 0         0 $request->content_type('application/x-www-form-urlencoded');
95 0         0 $request->content(build_query($post_data));
96             } else {
97 0         0 $request->method('GET');
98             }
99              
100 3         7045 return $request;
101             }
102              
103             sub send {
104 2     2 1 2478 my $self = shift;
105 2         9 my $request = $self->build_request;
106              
107 2         21 Reddit::Client::DEBUG('%4s request to %s', $self->{method}, $self->{url});
108              
109 2         30 my $ua = LWP::UserAgent->new(agent => $self->{user_agent}, env_proxy => 1);
110 2         8975 my $res = $ua->request($request);
111              
112 2 50       225 if ($self->{print_request}) {
    50          
113 0         0 print Dumper($request);
114 0         0 print Dumper($res);
115             } elsif ($self->{print_response}) {
116 0         0 print $res->content . "\n";
117             }
118              
119             # response is an HTTP::Response object, sent is HTTP::Request
120              
121 2 100       12 if ($res->is_success) {
122 1         14 return $res->content;
123             } else {
124             # I don't know what the fuck any of this is
125             # print request unless we already printed it
126 1 50 33     19 if ($self->{print_request_on_error} and !$self->{print_request}) {
    50          
127 0         0 print Dumper($request);
128 0         0 print Dumper($res);
129             } elsif ($self->{request_errors}) {
130 0         0 my $json;
131 0         0 my $success = eval { $json = decode_json $res->{_content}; };
  0         0  
132              
133             # If Reddit returned valid json, add it to a hash and print it
134 0 0       0 if ($success) {
135 0         0 my $err = {
136             error => 1,
137             code => $res->code,
138             status_line => $res->status_line,
139             data => $json,
140             };
141            
142 0         0 my $rtn = encode_json $err;
143 0         0 die "$rtn\n";
144              
145             } else {
146 0         0 die "Request error: HTTP ".$res->status_line .", Content: $res->{_content}";
147             }
148             #die $res->{_content}."\n";
149             } else { # default: print status line and exit
150             #croak sprintf("Request error: HTTP %s last token: %s time: %s", $res->status_line, $self->{last_token}, time);
151 1         6 die sprintf("Request error: HTTP %s\n", $res->status_line);
152             }
153             }
154             }
155              
156             sub token_request {
157 0     0 0   my ($self, %param) = @_;
158              
159 0           my $url = "https://$param{client_id}:$param{secret}\@www.reddit.com/api/v1/access_token";
160              
161 0           my $ua = LWP::UserAgent->new(agent => $param{user_agent});
162 0           my $req = HTTP::Request->new(POST => $url);
163 0           $req->header('content-type' => 'application/x-www-form-urlencoded');
164              
165             #my $postdata = "grant_type=password&username=$username&password=$password";
166 0           my $postdata;
167            
168 0 0         if ($param{auth_type} eq 'script') {
    0          
169 0           $postdata = "grant_type=password&username=$param{username}&password=" . uri_escape($param{password});
170             } elsif ($param{auth_type} eq 'webapp') {
171 0           $postdata = "grant_type=refresh_token&refresh_token=".uri_escape($param{refresh_token});
172 0           } else { die "Request:token_request: invalid auth type"; }
173              
174 0           $req->content($postdata);
175              
176 0           my $res = $ua->request($req);
177              
178 0 0         if ($res->is_success) {
179 0           return $res->decoded_content;
180             } else {
181             # this is sometimes called in static context
182             #if ($self->{request_errors}) {
183             # croak "Request error: HTTP ".$res->status_line .", Content: $res->{_content}";
184             #} else {
185 0           croak sprintf("Request error: HTTP %s", $res->status_line);
186             #}
187             #croak sprintf('Request error: HTTP %s', $res->status_line);
188             }
189             }
190              
191             sub refresh_token_request {
192 0     0 0   my ($self, %data) = @_;
193              
194             # create user agent
195 0           my $ua = new LWP::UserAgent( agent=> $data{ua} );
196             # create new request
197 0           my $request = new HTTP::Request();
198             # set the request method
199 0           $request->method("POST");
200             # set request url
201 0           my $url = "https://$data{client_id}:$data{secret}\@www.reddit.com/api/v1/access_token";
202 0           $request->uri($url);
203              
204             my $reqdata = {
205             grant_type => 'authorization_code',
206             code => $data{code},
207             redirect_uri=> $data{redirect_uri},
208 0           duration => 'permanent',
209             };
210              
211 0           $request->content_type('application/x-www-form-urlencoded');
212              
213 0           my $opt = { encode_reserved => 1 };
214 0           my $encoded = join '&', map { uri_encode($_, $opt) . '=' . uri_encode($reqdata->{$_}, $opt) } sort keys %$reqdata;
  0            
215              
216 0           $request->content($encoded);
217              
218 0           my $result = $ua->request($request);
219              
220 0 0         if ($data{print_request}) {
221 0           print Dumper($request);
222 0           print Dumper($result);
223             }
224              
225 0 0         if ($result->is_success) {
226 0           my $j = decode_json $result->content;
227 0           my $tok = $j->{refresh_token};
228              
229 0           return $tok;
230             } else {
231 0           print "Request error: HTTP ".$result->status_line.", Content:\n$result->{_content}\n";
232 0           print "refresh_token_request: something went wrong. To aid in debugging, you can set 'print_request' to true when creating a new Reddit::Client object. This will print the entire content of the request and response.\n";
233              
234 0           die;
235             }
236              
237             }
238              
239             1;
240              
241             __END__