File: | lib/WWW/Google/Contacts/Roles/CRUD.pm |
Coverage: | 19.0% |
line | stmt | bran | cond | sub | pod | time | code |
---|---|---|---|---|---|---|---|
1 | package WWW::Google::Contacts::Roles::CRUD; | ||||||
2 | |||||||
3 | 11 11 11 | 81 35 98 | use Moose::Role; | ||||
4 | 11 11 11 | 120 34 96 | use Carp qw( croak ); | ||||
5 | 11 11 11 | 159 44 195 | use WWW::Google::Contacts::Data; | ||||
6 | |||||||
7 | requires 'create_url'; | ||||||
8 | |||||||
9 | has raw_data_for_backwards_compability => ( is => 'rw' ); | ||||||
10 | has server => ( is => 'ro', required => 1 ); | ||||||
11 | |||||||
12 | sub as_xml { | ||||||
13 | 0 | 0 | my $self = shift; | ||||
14 | 0 | my $entry = { | |||||
15 | entry => { | ||||||
16 | 'xmlns' => 'http://www.w3.org/2005/Atom', | ||||||
17 | 'xmlns:gd' => 'http://schemas.google.com/g/2005', | ||||||
18 | 'xmlns:gContact' => 'http://schemas.google.com/contact/2008', | ||||||
19 | 0 | %{ $self->to_xml_hashref }, | |||||
20 | }, | ||||||
21 | }; | ||||||
22 | 0 | my $xml = WWW::Google::Contacts::Data->encode_xml( $entry ); | |||||
23 | 0 | return $xml; | |||||
24 | } | ||||||
25 | |||||||
26 | sub create_or_update { | ||||||
27 | 0 | 0 | my $self = shift; | ||||
28 | 0 | if ( $self->has_id ) { | |||||
29 | 0 | return $self->update; | |||||
30 | } | ||||||
31 | else { | ||||||
32 | 0 | return $self->create; | |||||
33 | } | ||||||
34 | } | ||||||
35 | |||||||
36 | sub create { | ||||||
37 | 0 | 0 | my $self = shift; | ||||
38 | |||||||
39 | 0 | my $xml = $self->as_xml; | |||||
40 | 0 | my $res = $self->server->post( $self->create_url, undef, 'application/atom+xml', $xml ); | |||||
41 | 0 | my $data = WWW::Google::Contacts::Data->decode_xml( $res->content ); | |||||
42 | 0 | $self->set_from_server( $data ); | |||||
43 | 0 | 1; | |||||
44 | } | ||||||
45 | |||||||
46 | sub retrieve { | ||||||
47 | 0 | 0 | my $self = shift; | ||||
48 | 0 | croak "No id set" unless $self->id; | |||||
49 | |||||||
50 | 0 | my $res = $self->server->get( $self->id ); | |||||
51 | 0 | my $data = WWW::Google::Contacts::Data->decode_xml( $res->content ); | |||||
52 | 0 | $self->raw_data_for_backwards_compability( $data ); | |||||
53 | 0 | $self->set_from_server( $data ); | |||||
54 | 0 | $self; | |||||
55 | } | ||||||
56 | |||||||
57 | sub update { | ||||||
58 | 0 | 0 | my $self = shift; | ||||
59 | 0 | croak "No id set" unless $self->id; | |||||
60 | |||||||
61 | 0 | my $xml = $self->as_xml; | |||||
62 | 0 | $self->server->put( $self->id, $self->etag, 'application/atom+xml', $xml ); | |||||
63 | 0 | $self; | |||||
64 | } | ||||||
65 | |||||||
66 | sub delete { | ||||||
67 | 0 | 0 | my $self = shift; | ||||
68 | 0 | croak "No id set" unless $self->id; | |||||
69 | |||||||
70 | 0 | $self->server->delete( $self->id, $self->etag ); | |||||
71 | 0 | 1; | |||||
72 | } | ||||||
73 | |||||||
74 | 1; |