File Coverage

File:lib/WWW/Google/Contacts.pm
Coverage:30.3%

linestmtbrancondsubpodtimecode
1package WWW::Google::Contacts;
2
3# ABSTRACT: Google Contacts Data API
4
5
11
11
11
141
39
99
use Moose;
6
7
11
11
11
137
35
89
use Carp qw/croak/;
8
9
11
11
11
173
45
147
use WWW::Google::Contacts::Server;
10
11
11
11
206
46
525
use WWW::Google::Contacts::Contact;
11
11
11
11
209
44
170
use WWW::Google::Contacts::ContactList;
12
11
11
11
199
45
187
use WWW::Google::Contacts::Group;
13
11
11
11
206
45
177
use WWW::Google::Contacts::GroupList;
14
15has username => (
16    isa => 'Str',
17    is => 'rw',
18    default => sub { $ENV{ GOOGLE_USERNAME } },
19);
20
21has password => (
22    isa => 'Str',
23    is => 'rw',
24    default => sub { $ENV{ GOOGLE_PASSWORD } },
25);
26
27has server => (
28    isa => 'Object',
29    is => 'ro',
30    lazy_build => 1,
31);
32
33# backward compability
34has email => ( isa => 'Str', is => 'rw', trigger => sub { $_[0]->username( $_[1] ) } );
35has pass => ( isa => 'Str', is => 'rw', trigger => sub { $_[0]->password( $_[1] ) } );
36
37sub _build_server {
38
2
129
    my $self = shift;
39
2
17
    return WWW::Google::Contacts::Server->new({
40        username => $self->username,
41        password => $self->password,
42    });
43}
44
45sub new_contact {
46
3
1
16
    my $self = shift;
47
1
10
    my $args = ( scalar(@_) == 1 and ref($_[0]) eq 'HASH' )
48
3
46
        ? { %{$_[0]}, server => $self->server }
49        : { @_, server => $self->server };
50
3
454
    return WWW::Google::Contacts::Contact->new($args);
51}
52
53sub contact {
54
0
1
    my ($self,$id) = @_;
55
0
    return WWW::Google::Contacts::Contact->new( id => $id, server => $self->server )->retrieve;
56}
57
58sub contacts {
59
0
1
    my $self = shift;
60
61
0
    my $list = WWW::Google::Contacts::ContactList->new( server => $self->server );
62
0
    return $list;
63}
64
65sub new_group {
66
0
1
    my $self = shift;
67
0
    my $args = ( scalar(@_) == 1 and ref($_[0]) eq 'HASH' )
68
0
        ? { %{$_[0]}, server => $self->server }
69        : { @_, server => $self->server };
70
0
    return WWW::Google::Contacts::Group->new( $args );
71}
72
73sub group {
74
0
1
    my ($self,$id) = @_;
75
0
    return WWW::Google::Contacts::Group->new( id => $id,server => $self->server )->retrieve;
76}
77
78sub groups {
79
0
1
    my $self = shift;
80
81
0
    my $list = WWW::Google::Contacts::GroupList->new( server => $self->server );
82
0
    return $list;
83}
84
85# All code below is for backwards compability
86
87sub login {
88
0
1
    my ($self, $email, $pass) = @_;
89
0
    warn "This method is deprecated and will be removed shortly";
90
0
    $self->email( $email );
91
0
    $self->pass( $pass );
92
0
    my $server = WWW::Google::Contacts::Server->new({ username => $self->email, password => $self->password });
93
0
    $server->authenticate;
94
0
    return 1;
95}
96
97sub create_contact {
98
0
1
    my $self = shift;
99
0
    warn "This method is deprecated and will be removed shortly";
100
0
    my $data = scalar @_ % 2 ? shift : { @_ };
101
102
0
    my $contact = $self->new_contact;
103
0
    return $self->_create_or_update_contact( $contact, $data );
104}
105
106sub _create_or_update_contact {
107
0
    my ($self, $contact, $data) = @_;
108
109
0
    $contact->given_name( $data->{ givenName } );
110
0
    $contact->family_name( $data->{ familyName } );
111
0
    $contact->notes( $data->{Notes} );
112    $contact->email({
113        type => "work",
114        primary => 1,
115        value => $data->{ primaryMail },
116        display_name => $data->{ displayName },
117
0
    });
118
0
    if ( $contact->{secondaryMail} ) {
119        $contact->add_email({
120            type => "home",
121            value => $data->{ secondaryMail },
122
0
        });
123    }
124# if ( $contact->{groupMembershipInfo} ) {
125# $data->{'atom:entry'}->{'gContact:groupMembershipInfo'} = {
126# deleted => 'false',
127# href => $contact->{groupMembershipInfo}
128# };
129# }
130
0
    if ( $contact->create_or_update ) {
131
0
        return 1;
132    }
133
0
    return 0;
134}
135
136sub get_contacts {
137
0
1
    my $self = shift;
138
139
0
    warn "This method is deprecated and will be removed shortly";
140
0
    my $list = $self->contacts;
141
0
    my @contacts;
142
0
0
    foreach my $c ( @{ $list->elements } ) {
143
0
        my $d = $c;
144        ($d->{id}) =
145
0
            map { $_->{ href } }
146
0
            grep { $_->{ rel } eq 'self' }
147
0
0
            @{ $d->{ link } }
148        ;
149
0
        $d->{name} = $d->{'gd:name'};
150
0
        $d->{email} = $d->{'gd:email'};
151
0
        $d->{groupMembershipInfo} = $d->{'gContact:groupMembershipInfo'};
152
0
        push @contacts, $d;
153    }
154
0
    return @contacts;
155}
156
157sub get_contact {
158
0
1
    my ($self, $id) = @_;
159
160
0
    warn "This method is deprecated and will be removed shortly";
161
0
    my $contact = $self->new_contact( id => $id )->retrieve;
162
0
    my $data = $contact->raw_data_for_backwards_compability;
163
0
    $data->{name} = $data->{'gd:name'};
164
0
    $data->{email} = $data->{'gd:email'};
165
0
    $data->{groupMembershipInfo} = $data->{'gContact:groupMembershipInfo'};
166
0
    return $data;
167}
168
169sub update_contact {
170
0
1
    my ($self, $id, $contact) = @_;
171
172
0
    warn "This method is deprecated and will be removed shortly";
173
0
    my $c = $self->new_contact( id => $id )->retrieve;
174
0
    return $self->_create_or_update_contact( $c, $contact );
175}
176
177sub delete_contact {
178
0
1
    my ($self, $id) = @_;
179
180
0
    warn "This method is deprecated and will be removed shortly";
181
0
    $self->new_contact( id => $id )->delete;
182}
183
184sub get_groups {
185
0
1
    my $self = shift;
186
187
0
    warn "This method is deprecated and will be removed shortly";
188
0
    my $list = $self->groups;
189
0
    my @groups;
190
0
0
    foreach my $d ( @{ $list->elements } ) {
191
0
        my $link = ref($d->{link}) eq 'ARRAY' ? $d->{link} : [ $d->{link} ];
192        ($d->{id}) =
193
0
            map { $_->{ href } }
194
0
0
            grep { $_->{ rel } eq 'self' }
195
0
            @{ $link }
196        ;
197
0
        push @groups, {
198            id => $d->{id},
199            title => $d->{title},
200            updated => $d->{updated},
201            exists $d->{'gContact:systemGroup'} ? ('gContact:systemGroup' => $d->{'gContact:systemGroup'}->{'id'}) : (),
202        }
203    }
204
0
    return @groups;
205}
206
207sub get_group {
208
0
1
    my ($self, $id) = @_;
209
210
0
    warn "This method is deprecated and will be removed shortly";
211
0
    my $group = $self->new_group( id => $id )->retrieve;
212
0
    my $data = $group->raw_data_for_backwards_compability;
213
0
    return $data;
214}
215
216sub _create_or_update_group {
217
0
    my ($self, $group, $data) = @_;
218
219
0
    $group->title( $data->{ title } );
220
0
    if ( $group->create_or_update ) {
221
0
        return 1;
222    }
223
0
    return 0;
224}
225
226sub create_group {
227
0
1
    my $self = shift;
228
0
    my $data = scalar @_ % 2 ? shift : { @_ };
229
230
0
    warn "This method is deprecated and will be removed shortly";
231
0
    my $group = $self->new_group;
232
0
    return $self->_create_or_update_group( $group, $data );
233}
234
235sub update_group {
236
0
1
    my ($self, $id, $args) = @_;
237
238
0
    warn "This method is deprecated and will be removed shortly";
239
0
    my $g = $self->new_group( id => $id )->retrieve;
240
0
    return $self->_create_or_update_group( $g, $args );
241}
242
243sub delete_group {
244
0
1
    my ($self, $id) = @_;
245
246
0
    warn "This method is deprecated and will be removed shortly";
247
0
    $self->new_group( id => $id )->delete;
248}
249
250
11
11
11
156
45
93
no Moose;
251__PACKAGE__->meta->make_immutable;
2521;