#!/usr/bin/perl -w
use strict;

use LWP::Simple qw($ua get);
use XML::XPath;

# To create a project
#    https://cloud.google.com/console#/project
#  Inside the project go to APIs+aut, select the
#    API the program needs (eg Contacts API).
#  Next go to "Registered apps"
#    "Register App"
#  We need the Client ID and Client Secret values

my $client_id='CHANGE_ME'
my $client_secret='CHANGE_ME'
my $redirect_uri='urn:ietf:wg:oauth:2.0:oob';

# This scope is for Google Contacts API
my $scope="https://www.google.com/m8/feeds";

# Pretty printing; how deep to indent the fields
my $INDENT=20;

# Shouldn't need to change anything after this...

my $pname=$0; $pname=~s!^.*/!!;
my $search=join(" ",@ARGV);

# Store our credentials in our home directory with a file called 
# $HOME/.<script name>.gcred
my $my_creds=$ENV{HOME} . "/.$pname.gcred";

# Cache results for an hour
my $cache=$ENV{HOME} . "/etc/contacts";
my $cache_time=3600;

our %auth;

# A wrapper to simplify POST/GET calls.  We know we always need to
# pass exactly one special header line, and the rest is the query
sub do_http($$$$@)
{
  my ($method,$url,$hdr,$val,@fields)=@_;


  my $ua = LWP::UserAgent->new();
  my $res;
  if ($method eq "post")
  {
    $res = $ua->post($url,$hdr=>$val,Content=>\@fields);
  }
  else
  {
    $res = $ua->get($url,$hdr=>$val);
  }

  if ($res->is_success)
  {
    return $res->content;
  }
  else
  {
    die "Error getting $url: " . ( $res->status_line) . "\n";
  }
}

# Talk to the google API for authentication, decode the returned JSON
# and put it into a hash.  Umm, we break layering a little and steal
# the global refresh_token if one hasn't been returned.  Store the
# results in the gcred file

sub communicate(@)
{
  my (@options)=@_;

  my @res=split(/[\r\n]+/,do_http(
    "post",
    'https://accounts.google.com/o/oauth2/token',
    'Content-Type','application/x-www-form-urlencoded',
    "client_id","$client_id",
    "client_secret","$client_secret",
    @options
  ));

  my %res;

  foreach (@res)
  {
    s/,$//;
    s/"$//;
    next unless /^\s*"(.*)"\s*:\s*"?(.*)/;
    $res{$1}=$2;
  }
  die "Unable to get access token\n" unless $res{access_token};

  $res{expires_at}=time()+$res{expires_in}-60;

  if (!$res{refresh_token} && $auth{refresh_token})
  {
    $res{refresh_token}=$auth{refresh_token};
  }

  open(F,">$my_creds");
  foreach (sort keys %res)
  {
    print F "$_=$res{$_}\n";
  }
  close(F);

  return %res;
}

# if we already have a token stored, use it
if ( -e $my_creds )
{
  open(F,"<$my_creds") || die "$my_creds: $!\n";
  while(<F>)
  {
    chomp;
    my ($var,$val)=split(/=/,$_,2);
    $auth{$var}=$val;
  }
  close(F);
}
else
{
  # First time running this code; prompt the user to generate the
  # first authentication token
  # http://goo.gl/U0uKEb
  my $auth_url="https://accounts.google.com/o/oauth2/auth?client_id=$client_id&scope=$scope&response_type=code&redirect_uri=$redirect_uri";

  print "Please go to:\n";
  print "\n";
  print "$auth_url\n";
  print "\n";
  print "after accepting, enter the code you are given:\n";
  my $auth_code=<STDIN>;
  chomp($auth_code);
  die "Missing code\n" unless $auth_code;

  # Based on what the user returned, generate our session token
  # http://goo.gl/Mu9E5J
  print "Requesting initial token\n";
  %auth=communicate("code","$auth_code","redirect_uri","$redirect_uri","grant_type","authorization_code"); 
}

my $need_download=1;
if ( -e $cache )
{
  my @s=stat($cache);
  my $mtime=$s[9];
  $need_download=0 if $mtime>time()-$cache_time;
}

if ($need_download)
{
  print "Updating cache from Google\n";

  # if our access token is expired, use the refresh token to get a new one
  # http://goo.gl/71rN6V
  if ( time() > $auth{expires_at} )
  {
    print "Refreshing token\n";
    %auth=communicate("refresh_token","$auth{refresh_token}",
                      "grant_type","refresh_token")
  }

  # Download 1000 entries.  I've no idea what the maximum number of
  # results google will actually return.  I have <100 contacts.
  # I'm lazy; I really don't want to have to handle paging if I can
  # avoid it.  Let's hope all the entries can be returned in one call!
  my $data=do_http("get","$scope/contacts/default/full?max-results=1000",
                   "Authorization","$auth{token_type} $auth{access_token}");

  open(G,">$cache");
  print G "$data";
  close(G);
}

# The cache file has sufficiently up-to-date data.   Load it into a string
open(F,"<$cache") or die "$cache: $!\n";
my $data;
while(<F>)
{
  $data .= "$_";
}
close(F);

# We have some horrendous XML to parse.  XPath, do your stuff!
my $xp = XML::XPath->new(xml => $data);

# Each returned result is an <entry> tag, so let's find them all
my @nodeset=$xp->findnodes("//entry");

# This will hold the results that match our request.
my %result=();

