diff --git a/google-contacts.pl b/google-contacts.pl new file mode 100755 index 0000000..93dc2b6 --- /dev/null +++ b/google-contacts.pl @@ -0,0 +1,154 @@ +#!/usr/bin/perl +use uni::perl; + +# simple Google Contacts dumper +# by Alex Kapranoff +# uses API v3.0, so all fields are dumped, not a subset +# +# best used as a backup tool run silently from cron +# +# based on http://github.com/miyagawa/google-contacts-gravatar + +package Google::Contacts::Dump; +use Any::Moose; +use Net::Google::AuthSub; +use LWP::UserAgent; +use XML::LibXML::Simple; +use Data::Dumper; + +with any_moose('X::Getopt'); + +has authsub => ( + is => 'rw', isa => 'Net::Google::AuthSub', + default => sub { Net::Google::AuthSub->new(service => 'cp') }, + lazy => 1, +); + +has agent => ( + is => 'rw', isa => 'LWP::UserAgent', + default => sub { LWP::UserAgent->new }, + lazy => 1, +); + +has auth_params => ( + is => 'rw', isa => 'HashRef', +); + +has email => ( + is => 'rw', isa => 'Str', required => 1, +); + +has password => ( + is => 'rw', isa => 'Str', required => 1, +); + +has max_results => ( + is => 'rw', isa => 'Int', default => 5000, +); + +has contacts => ( + is => 'rw', isa => 'ArrayRef', +); + +has debug => ( + is => 'rw', isa => 'Bool', default => 0, +); + +sub run { + my $self = shift; + + $self->authorize(); + $self->retrieve_contacts(); + + $self->dump_contacts(); +} + +sub authorize { + my $self = shift; + + my $resp = $self->authsub->login($self->email, $self->password); + $resp && $resp->is_success or die "Auth failed against " . $self->email; + $self->auth_params({ $self->authsub->auth_params }); +} + +sub retrieve_contacts { + my $self = shift; + + my $feed = $self->get_feed("contacts/default/full", 'max-results' => $self->max_results); + $self->contacts($feed->{entry}); +} + +sub degoogle($) { + my $ar = shift; + + for my $i (@$ar) { + delete $i->{primary} if @$ar == 1; + + $i->{rel} =~ s/^[^#]+#// if $i->{rel}; + } + + return $ar; +} + +sub clean_undef { + my %hash = @_; + + foreach (keys %hash) { + delete $hash{$_} unless $hash{$_}; + delete $hash{$_} + if (ref $hash{$_} eq 'ARRAY' && @{$hash{$_}} == 0); + } + + return \%hash; +} + +sub dump_contacts { + my $self = shift; + + my %new_keys; + my @sane; + for my $c (@{$self->contacts}) { + my %sane; + + $sane{emails} = degoogle $c->{'gd:email'}; + $sane{phones} = degoogle $c->{'gd:phoneNumber'}; + $sane{address} = degoogle $c->{'gd:structuredPostalAddress'}; + $sane{title} = $c->{title}; + $sane{name} = $c->{'gd:name'}; + $sane{org} = degoogle $c->{'gd:organization'}; + $sane{updated} = $c->{updated}; + $sane{website} = $c->{'gContact:website'}; + $sane{birthday} = $c->{'gContact:birthday'}; + $sane{nickname} = $c->{'gContact:nickname'}; + + push @sane, clean_undef %sane; + + $new_keys{$_}++ for keys %$c; + } + + delete @new_keys{qw/gd:email gd:phoneNumber title updated id link + content category gd:organization gd:postalAddress + gContact:groupMembershipInfo gContact:website gContact:birthday + gContact:nickname gd:etag gd:name gd:structuredPostalAddress + app:edited/}; + + #say Dumper($self->contacts); + say Dumper(\@sane); + #say "Number of " . @sane; + #say Dumper([keys %new_keys]); +} + +sub get_feed { + my($self, $path, %param) = @_; + + my $uri = URI->new("http://www.google.com/m8/feeds/$path"); + $param{v} = '3.0'; + $uri->query_form(%param); + my $res = $self->agent->get($uri, %{ $self->auth_params }); + $res->is_success or die "HTTP error for $uri: " . $res->status_line; + + return XML::LibXML::Simple->new->XMLin($res->content, KeyAttr => [], ForceArray => [ 'gd:email' ]); +} + +package main; +Google::Contacts::Dump->new_with_options->run;