File Coverage

File:lib/WWW/Google/Contacts/Server.pm
Coverage:27.5%

linestmtbrancondsubpodtimecode
1package WWW::Google::Contacts::Server;
2
3
11
11
11
77
33
91
use Moose;
4
11
11
11
185
40
162
use LWP::UserAgent;
5
11
11
11
164
46
172
use Net::Google::AuthSub;
6
11
11
11
99
37
107
use Carp qw( croak );
7
8has ua => (
9    is => 'ro',
10    default => sub { LWP::UserAgent->new },
11);
12
13has authsub => (
14    is => 'ro',
15    lazy_build => 1,
16);
17
18has username => (
19    isa => 'Str',
20    is => 'ro',
21    required => 1,
22);
23
24has password => (
25    isa => 'Str',
26    is => 'ro',
27    required => 1,
28);
29
30has gdata_version => (
31    isa => 'Str',
32    is => 'ro',
33    default => '3.0',
34);
35
36sub _build_authsub {
37
0
    my $self = shift;
38
39
0
    my $auth = Net::Google::AuthSub->new(service => 'cp');
40
0
    my $res = $auth->login($self->username, $self->password);
41
0
    unless ( $res and $res->is_success ) {
42
0
        if ( $res ) {
43
0
            warn $res->{ _response }->content;
44        }
45
0
        croak "Authentication failed";
46    }
47
0
    return $auth;
48}
49
50sub authenticate {
51
0
0
    my $self = shift;
52
0
    return 1 if ( $self->authsub );
53}
54
55sub get {
56
0
0
    my ($self, $id) = @_;
57
0
    my %headers = $self->authsub->auth_params;
58
0
    $headers{'GData-Version'} = $self->gdata_version;
59
0
    my $res = $self->ua->get( $id, %headers );
60
0
    unless ( $res->is_success ) {
61
0
        croak "GET failed: " . $res->status_line;
62    }
63
0
    return $res;
64}
65
66sub post {
67
0
0
    my ($self, $id, $etag, $content_type, $content) = @_;
68
69
0
    my %headers = $self->authsub->auth_params;
70
0
    $headers{'Content-Type'} = $content_type;
71
0
    $headers{'GData-Version'} = $self->gdata_version;
72
0
    my $res = $self->ua->post( $id, %headers, Content => $content );
73
0
    unless ( $res->is_success ) {
74
11
11
11
0
118
45
86
        use Data::Dumper; print Dumper $res;
75
0
        croak "POST failed: " . $res->status_line;
76    }
77
0
    return $res;
78}
79
80sub put {
81
0
0
    my ($self, $id, $etag, $content_type, $content) = @_;
82
83
0
    my %headers = $self->authsub->auth_params;
84
0
    $headers{'Content-Type'} = $content_type;
85
0
    $headers{'GData-Version'} = $self->gdata_version;
86
0
    $headers{'If-Match'} = $etag;
87
0
    $headers{'X-HTTP-Method-Override'} = 'PUT';
88
0
    my $res = $self->ua->post( $id, %headers, Content => $content );
89
0
    unless ( $res->is_success ) {
90
11
11
11
0
104
36
69
        use Data::Dumper; print Dumper $res;
91
0
        croak "PUT failed: " . $res->status_line;
92    }
93
0
    return $res;
94}
95
96sub delete {
97
0
0
    my ($self, $id, $etag) = @_;
98
99
0
    my %headers = $self->authsub->auth_params;
100
0
    $headers{'If-Match'} = $etag;
101
0
    $headers{'X-HTTP-Method-Override'} = 'DELETE';
102
0
    $headers{'GData-Version'} = $self->gdata_version;
103
0
    my $res = $self->ua->post($id, %headers);
104
0
    unless ( $res->is_success ) {
105
0
        croak "DELETE failed: " . $res->status_line;
106    }
107
0
    return $res;
108}
109
110
11
11
11
112
40
103
no Moose;
111__PACKAGE__->meta->make_immutable;
1121;