foreach my $node (@nodeset)
{
  # Only keep this node if the text version matches our search
  my $str= XML::XPath::XMLParser::as_string($node);

  # But we don't want the internal values
  $str=~s/<id>[^<]*<.id>//g;
  $str=~s/href=['"][^'"]*['"]//g;

  next unless $str =~ /$search/i;

  # We like this value.  Let's examine it.
  my %entry=();
  my @children=$node->getChildNodes();
  foreach my $ch (@children)
  {
    my $n=$ch->getName;
    # Don't care about these
    next if $n =~ /^id|updated|category|link|gContact:groupMembershipInfo$/;

    my $v=$ch->string_value || '';
    # Google can hide hidden CR/LFs at the end of data.  Strip it out.
    $v=~s/[\r\n\s]+$//m;

    if ($n eq 'title')
    {
      $entry{$n}=$v;
      next;
    }

    if ( $n eq 'content')
    {
      $entry{other}{Notes}=$v if $v;
      next;
    }
 
    if ($n eq 'gd:organization')
    {
      # Organisation has OrgName and orgTitle subfields
      my ($on,$ot)="";
      foreach my $o ($ch->getChildNodes())
      {
        my $n=$o->getName;
        my $v=$o->string_value || '';
           if ($n eq 'gd:orgName') { $on=$v; }
        elsif ($n eq 'gd:orgTitle') { $ot=$v; }
        else { die "Unknown org value $n=$v\n"; }
      }
      $on="" unless $on;
      $on=($on?"$on\n":"").$ot if $ot;
      $on=~s/[\r\n\s]+$//m;
      $entry{other}{Organization}=$on if $on;
      next;
    }

    # Now the google data structures may store data in values _or_ as
    # attributes.  Joy.  Let's grab the attributes and see if they're
    # overridden by values.
    my %att=();
    foreach my $a ($ch->getAttributes)
    {
      $att{$a->getName}=$a->getData;
    }

    # Many values (eg email) have the type ("home", "work", etc) as a
    # field of the attribute with a value such as blahblahblah#home
    if ($n eq 'gd:email')
    {
      my $t=$att{label} || $att{rel} || 'UNKNOWN'; $t=~s/^.*#//;
      push(@{ $entry{email}{$t}},$att{address});
    }
    elsif ($n eq 'gd:phoneNumber')
    {
      my $t=$att{label} || $att{rel} || 'UNKNOWN'; $t=~s/^.*#//;
      push (@{$entry{phone}{$t} },$v || $att{uri});
    }
    elsif ($n eq 'gd:postalAddress')
    {
      my $t=$att{label} || $att{rel} || 'UNKNOWN'; $t=~s/^.*#//;
      push(@{$entry{address}{$t}},$v || $att{uri});
    }
    elsif ($n eq 'gd:im')
    {
      my $t=$att{label} || $att{protocol} || $att{rel} || 'UNKNOWN'; $t=~s/^.*#//;
      push(@{$entry{im}{$t}},$v || $att{address});
    }
    else
    {
      # This parser written just on what my address book has.  Maybe I've
      # missed something!
      print "Unknown type: $n = $v\n";
    }
  }

  # Try to build a unique key for the results hash.
  my $key=$entry{title};
  while ($result{$key}) { $key += "+"; }
  $entry{key}=$key;
  %{ $result{$key}} = %entry;
}

# Print out the results of our hash array.
my $first=1;
foreach (sort { lc $a cmp lc $b } keys %result)
{
  print "=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=\n" unless $first;
  $first=0;

  my %entry=%{ $result{$_} };
  do_dump(\%entry);
}

# OK, we have an entry in a complicated hash array.  The structure is
# gonna depend on the XML returned so we can't make too many assumptions.
# Pretty print, time!
#
# What we're gonna do is print out the structures we know about and then
# if there's anything left over (shouldn't be!!!) we'll just raw-dump
# them.
sub do_dump
{
  my ($entry)=@_;

  print "$entry->{title}\n";
  delete($entry->{title});
  delete($entry->{key});

  dump_item("Email address",$entry->{email});
  delete($entry->{email});

  dump_item("Instant Messanger",$entry->{im});
  delete($entry->{im});

  dump_item("Phone Numbers",$entry->{phone});
  delete($entry->{phone});

  dump_item("Postal Addresses",$entry->{address});
  delete($entry->{address});

  dump_item("Other details",$entry->{other});
  delete($entry->{other});

  foreach (sort keys %$entry)
  {
    print "$_ ==> $entry->{$_}\n";
  }
}

# This formats to $INDENT level for the field.  The data passed might
# be an array of values.  And each value may have embedded CR/LF entries
sub fmt($$$)
{
  my ($i,$l,$c)=@_;
  $l=~s/^[^:]*://;
  my @rows;
  if (ref($c) eq 'ARRAY')
  {
    @rows=@$c;
  }
  else
  {
    @rows=($c);
  }
  foreach my $line (@rows)
  {
    printf("%${i}s: ",ucfirst($l));
    my @c=split(/[\r\n]/,$line);
    print join("\n". (" "x$i) . "  ",@c) . "\n";
  }
}

sub dump_item
{
  my ($title,$data)=@_;
  if ($data)
  {
    print "  $title:\n";
    foreach my $t (sort { lc $a cmp lc $b } keys %{ $data })
    {
      fmt($INDENT,$t,$data->{$t});
    }
  }
}