| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | package HTTP::Request::CurlParameters; | 
| 2 | 18 |  |  | 18 |  | 70401 | use strict; | 
|  | 18 |  |  |  |  | 54 |  | 
|  | 18 |  |  |  |  | 556 |  | 
| 3 | 18 |  |  | 18 |  | 119 | use warnings; | 
|  | 18 |  |  |  |  | 55 |  | 
|  | 18 |  |  |  |  | 435 |  | 
| 4 | 18 |  |  | 18 |  | 988 | use HTTP::Request; | 
|  | 18 |  |  |  |  | 45558 |  | 
|  | 18 |  |  |  |  | 359 |  | 
| 5 | 18 |  |  | 18 |  | 1095 | use HTTP::Request::Common; | 
|  | 18 |  |  |  |  | 4852 |  | 
|  | 18 |  |  |  |  | 1014 |  | 
| 6 | 18 |  |  | 18 |  | 111 | use URI; | 
|  | 18 |  |  |  |  | 39 |  | 
|  | 18 |  |  |  |  | 412 |  | 
| 7 | 18 |  |  | 18 |  | 96 | use File::Spec::Unix; | 
|  | 18 |  |  |  |  | 67 |  | 
|  | 18 |  |  |  |  | 522 |  | 
| 8 | 18 |  |  | 18 |  | 99 | use List::Util 'pairmap'; | 
|  | 18 |  |  |  |  | 32 |  | 
|  | 18 |  |  |  |  | 1932 |  | 
| 9 | 18 |  |  | 18 |  | 7699 | use PerlX::Maybe; | 
|  | 18 |  |  |  |  | 41560 |  | 
|  | 18 |  |  |  |  | 82 |  | 
| 10 | 18 |  |  | 18 |  | 722 | use Carp 'croak'; | 
|  | 18 |  |  |  |  | 42 |  | 
|  | 18 |  |  |  |  | 1219 |  | 
| 11 |  |  |  |  |  |  |  | 
| 12 | 18 |  |  | 18 |  | 9918 | use Moo 2; | 
|  | 18 |  |  |  |  | 221668 |  | 
|  | 18 |  |  |  |  | 106 |  | 
| 13 | 18 |  |  | 18 |  | 35335 | use Filter::signatures; | 
|  | 18 |  |  |  |  | 417022 |  | 
|  | 18 |  |  |  |  | 114 |  | 
| 14 | 18 |  |  | 18 |  | 679 | use feature 'signatures'; | 
|  | 18 |  |  |  |  | 220 |  | 
|  | 18 |  |  |  |  | 623 |  | 
| 15 | 18 |  |  | 18 |  | 109 | no warnings 'experimental::signatures'; | 
|  | 18 |  |  |  |  | 118 |  | 
|  | 18 |  |  |  |  | 99445 |  | 
| 16 |  |  |  |  |  |  |  | 
| 17 |  |  |  |  |  |  | our $VERSION = '0.50'; | 
| 18 |  |  |  |  |  |  |  | 
| 19 |  |  |  |  |  |  | =head1 NAME | 
| 20 |  |  |  |  |  |  |  | 
| 21 |  |  |  |  |  |  | HTTP::Request::CurlParameters - container for a Curl-like HTTP request | 
| 22 |  |  |  |  |  |  |  | 
| 23 |  |  |  |  |  |  | =head1 SYNOPSIS | 
| 24 |  |  |  |  |  |  |  | 
| 25 |  |  |  |  |  |  | my $ua = LWP::UserAgent->new; | 
| 26 |  |  |  |  |  |  | my $params = HTTP::Request::CurlParameters->new(argv => \@ARGV); | 
| 27 |  |  |  |  |  |  | my $response = $ua->request($params->as_request); | 
| 28 |  |  |  |  |  |  |  | 
| 29 |  |  |  |  |  |  | =head1 DESCRIPTION | 
| 30 |  |  |  |  |  |  |  | 
| 31 |  |  |  |  |  |  | Objects of this class are mostly created from L. Most | 
| 32 |  |  |  |  |  |  | likely you want to use that module instead: | 
| 33 |  |  |  |  |  |  |  | 
| 34 |  |  |  |  |  |  | my $ua = LWP::UserAgent->new; | 
| 35 |  |  |  |  |  |  | my $params = HTTP::Request::FromCurl->new(command_curl => $cmd); | 
| 36 |  |  |  |  |  |  | my $response = $ua->request($params->as_request); | 
| 37 |  |  |  |  |  |  |  | 
| 38 |  |  |  |  |  |  | =head1 METHODS | 
| 39 |  |  |  |  |  |  |  | 
| 40 |  |  |  |  |  |  | =head2 C<< ->new >> | 
| 41 |  |  |  |  |  |  |  | 
| 42 |  |  |  |  |  |  | Options: | 
| 43 |  |  |  |  |  |  |  | 
| 44 |  |  |  |  |  |  | =over 4 | 
| 45 |  |  |  |  |  |  |  | 
| 46 |  |  |  |  |  |  | =item * | 
| 47 |  |  |  |  |  |  |  | 
| 48 |  |  |  |  |  |  | C | 
| 49 |  |  |  |  |  |  |  | 
| 50 |  |  |  |  |  |  | method => 'GET' | 
| 51 |  |  |  |  |  |  |  | 
| 52 |  |  |  |  |  |  | The HTTP method to use. | 
| 53 |  |  |  |  |  |  |  | 
| 54 |  |  |  |  |  |  | =cut | 
| 55 |  |  |  |  |  |  |  | 
| 56 |  |  |  |  |  |  | has method => ( | 
| 57 |  |  |  |  |  |  | is => 'ro', | 
| 58 |  |  |  |  |  |  | default => 'GET', | 
| 59 |  |  |  |  |  |  | ); | 
| 60 |  |  |  |  |  |  |  | 
| 61 |  |  |  |  |  |  | =item * | 
| 62 |  |  |  |  |  |  |  | 
| 63 |  |  |  |  |  |  | C | 
| 64 |  |  |  |  |  |  |  | 
| 65 |  |  |  |  |  |  | uri => 'https://example.com' | 
| 66 |  |  |  |  |  |  |  | 
| 67 |  |  |  |  |  |  | The URI of the request. | 
| 68 |  |  |  |  |  |  |  | 
| 69 |  |  |  |  |  |  | =cut | 
| 70 |  |  |  |  |  |  |  | 
| 71 |  |  |  |  |  |  | has uri => ( | 
| 72 |  |  |  |  |  |  | is => 'ro', | 
| 73 |  |  |  |  |  |  | default => 'https://example.com', | 
| 74 |  |  |  |  |  |  | ); | 
| 75 |  |  |  |  |  |  |  | 
| 76 |  |  |  |  |  |  | =item * | 
| 77 |  |  |  |  |  |  |  | 
| 78 |  |  |  |  |  |  | C | 
| 79 |  |  |  |  |  |  |  | 
| 80 |  |  |  |  |  |  | headers => { | 
| 81 |  |  |  |  |  |  | 'Content-Type' => 'text/json', | 
| 82 |  |  |  |  |  |  | 'X-Secret' => ['value-1', 'value-2'], | 
| 83 |  |  |  |  |  |  | } | 
| 84 |  |  |  |  |  |  |  | 
| 85 |  |  |  |  |  |  | The headers of the request. Multiple headers with the same | 
| 86 |  |  |  |  |  |  | name can be passed as an arrayref to the header key. | 
| 87 |  |  |  |  |  |  |  | 
| 88 |  |  |  |  |  |  | =cut | 
| 89 |  |  |  |  |  |  |  | 
| 90 |  |  |  |  |  |  | has headers => ( | 
| 91 |  |  |  |  |  |  | is => 'ro', | 
| 92 |  |  |  |  |  |  | default => sub { {} }, | 
| 93 |  |  |  |  |  |  | ); | 
| 94 |  |  |  |  |  |  |  | 
| 95 |  |  |  |  |  |  | =item * | 
| 96 |  |  |  |  |  |  |  | 
| 97 |  |  |  |  |  |  | C | 
| 98 |  |  |  |  |  |  |  | 
| 99 |  |  |  |  |  |  | The cookie jar to use. | 
| 100 |  |  |  |  |  |  |  | 
| 101 |  |  |  |  |  |  | =cut | 
| 102 |  |  |  |  |  |  |  | 
| 103 |  |  |  |  |  |  | has cookie_jar => ( | 
| 104 |  |  |  |  |  |  | is => 'ro', | 
| 105 |  |  |  |  |  |  | ); | 
| 106 |  |  |  |  |  |  |  | 
| 107 |  |  |  |  |  |  | =item * | 
| 108 |  |  |  |  |  |  |  | 
| 109 |  |  |  |  |  |  | C | 
| 110 |  |  |  |  |  |  |  | 
| 111 |  |  |  |  |  |  | Options for the constructor of the cookie jar. | 
| 112 |  |  |  |  |  |  |  | 
| 113 |  |  |  |  |  |  | =cut | 
| 114 |  |  |  |  |  |  |  | 
| 115 |  |  |  |  |  |  | has cookie_jar_options => ( | 
| 116 |  |  |  |  |  |  | is => 'ro', | 
| 117 |  |  |  |  |  |  | default => sub { {} }, | 
| 118 |  |  |  |  |  |  | ); | 
| 119 |  |  |  |  |  |  |  | 
| 120 |  |  |  |  |  |  | =item * | 
| 121 |  |  |  |  |  |  |  | 
| 122 |  |  |  |  |  |  | C | 
| 123 |  |  |  |  |  |  |  | 
| 124 |  |  |  |  |  |  | credentials => 'hunter2:secret' | 
| 125 |  |  |  |  |  |  |  | 
| 126 |  |  |  |  |  |  | The credentials to use for basic authentication. | 
| 127 |  |  |  |  |  |  |  | 
| 128 |  |  |  |  |  |  | =cut | 
| 129 |  |  |  |  |  |  |  | 
| 130 |  |  |  |  |  |  | has credentials => ( | 
| 131 |  |  |  |  |  |  | is => 'ro', | 
| 132 |  |  |  |  |  |  | ); | 
| 133 |  |  |  |  |  |  |  | 
| 134 |  |  |  |  |  |  | =item * | 
| 135 |  |  |  |  |  |  |  | 
| 136 |  |  |  |  |  |  | C | 
| 137 |  |  |  |  |  |  |  | 
| 138 |  |  |  |  |  |  | auth => 'basic' | 
| 139 |  |  |  |  |  |  |  | 
| 140 |  |  |  |  |  |  | The authentication method to use. | 
| 141 |  |  |  |  |  |  |  | 
| 142 |  |  |  |  |  |  | =cut | 
| 143 |  |  |  |  |  |  |  | 
| 144 |  |  |  |  |  |  | has auth => ( | 
| 145 |  |  |  |  |  |  | is => 'ro', | 
| 146 |  |  |  |  |  |  | ); | 
| 147 |  |  |  |  |  |  |  | 
| 148 |  |  |  |  |  |  | =item * | 
| 149 |  |  |  |  |  |  |  | 
| 150 |  |  |  |  |  |  | C | 
| 151 |  |  |  |  |  |  |  | 
| 152 |  |  |  |  |  |  | post_data => ['A string','across multiple','scalars'] | 
| 153 |  |  |  |  |  |  |  | 
| 154 |  |  |  |  |  |  | The POST body to use. | 
| 155 |  |  |  |  |  |  |  | 
| 156 |  |  |  |  |  |  | =cut | 
| 157 |  |  |  |  |  |  |  | 
| 158 |  |  |  |  |  |  | has post_data => ( | 
| 159 |  |  |  |  |  |  | is => 'ro', | 
| 160 |  |  |  |  |  |  | default => sub { [] }, | 
| 161 |  |  |  |  |  |  | ); | 
| 162 |  |  |  |  |  |  |  | 
| 163 |  |  |  |  |  |  | =item * | 
| 164 |  |  |  |  |  |  |  | 
| 165 |  |  |  |  |  |  | C | 
| 166 |  |  |  |  |  |  |  | 
| 167 |  |  |  |  |  |  | body => '{"greeting":"Hello"}' | 
| 168 |  |  |  |  |  |  |  | 
| 169 |  |  |  |  |  |  | The body of the request. | 
| 170 |  |  |  |  |  |  |  | 
| 171 |  |  |  |  |  |  | =cut | 
| 172 |  |  |  |  |  |  |  | 
| 173 |  |  |  |  |  |  | has body => ( | 
| 174 |  |  |  |  |  |  | is => 'ro', | 
| 175 |  |  |  |  |  |  | ); | 
| 176 |  |  |  |  |  |  |  | 
| 177 |  |  |  |  |  |  | =item * | 
| 178 |  |  |  |  |  |  |  | 
| 179 |  |  |  |  |  |  | C | 
| 180 |  |  |  |  |  |  |  | 
| 181 |  |  |  |  |  |  | timeout => 50 | 
| 182 |  |  |  |  |  |  |  | 
| 183 |  |  |  |  |  |  | The timeout for the request | 
| 184 |  |  |  |  |  |  |  | 
| 185 |  |  |  |  |  |  | =cut | 
| 186 |  |  |  |  |  |  |  | 
| 187 |  |  |  |  |  |  | has timeout => ( | 
| 188 |  |  |  |  |  |  | is => 'ro', | 
| 189 |  |  |  |  |  |  | ); | 
| 190 |  |  |  |  |  |  |  | 
| 191 |  |  |  |  |  |  | =item * | 
| 192 |  |  |  |  |  |  |  | 
| 193 |  |  |  |  |  |  | C | 
| 194 |  |  |  |  |  |  |  | 
| 195 |  |  |  |  |  |  | unix_socket => '/var/run/docker/docker.sock' | 
| 196 |  |  |  |  |  |  |  | 
| 197 |  |  |  |  |  |  | The timeout for the request | 
| 198 |  |  |  |  |  |  |  | 
| 199 |  |  |  |  |  |  | =cut | 
| 200 |  |  |  |  |  |  |  | 
| 201 |  |  |  |  |  |  | has unix_socket => ( | 
| 202 |  |  |  |  |  |  | is => 'ro', | 
| 203 |  |  |  |  |  |  | ); | 
| 204 |  |  |  |  |  |  |  | 
| 205 |  |  |  |  |  |  | =item * | 
| 206 |  |  |  |  |  |  |  | 
| 207 |  |  |  |  |  |  | C | 
| 208 |  |  |  |  |  |  |  | 
| 209 |  |  |  |  |  |  | local_address => '192.0.2.116' | 
| 210 |  |  |  |  |  |  |  | 
| 211 |  |  |  |  |  |  | The local network address to bind to when making the request | 
| 212 |  |  |  |  |  |  |  | 
| 213 |  |  |  |  |  |  | =cut | 
| 214 |  |  |  |  |  |  |  | 
| 215 |  |  |  |  |  |  | has local_address => ( | 
| 216 |  |  |  |  |  |  | is => 'ro', | 
| 217 |  |  |  |  |  |  | ); | 
| 218 |  |  |  |  |  |  |  | 
| 219 |  |  |  |  |  |  | =item * | 
| 220 |  |  |  |  |  |  |  | 
| 221 |  |  |  |  |  |  | C | 
| 222 |  |  |  |  |  |  |  | 
| 223 |  |  |  |  |  |  | The HTML form parameters. These get converted into | 
| 224 |  |  |  |  |  |  | a body. | 
| 225 |  |  |  |  |  |  |  | 
| 226 |  |  |  |  |  |  | =cut | 
| 227 |  |  |  |  |  |  |  | 
| 228 |  |  |  |  |  |  | has form_args => ( | 
| 229 |  |  |  |  |  |  | is => 'ro', | 
| 230 |  |  |  |  |  |  | default => sub { [] }, | 
| 231 |  |  |  |  |  |  | ); | 
| 232 |  |  |  |  |  |  |  | 
| 233 |  |  |  |  |  |  | =item * | 
| 234 |  |  |  |  |  |  |  | 
| 235 |  |  |  |  |  |  | C | 
| 236 |  |  |  |  |  |  |  | 
| 237 |  |  |  |  |  |  | insecure => 1 | 
| 238 |  |  |  |  |  |  |  | 
| 239 |  |  |  |  |  |  | Disable SSL certificate verification | 
| 240 |  |  |  |  |  |  |  | 
| 241 |  |  |  |  |  |  | =cut | 
| 242 |  |  |  |  |  |  |  | 
| 243 |  |  |  |  |  |  | has insecure => ( | 
| 244 |  |  |  |  |  |  | is => 'ro', | 
| 245 |  |  |  |  |  |  | ); | 
| 246 |  |  |  |  |  |  |  | 
| 247 |  |  |  |  |  |  | =item * | 
| 248 |  |  |  |  |  |  |  | 
| 249 |  |  |  |  |  |  | C | 
| 250 |  |  |  |  |  |  |  | 
| 251 |  |  |  |  |  |  | cert => '/path/to/certificate', | 
| 252 |  |  |  |  |  |  |  | 
| 253 |  |  |  |  |  |  | Use the certificate file for SSL | 
| 254 |  |  |  |  |  |  |  | 
| 255 |  |  |  |  |  |  | =cut | 
| 256 |  |  |  |  |  |  |  | 
| 257 |  |  |  |  |  |  | has cert => ( | 
| 258 |  |  |  |  |  |  | is => 'ro', | 
| 259 |  |  |  |  |  |  | ); | 
| 260 |  |  |  |  |  |  |  | 
| 261 |  |  |  |  |  |  | =item * | 
| 262 |  |  |  |  |  |  |  | 
| 263 |  |  |  |  |  |  | C | 
| 264 |  |  |  |  |  |  |  | 
| 265 |  |  |  |  |  |  | capath => '/path/to/cadir/', | 
| 266 |  |  |  |  |  |  |  | 
| 267 |  |  |  |  |  |  | Use the certificate directory for SSL | 
| 268 |  |  |  |  |  |  |  | 
| 269 |  |  |  |  |  |  | =cut | 
| 270 |  |  |  |  |  |  |  | 
| 271 |  |  |  |  |  |  | has capath => ( | 
| 272 |  |  |  |  |  |  | is => 'ro', | 
| 273 |  |  |  |  |  |  | ); | 
| 274 |  |  |  |  |  |  |  | 
| 275 |  |  |  |  |  |  | =item * | 
| 276 |  |  |  |  |  |  |  | 
| 277 |  |  |  |  |  |  | C | 
| 278 |  |  |  |  |  |  |  | 
| 279 |  |  |  |  |  |  | Name of the output file | 
| 280 |  |  |  |  |  |  |  | 
| 281 |  |  |  |  |  |  | =cut | 
| 282 |  |  |  |  |  |  |  | 
| 283 |  |  |  |  |  |  | has output => ( | 
| 284 |  |  |  |  |  |  | is => 'ro', | 
| 285 |  |  |  |  |  |  | ); | 
| 286 |  |  |  |  |  |  |  | 
| 287 |  |  |  |  |  |  | =item * | 
| 288 |  |  |  |  |  |  |  | 
| 289 |  |  |  |  |  |  | C | 
| 290 |  |  |  |  |  |  |  | 
| 291 |  |  |  |  |  |  | show_error => 0 | 
| 292 |  |  |  |  |  |  |  | 
| 293 |  |  |  |  |  |  | Show error message on HTTP errors | 
| 294 |  |  |  |  |  |  |  | 
| 295 |  |  |  |  |  |  | =cut | 
| 296 |  |  |  |  |  |  |  | 
| 297 |  |  |  |  |  |  | has show_error => ( | 
| 298 |  |  |  |  |  |  | is => 'ro', | 
| 299 |  |  |  |  |  |  | ); | 
| 300 |  |  |  |  |  |  |  | 
| 301 |  |  |  |  |  |  | =item * | 
| 302 |  |  |  |  |  |  |  | 
| 303 |  |  |  |  |  |  | C | 
| 304 |  |  |  |  |  |  |  | 
| 305 |  |  |  |  |  |  | fail => 1 | 
| 306 |  |  |  |  |  |  |  | 
| 307 |  |  |  |  |  |  | Let the Perl code C on error | 
| 308 |  |  |  |  |  |  |  | 
| 309 |  |  |  |  |  |  | =back | 
| 310 |  |  |  |  |  |  |  | 
| 311 |  |  |  |  |  |  | =cut | 
| 312 |  |  |  |  |  |  |  | 
| 313 |  |  |  |  |  |  | has fail => ( | 
| 314 |  |  |  |  |  |  | is => 'ro', | 
| 315 |  |  |  |  |  |  | ); | 
| 316 |  |  |  |  |  |  |  | 
| 317 | 52 |  |  | 52 |  | 171 | sub _build_quoted_body( $self, $body=$self->body ) { | 
|  | 52 |  |  |  |  | 129 |  | 
|  | 52 |  |  |  |  | 254 |  | 
|  | 52 |  |  |  |  | 118 |  | 
| 318 | 52 | 100 |  |  |  | 206 | if( defined $body ) { | 
| 319 | 8 |  |  |  |  | 123 | $body =~ s!([\x00-\x1f'"\$\@\%\\])!sprintf '\\x%02x', ord $1!ge; | 
|  | 4 |  |  |  |  | 232 |  | 
| 320 | 8 |  |  |  |  | 87 | return sprintf qq{"%s"}, $body | 
| 321 |  |  |  |  |  |  |  | 
| 322 |  |  |  |  |  |  | } else { | 
| 323 |  |  |  |  |  |  | # Sluuuurp | 
| 324 |  |  |  |  |  |  | my @post_data = map { | 
| 325 | 0 | 0 |  |  |  | 0 | /^\@(.*)/ ? do { | 
| 326 | 0 | 0 |  |  |  | 0 | open my $fh, '<', $1 | 
| 327 |  |  |  |  |  |  | or die "$1: $!"; | 
| 328 | 0 |  |  |  |  | 0 | local $/; # / for Filter::Simple | 
| 329 | 0 |  |  |  |  | 0 | binmode $fh; | 
| 330 |  |  |  |  |  |  | <$fh> | 
| 331 | 0 |  |  |  |  | 0 | } | 
| 332 |  |  |  |  |  |  | : $_ | 
| 333 | 44 |  |  |  |  | 109 | } @{ $self->post_data }; | 
|  | 44 |  |  |  |  | 228 |  | 
| 334 | 44 |  |  |  |  | 365 | return join "", @post_data; | 
| 335 |  |  |  |  |  |  | } | 
| 336 |  |  |  |  |  |  | }; | 
| 337 |  |  |  |  |  |  |  | 
| 338 |  |  |  |  |  |  | =head2 C<< ->as_request >> | 
| 339 |  |  |  |  |  |  |  | 
| 340 |  |  |  |  |  |  | $ua->request( $r->as_request ); | 
| 341 |  |  |  |  |  |  |  | 
| 342 |  |  |  |  |  |  | Returns an equivalent L object | 
| 343 |  |  |  |  |  |  |  | 
| 344 |  |  |  |  |  |  | =cut | 
| 345 |  |  |  |  |  |  |  | 
| 346 | 73 |  |  | 73 |  | 243 | sub _explode_headers( $self ) { | 
|  | 73 |  |  |  |  | 170 |  | 
|  | 73 |  |  |  |  | 146 |  | 
| 347 |  |  |  |  |  |  | my @res = | 
| 348 | 387 |  |  |  |  | 677 | map { my $h = $_; | 
| 349 | 387 |  |  |  |  | 1422 | my $v = $self->headers->{$h}; | 
| 350 | 387 | 100 |  |  |  | 1889 | ref $v ? (map { $h => $_ } @$v) | 
|  | 2 |  |  |  |  | 17 |  | 
| 351 |  |  |  |  |  |  | : ($h => $v) | 
| 352 | 73 |  |  |  |  | 210 | } keys %{ $self->headers }; | 
|  | 73 |  |  |  |  | 606 |  | 
| 353 |  |  |  |  |  |  | } | 
| 354 |  |  |  |  |  |  |  | 
| 355 |  |  |  |  |  |  | =head2 C<< $r->as_request >> | 
| 356 |  |  |  |  |  |  |  | 
| 357 |  |  |  |  |  |  | my $r = $curl->as_request; | 
| 358 |  |  |  |  |  |  |  | 
| 359 |  |  |  |  |  |  | Returns a L object that represents | 
| 360 |  |  |  |  |  |  | the Curl options. | 
| 361 |  |  |  |  |  |  |  | 
| 362 |  |  |  |  |  |  | =cut | 
| 363 |  |  |  |  |  |  |  | 
| 364 | 20 |  |  | 20 | 1 | 488468 | sub as_request( $self ) { | 
|  | 20 |  |  |  |  | 115 |  | 
|  | 20 |  |  |  |  | 68 |  | 
| 365 | 20 |  |  |  |  | 249 | HTTP::Request->new( | 
| 366 |  |  |  |  |  |  | $self->method => $self->uri, | 
| 367 |  |  |  |  |  |  | [ $self->_explode_headers() ], | 
| 368 |  |  |  |  |  |  | $self->body(), | 
| 369 |  |  |  |  |  |  | ) | 
| 370 |  |  |  |  |  |  | }; | 
| 371 |  |  |  |  |  |  |  | 
| 372 | 0 |  |  | 0 |  | 0 | sub _fill_snippet( $self, $snippet ) { | 
|  | 0 |  |  |  |  | 0 |  | 
|  | 0 |  |  |  |  | 0 |  | 
|  | 0 |  |  |  |  | 0 |  | 
| 373 |  |  |  |  |  |  | # Doesn't parse parameters, yet | 
| 374 | 0 |  |  |  |  | 0 | $snippet =~ s!\$self->(\w+)!$self->$1!ge; | 
|  | 0 |  |  |  |  | 0 |  | 
| 375 | 0 |  |  |  |  | 0 | $snippet | 
| 376 |  |  |  |  |  |  | } | 
| 377 |  |  |  |  |  |  |  | 
| 378 | 27 |  |  | 27 |  | 66 | sub _init_cookie_jar_lwp( $self ) { | 
|  | 27 |  |  |  |  | 64 |  | 
|  | 27 |  |  |  |  | 53 |  | 
| 379 | 27 | 50 |  |  |  | 156 | if( my $fn = $self->cookie_jar ) { | 
| 380 | 0 | 0 |  |  |  | 0 | my $save = $self->cookie_jar_options->{'write'} ? 1 : 0; | 
| 381 |  |  |  |  |  |  | return { | 
| 382 | 0 |  |  |  |  | 0 | preamble => [ | 
| 383 |  |  |  |  |  |  | "use Path::Tiny;", | 
| 384 |  |  |  |  |  |  | "use HTTP::Cookies;", | 
| 385 |  |  |  |  |  |  | ], | 
| 386 |  |  |  |  |  |  | code => \"HTTP::Cookies->new(\n    file => path('$fn'),\n    autosave => $save,\n)", | 
| 387 |  |  |  |  |  |  | postamble => [ | 
| 388 |  |  |  |  |  |  | #"path('$fn')->spew(\$ua->cookie_jar->dump_cookies())", | 
| 389 |  |  |  |  |  |  | ], | 
| 390 |  |  |  |  |  |  | }; | 
| 391 |  |  |  |  |  |  | } | 
| 392 |  |  |  |  |  |  | } | 
| 393 |  |  |  |  |  |  |  | 
| 394 | 25 |  |  | 25 |  | 87 | sub _init_cookie_jar_tiny( $self ) { | 
|  | 25 |  |  |  |  | 73 |  | 
|  | 25 |  |  |  |  | 71 |  | 
| 395 | 25 | 50 |  |  |  | 2458 | if( my $fn = $self->cookie_jar ) { | 
| 396 | 0 |  |  |  |  | 0 | my $save = $self->cookie_jar_options->{'write'}; | 
| 397 |  |  |  |  |  |  | return { | 
| 398 | 0 | 0 |  |  |  | 0 | preamble => [ | 
| 399 |  |  |  |  |  |  | "use Path::Tiny;", | 
| 400 |  |  |  |  |  |  | "use HTTP::CookieJar;", | 
| 401 |  |  |  |  |  |  | ], | 
| 402 |  |  |  |  |  |  | code => \"HTTP::CookieJar->new->load_cookies(path('$fn')->lines),", | 
| 403 |  |  |  |  |  |  | postamble => [ | 
| 404 |  |  |  |  |  |  | $save ? | 
| 405 |  |  |  |  |  |  | ("path('$fn')->spew(\$ua->cookie_jar->dump_cookies())") | 
| 406 |  |  |  |  |  |  | : (), | 
| 407 |  |  |  |  |  |  | ], | 
| 408 |  |  |  |  |  |  | }; | 
| 409 |  |  |  |  |  |  | } | 
| 410 |  |  |  |  |  |  | } | 
| 411 |  |  |  |  |  |  |  | 
| 412 | 0 |  |  | 0 |  | 0 | sub _init_cookie_jar_mojolicious( $self ) { | 
|  | 0 |  |  |  |  | 0 |  | 
|  | 0 |  |  |  |  | 0 |  | 
| 413 | 0 | 0 |  |  |  | 0 | if( my $fn = $self->cookie_jar ) { | 
| 414 | 0 |  |  |  |  | 0 | my $save = $self->cookie_jar_options->{'write'}; | 
| 415 |  |  |  |  |  |  | return { | 
| 416 | 0 |  |  |  |  | 0 | preamble => [ | 
| 417 |  |  |  |  |  |  | #    "use Path::Tiny;", | 
| 418 |  |  |  |  |  |  | "use Mojo::UserAgent::CookieJar;", | 
| 419 |  |  |  |  |  |  | ], | 
| 420 |  |  |  |  |  |  | code => \"Mojo::UserAgent::CookieJar->new,", | 
| 421 |  |  |  |  |  |  | postamble => [ | 
| 422 |  |  |  |  |  |  | #$save ? | 
| 423 |  |  |  |  |  |  | #      ("path('$fn')->spew(\$ua->cookie_jar->dump_cookies())") | 
| 424 |  |  |  |  |  |  | #    : (), | 
| 425 |  |  |  |  |  |  | ], | 
| 426 |  |  |  |  |  |  | }; | 
| 427 |  |  |  |  |  |  | } | 
| 428 |  |  |  |  |  |  | } | 
| 429 |  |  |  |  |  |  |  | 
| 430 | 176 |  |  | 176 |  | 5776 | sub _pairlist( $self, $l, $prefix = "    " ) { | 
|  | 176 |  |  |  |  | 366 |  | 
|  | 176 |  |  |  |  | 420 |  | 
|  | 176 |  |  |  |  | 1314 |  | 
|  | 176 |  |  |  |  | 337 |  | 
| 431 |  |  |  |  |  |  | return join ",\n", | 
| 432 |  |  |  |  |  |  | pairmap { my $v = ! ref $b ? qq{'$b'} | 
| 433 |  |  |  |  |  |  | : ref $b eq 'SCALAR' ? $$b | 
| 434 | 0 |  |  |  |  | 0 | : ref $b eq 'ARRAY'  ? '[' . join( ", ", map {qq{'$_'}} @$b ) . ']' | 
| 435 | 335 | 50 |  | 335 |  | 1355 | : ref $b eq 'HASH'   ? '{' . $self->_pairlist([ map { $_ => $b->{$_} } sort keys %$b ]) . '}' | 
|  | 60 | 50 |  |  |  | 288 |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
| 436 |  |  |  |  |  |  | : die "Unknown type of $b"; | 
| 437 | 335 |  |  |  |  | 2355 | qq{$prefix'$a' => $v} | 
| 438 | 176 |  |  |  |  | 4063 | } @$l | 
| 439 |  |  |  |  |  |  | } | 
| 440 |  |  |  |  |  |  |  | 
| 441 | 27 |  |  | 27 |  | 83 | sub _build_lwp_headers( $self, $prefix = "    ", %options ) { | 
|  | 27 |  |  |  |  | 60 |  | 
|  | 27 |  |  |  |  | 78 |  | 
|  | 27 |  |  |  |  | 118 |  | 
|  | 27 |  |  |  |  | 71 |  | 
| 442 |  |  |  |  |  |  | # This is so we create the standard header order in our output | 
| 443 | 27 |  |  |  |  | 111 | my @h = $self->_explode_headers; | 
| 444 | 27 |  |  |  |  | 276 | my $h = HTTP::Headers->new( @h ); | 
| 445 | 27 |  |  |  |  | 5024 | $h->remove_header( @{$options{implicit_headers}} ); | 
|  | 27 |  |  |  |  | 247 |  | 
| 446 |  |  |  |  |  |  |  | 
| 447 |  |  |  |  |  |  | # also skip the Host: header if it derives from $uri | 
| 448 | 27 |  |  |  |  | 548 | my $val = $h->header('Host'); | 
| 449 | 27 | 100 | 66 |  |  | 1663 | if( $val and ($val eq $self->uri->host_port | 
|  |  |  | 66 |  |  |  |  | 
| 450 |  |  |  |  |  |  | or $val eq $self->uri->host   )) { | 
| 451 |  |  |  |  |  |  | # trivial host header | 
| 452 | 20 |  |  |  |  | 878 | $h->remove_header('Host'); | 
| 453 |  |  |  |  |  |  | }; | 
| 454 |  |  |  |  |  |  |  | 
| 455 | 27 |  |  |  |  | 997 | $self->_pairlist([ $h->flatten ], $prefix); | 
| 456 |  |  |  |  |  |  | } | 
| 457 |  |  |  |  |  |  |  | 
| 458 | 25 |  |  | 25 |  | 86 | sub _build_tiny_headers( $self, $prefix = "    ", %options ) { | 
|  | 25 |  |  |  |  | 55 |  | 
|  | 25 |  |  |  |  | 147 |  | 
|  | 25 |  |  |  |  | 105 |  | 
|  | 25 |  |  |  |  | 61 |  | 
| 459 | 25 |  |  |  |  | 176 | my @h = $self->_explode_headers; | 
| 460 | 25 |  |  |  |  | 385 | my $h = HTTP::Headers->new( @h ); | 
| 461 | 25 |  |  |  |  | 5477 | $h->remove_header( @{$options{implicit_headers}} ); | 
|  | 25 |  |  |  |  | 209 |  | 
| 462 |  |  |  |  |  |  |  | 
| 463 |  |  |  |  |  |  | # HTTP::Tiny does not like overriding the Host: header :-/ | 
| 464 | 25 |  |  |  |  | 829 | $h->remove_header('Host'); | 
| 465 |  |  |  |  |  |  |  | 
| 466 | 25 |  |  |  |  | 756 | @h = $h->flatten; | 
| 467 | 25 |  |  |  |  | 5545 | my %h; | 
| 468 |  |  |  |  |  |  | my @order; | 
| 469 | 25 |  |  |  |  | 144 | while( @h ) { | 
| 470 | 106 |  |  |  |  | 318 | my ($k,$v) = splice(@h,0,2); | 
| 471 | 106 | 50 |  |  |  | 300 | if( ! exists $h{ $k }) { | 
|  |  | 0 |  |  |  |  |  | 
| 472 |  |  |  |  |  |  | # Fresh value | 
| 473 | 106 |  |  |  |  | 269 | $h{ $k } = $v; | 
| 474 | 106 |  |  |  |  | 331 | push @order, $k; | 
| 475 |  |  |  |  |  |  | } elsif( ! ref $h{$k}) { | 
| 476 |  |  |  |  |  |  | # Second value | 
| 477 | 0 |  |  |  |  | 0 | $h{ $k } = [$h{$k}, $v]; | 
| 478 |  |  |  |  |  |  | } else { | 
| 479 |  |  |  |  |  |  | # Multiple values | 
| 480 | 0 |  |  |  |  | 0 | push @{$h{ $k }}, $v; | 
|  | 0 |  |  |  |  | 0 |  | 
| 481 |  |  |  |  |  |  | } | 
| 482 |  |  |  |  |  |  | }; | 
| 483 |  |  |  |  |  |  |  | 
| 484 | 25 |  |  |  |  | 144 | $self->_pairlist([ map { $_ => $h{ $_ } } @order ], $prefix); | 
|  | 106 |  |  |  |  | 343 |  | 
| 485 |  |  |  |  |  |  | } | 
| 486 |  |  |  |  |  |  |  | 
| 487 | 0 |  |  | 0 |  | 0 | sub _build_mojolicious_headers( $self, $prefix = "    ", %options ) { | 
|  | 0 |  |  |  |  | 0 |  | 
|  | 0 |  |  |  |  | 0 |  | 
|  | 0 |  |  |  |  | 0 |  | 
|  | 0 |  |  |  |  | 0 |  | 
| 488 |  |  |  |  |  |  | # This is so we create the standard header order in our output | 
| 489 | 0 |  |  |  |  | 0 | my @h = $self->_explode_headers; | 
| 490 | 0 |  |  |  |  | 0 | my $h = HTTP::Headers->new( @h ); | 
| 491 | 0 |  |  |  |  | 0 | $h->remove_header( @{$options{implicit_headers}} ); | 
|  | 0 |  |  |  |  | 0 |  | 
| 492 |  |  |  |  |  |  |  | 
| 493 |  |  |  |  |  |  | # also skip the Host: header if it derives from $uri | 
| 494 | 0 |  |  |  |  | 0 | my $val = $h->header('Host'); | 
| 495 | 0 | 0 | 0 |  |  | 0 | if( $val and ($val eq $self->uri->host_port | 
|  |  |  | 0 |  |  |  |  | 
| 496 |  |  |  |  |  |  | or $val eq $self->uri->host   )) { | 
| 497 |  |  |  |  |  |  | # trivial host header | 
| 498 | 0 |  |  |  |  | 0 | $h->remove_header('Host'); | 
| 499 |  |  |  |  |  |  | }; | 
| 500 |  |  |  |  |  |  |  | 
| 501 | 0 |  |  |  |  | 0 | @h = $h->flatten; | 
| 502 | 0 |  |  |  |  | 0 | my %h; | 
| 503 |  |  |  |  |  |  | my @order; | 
| 504 | 0 |  |  |  |  | 0 | while( @h ) { | 
| 505 | 0 |  |  |  |  | 0 | my ($k,$v) = splice(@h,0,2); | 
| 506 | 0 | 0 |  |  |  | 0 | if( ! exists $h{ $k }) { | 
|  |  | 0 |  |  |  |  |  | 
| 507 |  |  |  |  |  |  | # Fresh value | 
| 508 | 0 |  |  |  |  | 0 | $h{ $k } = $v; | 
| 509 | 0 |  |  |  |  | 0 | push @order, $k; | 
| 510 |  |  |  |  |  |  | } elsif( ! ref $h{$k}) { | 
| 511 |  |  |  |  |  |  | # Second value | 
| 512 | 0 |  |  |  |  | 0 | $h{ $k } = [$h{$k}, $v]; | 
| 513 |  |  |  |  |  |  | } else { | 
| 514 |  |  |  |  |  |  | # Multiple values | 
| 515 | 0 |  |  |  |  | 0 | push @{$h{ $k }}, $v; | 
|  | 0 |  |  |  |  | 0 |  | 
| 516 |  |  |  |  |  |  | } | 
| 517 |  |  |  |  |  |  | }; | 
| 518 |  |  |  |  |  |  |  | 
| 519 | 0 |  |  |  |  | 0 | $self->_pairlist([ map { $_ => $h{ $_ } } @order ], $prefix); | 
|  | 0 |  |  |  |  | 0 |  | 
| 520 |  |  |  |  |  |  | } | 
| 521 |  |  |  |  |  |  |  | 
| 522 |  |  |  |  |  |  | =head2 C<< $r->as_snippet( %options ) >> | 
| 523 |  |  |  |  |  |  |  | 
| 524 |  |  |  |  |  |  | print $r->as_snippet( type => 'LWP' ); | 
| 525 |  |  |  |  |  |  |  | 
| 526 |  |  |  |  |  |  | Returns a code snippet that returns code to create an equivalent | 
| 527 |  |  |  |  |  |  | L object and to perform the request using L. | 
| 528 |  |  |  |  |  |  |  | 
| 529 |  |  |  |  |  |  | This is mostly intended as a convenience function for creating Perl demo | 
| 530 |  |  |  |  |  |  | snippets from C examples. | 
| 531 |  |  |  |  |  |  |  | 
| 532 |  |  |  |  |  |  | =head3 Options | 
| 533 |  |  |  |  |  |  |  | 
| 534 |  |  |  |  |  |  | =over 4 | 
| 535 |  |  |  |  |  |  |  | 
| 536 |  |  |  |  |  |  | =item B | 
| 537 |  |  |  |  |  |  |  | 
| 538 |  |  |  |  |  |  | Arrayref of headers that will not be output. | 
| 539 |  |  |  |  |  |  |  | 
| 540 |  |  |  |  |  |  | Convenient values are ['Content-Length'] | 
| 541 |  |  |  |  |  |  |  | 
| 542 |  |  |  |  |  |  | =item B | 
| 543 |  |  |  |  |  |  |  | 
| 544 |  |  |  |  |  |  | type => 'Tiny', | 
| 545 |  |  |  |  |  |  |  | 
| 546 |  |  |  |  |  |  | Type of snippet. Valid values are C for L, | 
| 547 |  |  |  |  |  |  | C for L | 
| 548 |  |  |  |  |  |  | and C for L. | 
| 549 |  |  |  |  |  |  |  | 
| 550 |  |  |  |  |  |  | =back | 
| 551 |  |  |  |  |  |  |  | 
| 552 |  |  |  |  |  |  | =cut | 
| 553 |  |  |  |  |  |  |  | 
| 554 | 52 |  |  | 52 | 1 | 4357078 | sub as_snippet( $self, %options ) { | 
|  | 52 |  |  |  |  | 257 |  | 
|  | 52 |  |  |  |  | 687 |  | 
|  | 52 |  |  |  |  | 160 |  | 
| 555 | 52 |  | 100 |  |  | 390 | my $type = delete $options{ type } || 'LWP'; | 
| 556 | 52 | 100 |  |  |  | 387 | if( 'LWP' eq $type ) { | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 557 | 27 |  |  |  |  | 274 | $self->as_lwp_snippet( %options ) | 
| 558 |  |  |  |  |  |  | } elsif( 'Tiny' eq $type ) { | 
| 559 | 25 |  |  |  |  | 298 | $self->as_http_tiny_snippet( %options ) | 
| 560 |  |  |  |  |  |  | } elsif( 'Mojolicious' eq $type ) { | 
| 561 | 0 |  |  |  |  | 0 | $self->as_mojolicious_snippet( %options ) | 
| 562 |  |  |  |  |  |  | } else { | 
| 563 | 0 |  |  |  |  | 0 | croak "Unknown type '$type'."; | 
| 564 |  |  |  |  |  |  | } | 
| 565 |  |  |  |  |  |  | } | 
| 566 |  |  |  |  |  |  |  | 
| 567 | 27 |  |  | 27 | 0 | 84 | sub as_lwp_snippet( $self, %options ) { | 
|  | 27 |  |  |  |  | 106 |  | 
|  | 27 |  |  |  |  | 126 |  | 
|  | 27 |  |  |  |  | 71 |  | 
| 568 | 27 |  | 50 |  |  | 515 | $options{ prefix } ||= ''; | 
| 569 | 27 |  | 100 |  |  | 381 | $options{ implicit_headers } ||= []; | 
| 570 |  |  |  |  |  |  |  | 
| 571 | 27 |  |  |  |  | 149 | my @preamble; | 
| 572 |  |  |  |  |  |  | my @postamble; | 
| 573 | 27 |  |  |  |  | 0 | my %ssl_options; | 
| 574 | 27 | 100 |  |  |  | 131 | push @preamble, @{ $options{ preamble } } if $options{ preamble }; | 
|  | 25 |  |  |  |  | 151 |  | 
| 575 | 27 | 50 |  |  |  | 145 | push @postamble, @{ $options{ postamble } } if $options{ postamble }; | 
|  | 0 |  |  |  |  | 0 |  | 
| 576 | 27 |  |  |  |  | 155 | my @setup_ua = (''); | 
| 577 |  |  |  |  |  |  |  | 
| 578 | 27 |  |  |  |  | 354 | my $request_args = join ", ", | 
| 579 |  |  |  |  |  |  | '$r', | 
| 580 |  |  |  |  |  |  | $self->_pairlist([ | 
| 581 |  |  |  |  |  |  | maybe ':content_file', $self->output | 
| 582 |  |  |  |  |  |  | ], '') | 
| 583 |  |  |  |  |  |  | ; | 
| 584 | 27 |  |  |  |  | 517 | my $init_cookie_jar = $self->_init_cookie_jar_lwp(); | 
| 585 | 27 | 50 |  |  |  | 143 | if( my $p = $init_cookie_jar->{preamble}) { | 
| 586 | 0 |  |  |  |  | 0 | push @preamble, @{$p} | 
|  | 0 |  |  |  |  | 0 |  | 
| 587 |  |  |  |  |  |  | }; | 
| 588 |  |  |  |  |  |  |  | 
| 589 | 27 | 100 |  |  |  | 135 | if( $self->insecure ) { | 
| 590 | 20 |  |  |  |  | 66 | push @preamble, 'use IO::Socket::SSL;'; | 
| 591 | 20 |  |  |  |  | 172 | $ssl_options{ SSL_verify_mode } = \'IO::Socket::SSL::SSL_VERIFY_NONE'; | 
| 592 | 20 |  |  |  |  | 122 | $ssl_options{ SSL_hostname    } = ''; | 
| 593 | 20 |  |  |  |  | 93 | $ssl_options{ verify_hostname } = ''; | 
| 594 |  |  |  |  |  |  | }; | 
| 595 |  |  |  |  |  |  |  | 
| 596 | 27 | 50 |  |  |  | 136 | if( $self->cert ) { | 
| 597 | 0 |  |  |  |  | 0 | push @preamble, 'use IO::Socket::SSL;'; | 
| 598 | 0 |  |  |  |  | 0 | $ssl_options{ SSL_ca_file } = $self->cert; | 
| 599 |  |  |  |  |  |  | }; | 
| 600 | 27 | 50 |  |  |  | 130 | if( $self->capath ) { | 
| 601 | 0 |  |  |  |  | 0 | push @preamble, 'use IO::Socket::SSL;'; | 
| 602 | 0 |  |  |  |  | 0 | $ssl_options{ SSL_ca_path } = $self->capath; | 
| 603 |  |  |  |  |  |  | }; | 
| 604 |  |  |  |  |  |  | my $constructor_args = join ",", | 
| 605 |  |  |  |  |  |  | $self->_pairlist([ | 
| 606 |  |  |  |  |  |  | send_te => 0, | 
| 607 |  |  |  |  |  |  | maybe local_address => $self->local_address, | 
| 608 |  |  |  |  |  |  | maybe timeout       => $self->timeout, | 
| 609 |  |  |  |  |  |  | maybe cookie_jar    => $init_cookie_jar->{code}, | 
| 610 | 27 | 100 |  |  |  | 601 | maybe SSL_options   => keys %ssl_options ? \%ssl_options : undef, | 
| 611 |  |  |  |  |  |  | ], '') | 
| 612 |  |  |  |  |  |  | ; | 
| 613 | 27 | 50 |  |  |  | 320 | if( defined( my $credentials = $self->credentials )) { | 
| 614 | 0 |  |  |  |  | 0 | my( $user, $pass ) = split /:/, $credentials, 2; | 
| 615 | 0 |  |  |  |  | 0 | my $setup_credentials = sprintf qq{\$ua->credentials("%s","%s");}, | 
| 616 |  |  |  |  |  |  | quotemeta $user, | 
| 617 |  |  |  |  |  |  | quotemeta $pass; | 
| 618 | 0 |  |  |  |  | 0 | push @setup_ua, $setup_credentials; | 
| 619 |  |  |  |  |  |  | }; | 
| 620 | 27 | 50 |  |  |  | 200 | if( $self->show_error ) { | 
|  |  | 50 |  |  |  |  |  | 
| 621 | 0 |  |  |  |  | 0 | push @postamble, | 
| 622 |  |  |  |  |  |  | '    die $res->message if $res->is_error;', | 
| 623 |  |  |  |  |  |  | } elsif( $self->fail ) { | 
| 624 | 0 |  |  |  |  | 0 | push @postamble, | 
| 625 |  |  |  |  |  |  | '    exit 1 if !$res->{success};', | 
| 626 |  |  |  |  |  |  | }; | 
| 627 |  |  |  |  |  |  |  | 
| 628 | 27 | 50 |  |  |  | 125 | @setup_ua = () | 
| 629 |  |  |  |  |  |  | if @setup_ua == 1; | 
| 630 |  |  |  |  |  |  |  | 
| 631 | 27 |  |  |  |  | 67 | my $request_constructor; | 
| 632 |  |  |  |  |  |  |  | 
| 633 | 27 | 50 | 66 |  |  | 175 | if( $self->method ne 'GET' and @{ $self->form_args }) { | 
|  | 5 |  |  |  |  | 211 |  | 
| 634 | 0 |  |  |  |  | 0 | push @preamble, 'use HTTP::Request::Common;'; | 
| 635 | 0 |  |  |  |  | 0 | $request_constructor = < | 
| 636 | 0 |  |  |  |  | 0 | my \$r = HTTP::Request::Common::@{[$self->method]}( | 
| 637 | 0 |  |  |  |  | 0 | '@{[$self->uri]}', | 
| 638 |  |  |  |  |  |  | Content_Type => 'form-data', | 
| 639 |  |  |  |  |  |  | Content => [ | 
| 640 | 0 |  |  |  |  | 0 | @{[$self->_pairlist($self->form_args, '            ')]} | 
| 641 |  |  |  |  |  |  | ], | 
| 642 | 0 |  |  |  |  | 0 | @{[$self->_build_lwp_headers('            ', %options)]} | 
| 643 |  |  |  |  |  |  | ); | 
| 644 |  |  |  |  |  |  | SNIPPET | 
| 645 |  |  |  |  |  |  | } else { | 
| 646 | 27 |  |  |  |  | 127 | $request_constructor = < | 
| 647 |  |  |  |  |  |  | my \$r = HTTP::Request->new( | 
| 648 | 27 |  |  |  |  | 357 | '@{[$self->method]}' => '@{[$self->uri]}', | 
|  | 27 |  |  |  |  | 297 |  | 
| 649 |  |  |  |  |  |  | [ | 
| 650 | 27 |  |  |  |  | 329 | @{[$self->_build_lwp_headers('            ', %options)]} | 
| 651 |  |  |  |  |  |  | ], | 
| 652 | 27 |  |  |  |  | 186 | @{[$self->_build_quoted_body()]} | 
| 653 |  |  |  |  |  |  | ); | 
| 654 |  |  |  |  |  |  | SNIPPET | 
| 655 |  |  |  |  |  |  | } | 
| 656 |  |  |  |  |  |  |  | 
| 657 | 27 |  |  |  |  | 129 | @preamble = map { "$options{prefix}    $_\n" } @preamble; | 
|  | 70 |  |  |  |  | 299 |  | 
| 658 | 27 |  |  |  |  | 87 | @postamble = map { "$options{prefix}    $_\n" } @postamble; | 
|  | 0 |  |  |  |  | 0 |  | 
| 659 | 27 |  |  |  |  | 87 | @setup_ua = map { "$options{prefix}    $_\n" } @setup_ua; | 
|  | 0 |  |  |  |  | 0 |  | 
| 660 |  |  |  |  |  |  |  | 
| 661 | 27 |  |  |  |  | 406 | return < | 
| 662 |  |  |  |  |  |  | @preamble | 
| 663 |  |  |  |  |  |  | my \$ua = LWP::UserAgent->new($constructor_args);@setup_ua | 
| 664 |  |  |  |  |  |  | $request_constructor | 
| 665 |  |  |  |  |  |  | my \$res = \$ua->request( $request_args ); | 
| 666 |  |  |  |  |  |  | @postamble | 
| 667 |  |  |  |  |  |  | SNIPPET | 
| 668 |  |  |  |  |  |  | }; | 
| 669 |  |  |  |  |  |  |  | 
| 670 | 25 |  |  | 25 | 0 | 110 | sub as_http_tiny_snippet( $self, %options ) { | 
|  | 25 |  |  |  |  | 99 |  | 
|  | 25 |  |  |  |  | 118 |  | 
|  | 25 |  |  |  |  | 56 |  | 
| 671 | 25 |  | 50 |  |  | 518 | $options{ prefix } ||= ''; | 
| 672 | 25 |  | 50 |  |  | 409 | $options{ implicit_headers } ||= []; | 
| 673 |  |  |  |  |  |  |  | 
| 674 | 25 |  |  |  |  | 98 | push @{ $options{ implicit_headers }}, 'Host'; # HTTP::Tiny dislikes that header | 
|  | 25 |  |  |  |  | 186 |  | 
| 675 |  |  |  |  |  |  |  | 
| 676 | 25 |  |  |  |  | 126 | my @preamble; | 
| 677 |  |  |  |  |  |  | my @postamble; | 
| 678 | 25 |  |  |  |  | 0 | my %ssl_options; | 
| 679 | 25 | 50 |  |  |  | 196 | push @preamble, @{ $options{ preamble } } if $options{ preamble }; | 
|  | 25 |  |  |  |  | 148 |  | 
| 680 | 25 | 50 |  |  |  | 129 | push @postamble, @{ $options{ postamble } } if $options{ postamble }; | 
|  | 0 |  |  |  |  | 0 |  | 
| 681 | 25 |  |  |  |  | 129 | my @setup_ua = (''); | 
| 682 |  |  |  |  |  |  |  | 
| 683 | 25 |  |  |  |  | 459 | my $request_args = join ", ", | 
| 684 |  |  |  |  |  |  | '$r', | 
| 685 |  |  |  |  |  |  | $self->_pairlist([ | 
| 686 |  |  |  |  |  |  | maybe ':content_file', $self->output | 
| 687 |  |  |  |  |  |  | ], '') | 
| 688 |  |  |  |  |  |  | ; | 
| 689 | 25 |  |  |  |  | 505 | my $init_cookie_jar = $self->_init_cookie_jar_tiny(); | 
| 690 | 25 | 50 |  |  |  | 124 | if( my $p = $init_cookie_jar->{preamble}) { | 
| 691 | 0 |  |  |  |  | 0 | push @preamble, @{$p} | 
|  | 0 |  |  |  |  | 0 |  | 
| 692 |  |  |  |  |  |  | }; | 
| 693 |  |  |  |  |  |  |  | 
| 694 | 25 |  |  |  |  | 69 | my @ssl; | 
| 695 | 25 | 100 |  |  |  | 175 | if( $self->insecure ) { | 
| 696 |  |  |  |  |  |  | } else { | 
| 697 | 5 |  |  |  |  | 41 | push @ssl, verify_SSL => 1; | 
| 698 |  |  |  |  |  |  | }; | 
| 699 | 25 | 50 |  |  |  | 191 | if( $self->cert ) { | 
| 700 | 0 |  |  |  |  | 0 | push @preamble, 'use IO::Socket::SSL;'; | 
| 701 | 0 |  |  |  |  | 0 | $ssl_options{ SSL_ca_file } = $self->cert; | 
| 702 |  |  |  |  |  |  | }; | 
| 703 | 25 | 50 |  |  |  | 254 | if( $self->show_error ) { | 
|  |  | 50 |  |  |  |  |  | 
| 704 | 0 |  |  |  |  | 0 | push @postamble, | 
| 705 |  |  |  |  |  |  | '    die $res->{reason} if !$res->{success};', | 
| 706 |  |  |  |  |  |  | } elsif( $self->fail ) { | 
| 707 | 0 |  |  |  |  | 0 | push @postamble, | 
| 708 |  |  |  |  |  |  | '    exit 1 if !$res->{success};', | 
| 709 |  |  |  |  |  |  | }; | 
| 710 |  |  |  |  |  |  | my $constructor_args = join ",", | 
| 711 |  |  |  |  |  |  | $self->_pairlist([ | 
| 712 |  |  |  |  |  |  | @ssl, | 
| 713 |  |  |  |  |  |  | maybe timeout       => $self->timeout, | 
| 714 |  |  |  |  |  |  | maybe local_address => $self->local_address, | 
| 715 |  |  |  |  |  |  | maybe cookie_jar    => $init_cookie_jar->{code}, | 
| 716 | 25 | 50 |  |  |  | 638 | maybe SSL_options   => keys %ssl_options ? \%ssl_options : undef, | 
| 717 |  |  |  |  |  |  | ], '') | 
| 718 |  |  |  |  |  |  | ; | 
| 719 | 25 | 50 |  |  |  | 437 | if( defined( my $credentials = $self->credentials )) { | 
| 720 | 0 |  |  |  |  | 0 | my( $user, $pass ) = split /:/, $credentials, 2; | 
| 721 | 0 |  |  |  |  | 0 | my $setup_credentials = sprintf qq{\$ua->credentials("%s","%s");}, | 
| 722 |  |  |  |  |  |  | quotemeta $user, | 
| 723 |  |  |  |  |  |  | quotemeta $pass; | 
| 724 | 0 |  |  |  |  | 0 | push @setup_ua, $setup_credentials; | 
| 725 |  |  |  |  |  |  | }; | 
| 726 |  |  |  |  |  |  |  | 
| 727 | 25 | 50 |  |  |  | 191 | @setup_ua = () | 
| 728 |  |  |  |  |  |  | if @setup_ua == 1; | 
| 729 |  |  |  |  |  |  |  | 
| 730 | 25 |  |  |  |  | 96 | @preamble = map { "$options{prefix}    $_\n" } @preamble; | 
|  | 50 |  |  |  |  | 283 |  | 
| 731 | 25 |  |  |  |  | 103 | @postamble = map { "$options{prefix}    $_\n" } @postamble; | 
|  | 0 |  |  |  |  | 0 |  | 
| 732 | 25 |  |  |  |  | 78 | @setup_ua = map { "$options{prefix}    $_\n" } @setup_ua; | 
|  | 0 |  |  |  |  | 0 |  | 
| 733 |  |  |  |  |  |  |  | 
| 734 | 25 |  |  |  |  | 399 | my @content = $self->_build_quoted_body(); | 
| 735 | 25 | 100 |  |  |  | 85 | if( grep {/\S/} @content ) { | 
|  | 25 | 50 |  |  |  | 184 |  | 
| 736 | 3 |  |  |  |  | 44 | unshift @content, 'content => ', | 
| 737 | 22 |  |  |  |  | 190 | } elsif( @{ $self->form_args }) { | 
| 738 | 0 |  |  |  |  | 0 | my $req = HTTP::Request::Common::POST( | 
| 739 |  |  |  |  |  |  | 'https://example.com', | 
| 740 |  |  |  |  |  |  | Content_Type => 'form-data', | 
| 741 |  |  |  |  |  |  | Content => $self->form_args, | 
| 742 |  |  |  |  |  |  | ); | 
| 743 | 0 |  |  |  |  | 0 | @content = ('content => ', $self->_build_quoted_body( $req->content )); | 
| 744 | 0 |  |  |  |  | 0 | $self->headers->{ 'Content-Type' } = join "; ", $req->headers->content_type; | 
| 745 |  |  |  |  |  |  | } | 
| 746 |  |  |  |  |  |  |  | 
| 747 | 25 |  |  |  |  | 266 | return < | 
| 748 |  |  |  |  |  |  | @preamble | 
| 749 |  |  |  |  |  |  | my \$ua = HTTP::Tiny->new($constructor_args);@setup_ua | 
| 750 |  |  |  |  |  |  | my \$res = \$ua->request( | 
| 751 | 25 |  |  |  |  | 322 | '@{[$self->method]}' => '@{[$self->uri]}', | 
|  | 25 |  |  |  |  | 240 |  | 
| 752 |  |  |  |  |  |  | { | 
| 753 |  |  |  |  |  |  | headers => { | 
| 754 | 25 |  |  |  |  | 329 | @{[$self->_build_tiny_headers('            ', %options)]} | 
| 755 |  |  |  |  |  |  | }, | 
| 756 |  |  |  |  |  |  | @content | 
| 757 |  |  |  |  |  |  | }, | 
| 758 |  |  |  |  |  |  | ); | 
| 759 |  |  |  |  |  |  | @postamble | 
| 760 |  |  |  |  |  |  | SNIPPET | 
| 761 |  |  |  |  |  |  | }; | 
| 762 |  |  |  |  |  |  |  | 
| 763 | 0 |  |  | 0 | 0 | 0 | sub as_mojolicious_snippet( $self, %options ) { | 
|  | 0 |  |  |  |  | 0 |  | 
|  | 0 |  |  |  |  | 0 |  | 
|  | 0 |  |  |  |  | 0 |  | 
| 764 | 0 |  | 0 |  |  | 0 | $options{ prefix } ||= ''; | 
| 765 | 0 |  | 0 |  |  | 0 | $options{ implicit_headers } ||= []; | 
| 766 |  |  |  |  |  |  |  | 
| 767 | 0 |  |  |  |  | 0 | my @preamble; | 
| 768 |  |  |  |  |  |  | my @postamble; | 
| 769 | 0 |  |  |  |  | 0 | my %ssl_options; | 
| 770 | 0 | 0 |  |  |  | 0 | push @preamble, @{ $options{ preamble } } if $options{ preamble }; | 
|  | 0 |  |  |  |  | 0 |  | 
| 771 | 0 | 0 |  |  |  | 0 | push @postamble, @{ $options{ postamble } } if $options{ postamble }; | 
|  | 0 |  |  |  |  | 0 |  | 
| 772 | 0 |  |  |  |  | 0 | my @setup_ua = (''); | 
| 773 |  |  |  |  |  |  |  | 
| 774 | 0 |  |  |  |  | 0 | my $request_args = join ", ", | 
| 775 |  |  |  |  |  |  | '$r', | 
| 776 |  |  |  |  |  |  | $self->_pairlist([ | 
| 777 |  |  |  |  |  |  | maybe ':content_file', $self->output | 
| 778 |  |  |  |  |  |  | ], '') | 
| 779 |  |  |  |  |  |  | ; | 
| 780 | 0 |  |  |  |  | 0 | my $init_cookie_jar = $self->_init_cookie_jar_mojolicious(); | 
| 781 | 0 | 0 |  |  |  | 0 | if( my $p = $init_cookie_jar->{preamble}) { | 
| 782 | 0 |  |  |  |  | 0 | push @preamble, @{$p} | 
|  | 0 |  |  |  |  | 0 |  | 
| 783 |  |  |  |  |  |  | }; | 
| 784 |  |  |  |  |  |  |  | 
| 785 | 0 |  |  |  |  | 0 | my @ssl; | 
| 786 | 0 | 0 |  |  |  | 0 | if( $self->insecure ) { | 
| 787 | 0 |  |  |  |  | 0 | push @ssl, insecure => 1, | 
| 788 |  |  |  |  |  |  | }; | 
| 789 | 0 | 0 |  |  |  | 0 | if( $self->cert ) { | 
| 790 | 0 |  |  |  |  | 0 | push @ssl, cert => $self->cert, | 
| 791 |  |  |  |  |  |  | }; | 
| 792 | 0 | 0 |  |  |  | 0 | if( $self->show_error ) { | 
|  |  | 0 |  |  |  |  |  | 
| 793 | 0 |  |  |  |  | 0 | push @postamble, | 
| 794 |  |  |  |  |  |  | '    die $res->message if $res->is_error;', | 
| 795 |  |  |  |  |  |  | } elsif( $self->fail ) { | 
| 796 | 0 |  |  |  |  | 0 | push @postamble, | 
| 797 |  |  |  |  |  |  | '    exit 1 if !$res->is_error;', | 
| 798 |  |  |  |  |  |  | }; | 
| 799 | 0 |  |  |  |  | 0 | my $socket_options = {}; | 
| 800 | 0 | 0 |  |  |  | 0 | if( my $host = $self->local_address ) { | 
| 801 | 0 |  |  |  |  | 0 | $socket_options->{ LocalAddr } = $host; | 
| 802 |  |  |  |  |  |  | } | 
| 803 |  |  |  |  |  |  | my $constructor_args = join ",", | 
| 804 |  |  |  |  |  |  | $self->_pairlist([ | 
| 805 |  |  |  |  |  |  | @ssl, | 
| 806 |  |  |  |  |  |  | keys %$socket_options ? $socket_options : (), | 
| 807 |  |  |  |  |  |  | maybe request_timeout    => $self->timeout, | 
| 808 |  |  |  |  |  |  | maybe local_address => $self->local_address, | 
| 809 |  |  |  |  |  |  | maybe cookie_jar    => $init_cookie_jar->{code}, | 
| 810 | 0 | 0 |  |  |  | 0 | maybe SSL_options   => keys %ssl_options ? \%ssl_options : undef, | 
|  |  | 0 |  |  |  |  |  | 
| 811 |  |  |  |  |  |  | ], '') | 
| 812 |  |  |  |  |  |  | ; | 
| 813 | 0 | 0 |  |  |  | 0 | if( defined( my $credentials = $self->credentials )) { | 
| 814 | 0 |  |  |  |  | 0 | my( $user, $pass ) = split /:/, $credentials, 2; | 
| 815 | 0 |  |  |  |  | 0 | my $setup_credentials = sprintf qq{\$ua->userinfo("%s","%s");}, | 
| 816 |  |  |  |  |  |  | quotemeta $user, | 
| 817 |  |  |  |  |  |  | quotemeta $pass; | 
| 818 | 0 |  |  |  |  | 0 | push @setup_ua, $setup_credentials; | 
| 819 |  |  |  |  |  |  | }; | 
| 820 |  |  |  |  |  |  |  | 
| 821 | 0 | 0 |  |  |  | 0 | @setup_ua = () | 
| 822 |  |  |  |  |  |  | if @setup_ua == 1; | 
| 823 |  |  |  |  |  |  |  | 
| 824 | 0 |  |  |  |  | 0 | @preamble = map { "$options{prefix}    $_\n" } @preamble; | 
|  | 0 |  |  |  |  | 0 |  | 
| 825 | 0 |  |  |  |  | 0 | @postamble = map { "$options{prefix}    $_\n" } @postamble; | 
|  | 0 |  |  |  |  | 0 |  | 
| 826 | 0 |  |  |  |  | 0 | @setup_ua = map { "$options{prefix}    $_\n" } @setup_ua; | 
|  | 0 |  |  |  |  | 0 |  | 
| 827 |  |  |  |  |  |  |  | 
| 828 | 0 |  |  |  |  | 0 | my $content = $self->_build_quoted_body(); | 
| 829 | 0 | 0 |  |  |  | 0 | if( @{ $self->form_args }) { | 
|  | 0 |  |  |  |  | 0 |  | 
| 830 | 0 |  |  |  |  | 0 | my $req = HTTP::Request::Common::POST( | 
| 831 |  |  |  |  |  |  | 'https://example.com', | 
| 832 |  |  |  |  |  |  | Content_Type => 'form-data', | 
| 833 |  |  |  |  |  |  | Content => $self->form_args, | 
| 834 |  |  |  |  |  |  | ); | 
| 835 | 0 |  | 0 |  |  | 0 | $content ||= $self->_build_quoted_body( $req->content ); | 
| 836 | 0 |  |  |  |  | 0 | $self->headers->{ 'Content-Type' } = join "; ", $req->headers->content_type; | 
| 837 |  |  |  |  |  |  | } | 
| 838 |  |  |  |  |  |  |  | 
| 839 | 0 |  |  |  |  | 0 | return < | 
| 840 |  |  |  |  |  |  | @preamble | 
| 841 |  |  |  |  |  |  | my \$ua = Mojo::UserAgent->new($constructor_args);@setup_ua | 
| 842 |  |  |  |  |  |  | my \$tx = \$ua->build_tx( | 
| 843 | 0 |  |  |  |  | 0 | '@{[$self->method]}' => '@{[$self->uri]}', | 
|  | 0 |  |  |  |  | 0 |  | 
| 844 |  |  |  |  |  |  | { | 
| 845 | 0 |  |  |  |  | 0 | @{[$self->_build_mojolicious_headers('            ', %options)]} | 
| 846 |  |  |  |  |  |  | }, | 
| 847 |  |  |  |  |  |  | $content | 
| 848 |  |  |  |  |  |  | ); | 
| 849 |  |  |  |  |  |  | my \$res = \$ua->start(\$tx)->result; | 
| 850 |  |  |  |  |  |  | @postamble | 
| 851 |  |  |  |  |  |  | SNIPPET | 
| 852 |  |  |  |  |  |  | }; | 
| 853 |  |  |  |  |  |  |  | 
| 854 |  |  |  |  |  |  | =head2 C<< $r->as_curl >> | 
| 855 |  |  |  |  |  |  |  | 
| 856 |  |  |  |  |  |  | print $r->as_curl; | 
| 857 |  |  |  |  |  |  |  | 
| 858 |  |  |  |  |  |  | Returns a curl command line representing the request | 
| 859 |  |  |  |  |  |  |  | 
| 860 |  |  |  |  |  |  | This is convenient if you started out from something else or want a canonical | 
| 861 |  |  |  |  |  |  | representation of a curl command line. | 
| 862 |  |  |  |  |  |  |  | 
| 863 |  |  |  |  |  |  | =over 4 | 
| 864 |  |  |  |  |  |  |  | 
| 865 |  |  |  |  |  |  | =item B | 
| 866 |  |  |  |  |  |  |  | 
| 867 |  |  |  |  |  |  | The curl command to be used. Default is C. | 
| 868 |  |  |  |  |  |  |  | 
| 869 |  |  |  |  |  |  | =back | 
| 870 |  |  |  |  |  |  |  | 
| 871 |  |  |  |  |  |  | =cut | 
| 872 |  |  |  |  |  |  |  | 
| 873 |  |  |  |  |  |  | # These are what curl uses as defaults, not what Perl should use as default! | 
| 874 |  |  |  |  |  |  | our %curl_header_defaults = ( | 
| 875 |  |  |  |  |  |  | 'Accept'          => '*/*', | 
| 876 |  |  |  |  |  |  | #'Accept-Encoding' => 'deflate, gzip', | 
| 877 |  |  |  |  |  |  | # For Perl, use HTTP::Message::decodable() instead of the above list | 
| 878 |  |  |  |  |  |  | ); | 
| 879 |  |  |  |  |  |  |  | 
| 880 | 0 |  |  | 0 | 1 | 0 | sub as_curl($self,%options) { | 
|  | 0 |  |  |  |  | 0 |  | 
|  | 0 |  |  |  |  | 0 |  | 
|  | 0 |  |  |  |  | 0 |  | 
| 881 |  |  |  |  |  |  | $options{ curl } = 'curl' | 
| 882 | 0 | 0 |  |  |  | 0 | if ! exists $options{ curl }; | 
| 883 |  |  |  |  |  |  | $options{ long_options } = 1 | 
| 884 | 0 | 0 |  |  |  | 0 | if ! exists $options{ long_options }; | 
| 885 |  |  |  |  |  |  |  | 
| 886 | 0 |  |  |  |  | 0 | my @request_commands; | 
| 887 |  |  |  |  |  |  |  | 
| 888 | 0 | 0 |  |  |  | 0 | if( $self->method eq 'HEAD' ) { | 
|  |  | 0 |  |  |  |  |  | 
| 889 |  |  |  |  |  |  | push @request_commands, | 
| 890 | 0 | 0 |  |  |  | 0 | $options{ long_options } ? '--head' : '-I'; | 
| 891 |  |  |  |  |  |  |  | 
| 892 |  |  |  |  |  |  | } elsif( $self->method ne 'GET' ) { | 
| 893 |  |  |  |  |  |  | push @request_commands, | 
| 894 | 0 | 0 |  |  |  | 0 | $options{ long_options } ? '--request' : '-X', | 
| 895 |  |  |  |  |  |  | $self->method; | 
| 896 |  |  |  |  |  |  | }; | 
| 897 |  |  |  |  |  |  |  | 
| 898 | 0 | 0 |  |  |  | 0 | if( scalar keys %{ $self->headers }) { | 
|  | 0 |  |  |  |  | 0 |  | 
| 899 | 0 |  |  |  |  | 0 | for my $h (sort keys %{$self->headers}) { | 
|  | 0 |  |  |  |  | 0 |  | 
| 900 | 0 |  |  |  |  | 0 | my $v = $self->headers->{$h}; | 
| 901 |  |  |  |  |  |  |  | 
| 902 | 0 |  |  |  |  | 0 | my $default; | 
| 903 | 0 | 0 |  |  |  | 0 | if( exists $curl_header_defaults{ $h }) { | 
| 904 | 0 |  |  |  |  | 0 | $default = $curl_header_defaults{ $h }; | 
| 905 |  |  |  |  |  |  | }; | 
| 906 |  |  |  |  |  |  |  | 
| 907 | 0 | 0 |  |  |  | 0 | if( ! ref $v ) { | 
| 908 | 0 |  |  |  |  | 0 | $v = [$v]; | 
| 909 |  |  |  |  |  |  | }; | 
| 910 | 0 |  |  |  |  | 0 | for my $val (@$v) { | 
| 911 | 0 | 0 | 0 |  |  | 0 | if( !defined $default or $val ne $default ) { | 
| 912 |  |  |  |  |  |  |  | 
| 913 |  |  |  |  |  |  | # also skip the Host: header if it derives from $uri | 
| 914 | 0 | 0 | 0 |  |  | 0 | if( $h eq 'Host' and ($val eq $self->uri->host_port | 
|  |  | 0 | 0 |  |  |  |  | 
| 915 |  |  |  |  |  |  | or $val eq $self->uri->host   )) { | 
| 916 |  |  |  |  |  |  | # trivial host header | 
| 917 |  |  |  |  |  |  | } elsif( $h eq 'User-Agent' ) { | 
| 918 |  |  |  |  |  |  | push @request_commands, | 
| 919 | 0 | 0 |  |  |  | 0 | $options{ long_options } ? '--user-agent' : '-A', | 
| 920 |  |  |  |  |  |  | $val; | 
| 921 |  |  |  |  |  |  | } else { | 
| 922 |  |  |  |  |  |  | push @request_commands, | 
| 923 | 0 | 0 |  |  |  | 0 | $options{ long_options } ? '--header' : '-h', | 
| 924 |  |  |  |  |  |  | "$h: $val"; | 
| 925 |  |  |  |  |  |  | }; | 
| 926 |  |  |  |  |  |  | }; | 
| 927 |  |  |  |  |  |  | }; | 
| 928 |  |  |  |  |  |  | }; | 
| 929 |  |  |  |  |  |  | }; | 
| 930 |  |  |  |  |  |  |  | 
| 931 | 0 | 0 |  |  |  | 0 | if( my $body = $self->body ) { | 
| 932 |  |  |  |  |  |  | push @request_commands, | 
| 933 | 0 | 0 |  |  |  | 0 | $options{ long_options } ? '--data-raw' : '--data-raw', | 
| 934 |  |  |  |  |  |  | $body; | 
| 935 |  |  |  |  |  |  | }; | 
| 936 |  |  |  |  |  |  |  | 
| 937 | 0 |  |  |  |  | 0 | push @request_commands, $self->uri; | 
| 938 |  |  |  |  |  |  |  | 
| 939 |  |  |  |  |  |  | return | 
| 940 |  |  |  |  |  |  | #(defined $options{ curl } ? $options{curl} : () ), | 
| 941 | 0 |  |  |  |  | 0 | @request_commands; | 
| 942 |  |  |  |  |  |  | } | 
| 943 |  |  |  |  |  |  |  | 
| 944 |  |  |  |  |  |  | =head2 C<< $r->as_wget >> | 
| 945 |  |  |  |  |  |  |  | 
| 946 |  |  |  |  |  |  | print $r->as_wget; | 
| 947 |  |  |  |  |  |  |  | 
| 948 |  |  |  |  |  |  | Returns a curl command line representing the request | 
| 949 |  |  |  |  |  |  |  | 
| 950 |  |  |  |  |  |  | This is convenient if you started out from something else or want a canonical | 
| 951 |  |  |  |  |  |  | representation of a curl command line. | 
| 952 |  |  |  |  |  |  |  | 
| 953 |  |  |  |  |  |  | =over 4 | 
| 954 |  |  |  |  |  |  |  | 
| 955 |  |  |  |  |  |  | =item B | 
| 956 |  |  |  |  |  |  |  | 
| 957 |  |  |  |  |  |  | The curl command to be used. Default is C. | 
| 958 |  |  |  |  |  |  |  | 
| 959 |  |  |  |  |  |  | =back | 
| 960 |  |  |  |  |  |  |  | 
| 961 |  |  |  |  |  |  | =cut | 
| 962 |  |  |  |  |  |  | # These are what wget uses as defaults, not what Perl should use as default! | 
| 963 |  |  |  |  |  |  | our %wget_header_defaults = ( | 
| 964 |  |  |  |  |  |  | 'Accept'          => '*/*', | 
| 965 |  |  |  |  |  |  | 'Accept-Encoding' => 'identity', | 
| 966 |  |  |  |  |  |  | 'User-Agent' => 'Wget/1.21', | 
| 967 |  |  |  |  |  |  | 'Connection' => 'Keep-Alive', | 
| 968 |  |  |  |  |  |  | ); | 
| 969 |  |  |  |  |  |  |  | 
| 970 | 20 |  |  | 20 | 1 | 454 | sub as_wget($self,%options) { | 
|  | 20 |  |  |  |  | 123 |  | 
|  | 20 |  |  |  |  | 204 |  | 
|  | 20 |  |  |  |  | 57 |  | 
| 971 |  |  |  |  |  |  | $options{ wget } = 'wget' | 
| 972 | 20 | 50 |  |  |  | 113 | if ! exists $options{ wget }; | 
| 973 |  |  |  |  |  |  | $options{ long_options } = 1 | 
| 974 | 20 | 50 |  |  |  | 191 | if ! exists $options{ long_options }; | 
| 975 |  |  |  |  |  |  |  | 
| 976 | 20 |  |  |  |  | 71 | my @request_commands; | 
| 977 |  |  |  |  |  |  |  | 
| 978 | 20 | 100 |  |  |  | 186 | if( $self->method ne 'GET' ) { | 
| 979 | 3 | 100 | 66 |  |  | 72 | if( $self->method eq 'POST' and $self->body ) { | 
| 980 |  |  |  |  |  |  | # This is implied by '--post-data', below | 
| 981 |  |  |  |  |  |  | } else { | 
| 982 | 1 |  |  |  |  | 20 | push @request_commands, | 
| 983 |  |  |  |  |  |  | '--method' => $self->method; | 
| 984 |  |  |  |  |  |  | }; | 
| 985 |  |  |  |  |  |  | }; | 
| 986 |  |  |  |  |  |  |  | 
| 987 | 20 | 50 |  |  |  | 51 | if( scalar keys %{ $self->headers }) { | 
|  | 20 |  |  |  |  | 167 |  | 
| 988 | 20 |  |  |  |  | 62 | my %h = %{ $self->headers }; | 
|  | 20 |  |  |  |  | 149 |  | 
| 989 |  |  |  |  |  |  |  | 
| 990 |  |  |  |  |  |  | # "--no-cache" implies two headers, Cache-Control and Pragma | 
| 991 |  |  |  |  |  |  | my $is_cache =    exists $h{ 'Pragma' } | 
| 992 |  |  |  |  |  |  | && exists $h{ 'Cache-Control' } | 
| 993 |  |  |  |  |  |  | && $h{ 'Cache-Control' } =~ /^no-cache\b/ | 
| 994 | 20 |  | 66 |  |  | 202 | && $h{ 'Pragma' } eq 'no-cache' | 
| 995 |  |  |  |  |  |  | ; | 
| 996 | 20 | 100 |  |  |  | 79 | if( $is_cache ) { | 
| 997 | 1 |  |  |  |  | 3 | delete $h{ 'Pragma' }; | 
| 998 | 1 |  |  |  |  | 3 | delete $h{ 'Cache-Control' }; | 
| 999 | 1 |  |  |  |  | 3 | push @request_commands, '--no-cache'; | 
| 1000 |  |  |  |  |  |  | }; | 
| 1001 |  |  |  |  |  |  |  | 
| 1002 | 20 |  |  |  |  | 177 | for my $name (sort keys %h) { | 
| 1003 | 120 |  |  |  |  | 953 | my $v = $h{ $name }; | 
| 1004 |  |  |  |  |  |  |  | 
| 1005 | 120 |  |  |  |  | 193 | my $default; | 
| 1006 | 120 | 100 |  |  |  | 313 | if( exists $wget_header_defaults{ $name }) { | 
| 1007 | 79 |  |  |  |  | 335 | $default = $wget_header_defaults{ $name }; | 
| 1008 |  |  |  |  |  |  | }; | 
| 1009 |  |  |  |  |  |  |  | 
| 1010 | 120 | 50 |  |  |  | 270 | if( ! ref $v ) { | 
| 1011 | 120 |  |  |  |  | 266 | $v = [$v]; | 
| 1012 |  |  |  |  |  |  | }; | 
| 1013 | 120 |  |  |  |  | 288 | for my $val (@$v) { | 
| 1014 | 120 | 100 | 100 |  |  | 587 | if( !defined $default or $val ne $default ) { | 
| 1015 |  |  |  |  |  |  | # also skip the Host: header if it derives from $uri | 
| 1016 | 62 | 100 | 66 |  |  | 463 | if( $name eq 'Host' and ($val eq $self->uri->host_port | 
|  |  | 100 | 100 |  |  |  |  | 
| 1017 |  |  |  |  |  |  | or $val eq $self->uri->host   )) { | 
| 1018 |  |  |  |  |  |  | # trivial host header, ignore | 
| 1019 |  |  |  |  |  |  | } elsif( $name eq 'User-Agent' ) { | 
| 1020 | 20 |  |  |  |  | 137 | push @request_commands, | 
| 1021 |  |  |  |  |  |  | '--user-agent', | 
| 1022 |  |  |  |  |  |  | $val; | 
| 1023 |  |  |  |  |  |  | } else { | 
| 1024 | 24 |  |  |  |  | 322 | push @request_commands, | 
| 1025 |  |  |  |  |  |  | '--header', | 
| 1026 |  |  |  |  |  |  | "$name: $val"; | 
| 1027 |  |  |  |  |  |  | }; | 
| 1028 |  |  |  |  |  |  | }; | 
| 1029 |  |  |  |  |  |  | }; | 
| 1030 |  |  |  |  |  |  | }; | 
| 1031 |  |  |  |  |  |  | }; | 
| 1032 |  |  |  |  |  |  |  | 
| 1033 | 20 | 100 |  |  |  | 170 | if( my $body = $self->body ) { | 
| 1034 | 3 | 100 |  |  |  | 35 | if( $self->method eq 'POST' ) { | 
| 1035 | 2 |  |  |  |  | 19 | push @request_commands, | 
| 1036 |  |  |  |  |  |  | '--post-data', | 
| 1037 |  |  |  |  |  |  | $body; | 
| 1038 |  |  |  |  |  |  | } else { | 
| 1039 | 1 |  |  |  |  | 12 | push @request_commands, | 
| 1040 |  |  |  |  |  |  | '--body-data', | 
| 1041 |  |  |  |  |  |  | $body; | 
| 1042 |  |  |  |  |  |  | }; | 
| 1043 |  |  |  |  |  |  | }; | 
| 1044 |  |  |  |  |  |  |  | 
| 1045 | 20 |  |  |  |  | 82 | push @request_commands, $self->uri; | 
| 1046 |  |  |  |  |  |  |  | 
| 1047 |  |  |  |  |  |  | return | 
| 1048 |  |  |  |  |  |  | #(defined $options{ curl } ? $options{curl} : () ), | 
| 1049 | 20 |  |  |  |  | 110 | @request_commands; | 
| 1050 |  |  |  |  |  |  | } | 
| 1051 |  |  |  |  |  |  |  | 
| 1052 |  |  |  |  |  |  |  | 
| 1053 |  |  |  |  |  |  | =head2 C<< $r->clone >> | 
| 1054 |  |  |  |  |  |  |  | 
| 1055 |  |  |  |  |  |  | Returns a shallow copy of the object | 
| 1056 |  |  |  |  |  |  |  | 
| 1057 |  |  |  |  |  |  | =cut | 
| 1058 |  |  |  |  |  |  |  | 
| 1059 | 0 |  |  | 0 | 1 |  | sub clone( $self, %options ) { | 
|  | 0 |  |  |  |  |  |  | 
|  | 0 |  |  |  |  |  |  | 
|  | 0 |  |  |  |  |  |  | 
| 1060 | 0 |  |  |  |  |  | (ref $self)->new( %$self, %options ) | 
| 1061 |  |  |  |  |  |  | } | 
| 1062 |  |  |  |  |  |  |  | 
| 1063 |  |  |  |  |  |  | 1; | 
| 1064 |  |  |  |  |  |  |  | 
| 1065 |  |  |  |  |  |  | =head1 REPOSITORY | 
| 1066 |  |  |  |  |  |  |  | 
| 1067 |  |  |  |  |  |  | The public repository of this module is | 
| 1068 |  |  |  |  |  |  | L. | 
| 1069 |  |  |  |  |  |  |  | 
| 1070 |  |  |  |  |  |  | =head1 SUPPORT | 
| 1071 |  |  |  |  |  |  |  | 
| 1072 |  |  |  |  |  |  | The public support forum of this module is | 
| 1073 |  |  |  |  |  |  | L. | 
| 1074 |  |  |  |  |  |  |  | 
| 1075 |  |  |  |  |  |  | =head1 BUG TRACKER | 
| 1076 |  |  |  |  |  |  |  | 
| 1077 |  |  |  |  |  |  | Please report bugs in this module via the Github bug queue at | 
| 1078 |  |  |  |  |  |  | L | 
| 1079 |  |  |  |  |  |  |  | 
| 1080 |  |  |  |  |  |  | =head1 AUTHOR | 
| 1081 |  |  |  |  |  |  |  | 
| 1082 |  |  |  |  |  |  | Max Maischein C | 
| 1083 |  |  |  |  |  |  |  | 
| 1084 |  |  |  |  |  |  | =head1 COPYRIGHT (c) | 
| 1085 |  |  |  |  |  |  |  | 
| 1086 |  |  |  |  |  |  | Copyright 2018-2023 by Max Maischein C. | 
| 1087 |  |  |  |  |  |  |  | 
| 1088 |  |  |  |  |  |  | =head1 LICENSE | 
| 1089 |  |  |  |  |  |  |  | 
| 1090 |  |  |  |  |  |  | This module is released under the same terms as Perl itself. | 
| 1091 |  |  |  |  |  |  |  | 
| 1092 |  |  |  |  |  |  | =cut |