| 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; | ||||||