LP#1541559: HTTPClient: a utility for sending HTTP requests and handling responses
[working/Evergreen.git] / Open-ILS / src / perlmods / lib / OpenILS / Utils / HTTPClient.pm
1 package OpenILS::Utils::HTTPClient;
2
3 use strict;
4 use warnings;
5
6 use OpenSRF::Utils::SettingsClient;
7 use OpenSRF::Utils::Logger qw($logger);
8 use OpenSRF::Utils::JSON;
9 use LWP::UserAgent;
10 use HTTP::Request;
11
12 sub new {
13     my $class = shift;
14
15     my $self = {};
16     bless $self, $class;
17
18     $self->_initialize();
19
20     return $self;
21 }
22
23 sub _initialize {
24     my $self = shift;
25
26     # pull settings from opensrf.xml config
27     my $conf = OpenSRF::Utils::SettingsClient->new();
28     my $settings = $conf->config_value('http_client');
29
30     if ($settings->{useragent}) {
31         $self->{useragent} = $settings->{useragent};
32     }
33     if ($settings->{default_timeout}) {
34         $self->{default_timeout} = $settings->{default_timeout};
35     }
36
37     # SSL handling options. When communicating over HTTPS, LWP::UserAgent
38     # falls back to the environment variables whose values are set here.
39     # See LWP::UserAgent docs for details.
40     foreach my $opt (keys %{$settings->{ssl_opts}}) {
41         # check for a valid SSL cert?
42         if ($opt eq 'verify_hostname') {
43             $ENV{PERL_LWP_SSL_VERIFY_HOSTNAME} = $settings->{ssl_opts}->{verify_hostname};
44         # path to directory for CA certificate files
45         } elsif ($opt eq 'SSL_ca_path') {
46             $ENV{PERL_LWP_SSL_CA_PATH} = $settings->{ssl_opts}->{SSL_ca_path};
47         # path to CA certificate file
48         } elsif ($opt eq 'SSL_ca_file') {
49             $ENV{PERL_LWP_SSL_CA_FILE} = $settings->{ssl_opts}->{SSL_ca_file};
50         }
51     }
52
53     return $self;
54 }
55
56 # request(): Send an HTTP request.
57 #
58 # Params:
59 #   $method - HTTP method (GET, POST, PUT, DELETE)
60 #   $uri - URI of resource to be requested
61 #   $header - hashref containing HTTP headers
62 #   $content - content of request
63 #   $request_timeout - timeout value in seconds; defaults to 60s
64 #   $useragent - user agent string; defaults to SameOrigin/1.0
65 #
66 # Returns an HTTP::Response object, or undef if the request failed/timed out.
67 # Use $res->content to get response content.
68 #
69 sub request {
70     my ($self, $method, $uri, $headers, $content, $request_timeout, $useragent) = @_;
71     my $ua = new LWP::UserAgent;
72
73     $request_timeout = $request_timeout || $self->{default_timeout} || 60;
74     $ua->timeout($request_timeout);
75
76     $useragent = $useragent || $self->{useragent} || 'SameOrigin/1.0';
77     $ua->agent($useragent);
78
79     my $h = HTTP::Headers->new();
80     foreach my $k (keys %$headers) {
81         $h->header($k => $headers->{$k});
82     }
83
84     my $req = HTTP::Request->new(
85         $method,
86         $uri,
87         $h,
88         $content
89     );
90     my $res;
91
92     eval {
93         $logger->info("HTTPClient: sending HTTP $method request to $uri");
94         $res = $ua->request($req);
95     } or do {
96         $logger->info("HTTPClient: execution error");
97         return undef;
98     };
99
100     if ($res->status_line =~ /timeout/) {
101         $logger->info("HTTPClient: timeout error: " . $res->status_line);
102         return undef;
103     }
104
105     # TODO handle HTTP response status codes
106
107     return $res;
108 }
109
110 # Wrappers for request() using specific HTTP methods (GET, POST etc).
111 sub get {
112     my $self = shift;
113     return $self->request('GET', @_);
114 }
115
116 sub post {
117     my $self = shift;
118     return $self->request('POST', @_);
119 }
120
121 sub put {
122     my $self = shift;
123     return $self->request('PUT', @_);
124 }
125
126 sub delete {
127     my $self = shift;
128     return $self->request('DELETE', @_);
129 }
130
131 1;