File Coverage

File:	lib/WWW/OpenAPI.pm
Coverage:	66.7%

line	stmt	bran	cond	sub	pod	time	code
1							package WWW::OpenAPI;
2
3	1 1 1			1		5 2 7	use strict;
4	1 1 1			1		8 3 6	use warnings;
5
6							#use Smart::Comments;
7	1 1 1			1		8 2 10	use Carp;
8	1 1 1			1		9 2 12	use Params::Util qw( _HASH0 );
9	1 1 1			1		10 5 21	use LWP::UserAgent;
10	1 1 1			1		13 4 17	use Data::Dumper;
11
12							sub new {
13							### @_
14	1	50		1	0	10	my $class = ref $_[0] ? ref shift : shift;
15	1	50				8	my $params = _HASH0(shift @_) or croak "Invalid params";
16							### $params
17	1	50				24	my $server = delete $params->{server} or
18							croak "No server specified.";
19	1					5	my $timer = delete $params->{timer};
20	1					9	my $ua = LWP::UserAgent->new;
21	1					290	$ua->cookie_jar({ file => "cookies.txt" });
22	1					36	bless {
23							server => $server,
24							ua => $ua,
25							timer => $timer,
26							}, $class;
27							}
28
29							sub content_type {
30	0			0	0	0	$_[0]->{content_type} = $_[1];
31							}
32
33							sub login {
34	0			0	0	0	my ($self, $user, $password) = @_;
35	0					0	$self->get("/=/login/$user/$password");
36							}
37
38							sub get {
39	1			1	0	12	my $self = shift;
40	1					16	$self->request(undef, 'GET', @_);
41							}
42
43							sub post {
44	258			258	0	1955	my $self = shift;
45	258					1836	my $content = shift;
46	258					2585	$self->request($content, 'POST', @_);
47							}
48
49							sub put {
50	2			2	0	10	my $self = shift;
51	2					98	my $content = shift;
52	2					17	$self->request($content, 'PUT', @_);
53							}
54
55							sub delete {
56	12			12	0	89	my $self = shift;
57	12					121	$self->request(undef, 'DELETE', @_);
58							}
59
60							sub request {
61	273			273	0	2994	my ($self, $content, $method, $url, $params) = @_;
62	273	50	33			2988	!defined $params or _HASH0($params) or
63							die "Params must be a hash: ", Dumper($params), "\n";
64	273	50	33			2419	if ($params && %$params) {
65	0	0				0	if ($url =~ /\?/) {
66	0					0	die "? not allowed when params specified.\n";
67							} else {
68	0					0	my @params;
69	0					0	while (my ($key, $val) = each %$params) {
70	0					0	push @params, "$key=$val";
71							}
72	0					0	$url .= "?" . join '&', @params;
73							}
74							}
75	273					1859	my $type = $self->{content_type};
76	273		50			2116	$type \|\|= 'text/plain';
77	273	50				2530	if ($url !~ /^http:\/\//) {
78	273					2772	$url = $self->{server} . $url;
79							}
80	273					4358	my $req = HTTP::Request->new($method);
81	273					57009	$req->header('Content-Type' => $type);
82	273					47084	$req->header('Accept', '/');
83	273					45501	$req->url($url);
84	273	100 50	33			65834	if ($content) {
85	260	50	33			3895	if ($method eq 'GET' or $method eq 'HEAD') {
86	0					0	die "HTTP 1.0/1.1 $method request should not have content: $content\n";
87							}
88
89	260					1510	$req->content($content);
90							} elsif ($method eq 'POST' or $method eq 'PUT') {
91	0					0	$req->header('Content-Length' => 0);
92							}
93	273					18012	my $timer = $self->{timer};
94	273					1432	my $ua = $self->{ua};
95	273	50				1380	$timer->start($method) if $timer;
96	273					1864	my $res = $ua->request($req);
97	273	50				85466	$timer->stop($method) if $timer;
98	273					2489	return $res;
99							}
100
101							1;
102