| File: | lib/WWW/Google/Contacts/Server.pm |
| Coverage: | 27.5% |
| line | stmt | bran | cond | sub | pod | time | code |
|---|---|---|---|---|---|---|---|
| 1 | package 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 | |||||||
| 8 | has ua => ( | ||||||
| 9 | is => 'ro', | ||||||
| 10 | default => sub { LWP::UserAgent->new }, | ||||||
| 11 | ); | ||||||
| 12 | |||||||
| 13 | has authsub => ( | ||||||
| 14 | is => 'ro', | ||||||
| 15 | lazy_build => 1, | ||||||
| 16 | ); | ||||||
| 17 | |||||||
| 18 | has username => ( | ||||||
| 19 | isa => 'Str', | ||||||
| 20 | is => 'ro', | ||||||
| 21 | required => 1, | ||||||
| 22 | ); | ||||||
| 23 | |||||||
| 24 | has password => ( | ||||||
| 25 | isa => 'Str', | ||||||
| 26 | is => 'ro', | ||||||
| 27 | required => 1, | ||||||
| 28 | ); | ||||||
| 29 | |||||||
| 30 | has gdata_version => ( | ||||||
| 31 | isa => 'Str', | ||||||
| 32 | is => 'ro', | ||||||
| 33 | default => '3.0', | ||||||
| 34 | ); | ||||||
| 35 | |||||||
| 36 | sub _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 | |||||||
| 50 | sub authenticate { | ||||||
| 51 | 0 | 0 | my $self = shift; | ||||
| 52 | 0 | return 1 if ( $self->authsub ); | |||||
| 53 | } | ||||||
| 54 | |||||||
| 55 | sub 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 | |||||||
| 66 | sub 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 | |||||||
| 80 | sub 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 | |||||||
| 96 | sub 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; | ||||||
| 112 | 1; | ||||||