Permalink
Find file
Fetching contributors…
Cannot retrieve contributors at this time
executable file 154 lines (117 sloc) 3.44 KB
#!/usr/bin/perl
use uni::perl;
# simple Google Contacts dumper
# by Alex Kapranoff <kappa@cpan.org>
# 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 OAuth::Cmdline;
use LWP::UserAgent;
use XML::LibXML::Simple;
use Data::Dumper;
with any_moose('X::Getopt');
has oauth => (
is => 'rw', isa => 'OAuth::Cmdline',
default => sub { OAuth::Cmdline->new(site => 'google-contacts') },
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;
$self->auth_params({ $self->oauth->authorization_headers });
}
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;
$ar = [ $ar ] unless ref $ar eq 'ARRAY';
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("https://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;