root/test/t/apiclient.pm

Revision 8938addd5f83abced30639d76ba3ec6c59e68861, 1.8 kB (checked in by Theo Schlossnagle <jesus@omniti.com>, 3 years ago)

make the pattern match output (Sun Studio produces slightly different assertions)... VERIFYHOST needs to be 1 or we explode on Solaris.. not sure why

  • Property mode set to 100644
Line 
1 package apiclient;
2
3 use WWW::Curl::Easy;
4
5 sub new {
6     my $class = shift;
7     my $host = shift;
8     my $port = shift;
9     my $options = {
10         'cainfo' => '../test-ca.crt',
11         'key' => '../client.key',
12         'cert' => '../client.crt',
13     };
14     my $ext = shift || {};
15     while(my ($k,$v) = each %$ext) {
16       $options->{$k} = $v;
17     }
18     my $curl = WWW::Curl::Easy->new();
19     $curl->setopt(CURLOPT_SSL_VERIFYPEER, 0);
20     $curl->setopt(CURLOPT_SSL_VERIFYHOST, 1);
21     $curl->setopt(CURLOPT_CAINFO, $options->{cainfo});
22     $curl->setopt(CURLOPT_SSLKEY, $options->{key});
23     $curl->setopt(CURLOPT_SSLCERT, $options->{cert});
24     $curl->setopt(CURLOPT_TIMEOUT, 35);
25     return bless { curl => $curl, host => $host, port => $port }, $class;
26 }
27 sub do {
28     my $self = shift;
29     my $method = shift;
30     my $uri = shift || '/';
31     if (@_) {
32         my $payload = shift;
33         $self->{curl}->setopt(CURLOPT_UPLOAD, 1);
34         open (my $fh, "<", \$payload);
35         $self->{curl}->setopt(CURLOPT_INFILE, $fh);
36         $self->{curl}->setopt(CURLOPT_INFILESIZE, length($payload));
37     }
38     else {
39         $self->{curl}->setopt(CURLOPT_UPLOAD, 0);
40     }
41     $self->{curl}->setopt(CURLOPT_CUSTOMREQUEST, $method);
42     $self->{curl}->setopt(CURLOPT_URL, "https://$self->{host}:$self->{port}$uri");
43     my $response_body;
44
45     open (my $fileb, ">", \$response_body);
46     $self->{curl}->setopt(CURLOPT_WRITEDATA, $fileb);
47
48     my $retcode = $self->{curl}->perform();
49     my $response_code = $self->{curl}->getinfo(CURLINFO_HTTP_CODE);
50     if ($retcode == 0) {
51         return ($response_code, $response_body);
52     }
53     die $self->{curl}->strerror($retcode);
54 }
55 sub capabilities { shift->do('CAPA', @_); }
56 sub get { shift->do('GET', @_); }
57 sub post { shift->do('POST', @_); }
58 sub put { shift->do('PUT', @_); }
59 sub delete { shift->do('DELETE', @_); }
60
61 1;
Note: See TracBrowser for help on using the browser.