dark

Perl, Facebook and GMail Contacts

blank

There are probably already 13 in a dozen applications or websites that can do this, but I wanted to write one on my own, in the programming language I like: Perl.

Nowadays writing programs for tasks concerning Web 2.0 alike websites, is rather simple and easy. The only thing you will have to do, is learn their API. These API are mostly XML based requests and replies.

Most programming languages then write wrapper classes that call and access those API’s, like was done in Perl.
Thanks to the following modules, which can be found on CPAN, I wrote a small script which loads my contacts on Facebook and then updates or creates my contacts in GMail.

The script will retrieve some contact information, like the birthday, email addresses, status messages, and website information from Facebook as well as the profile picture of the contact. Then it will search your GMail Contact list for the user and will update the contact if it is found. Non-existing contacts will be ignored.

The modules used in the script are:

use WWW::Facebook::API;
use WWW::Google::Contacts;
use HTTP::Request;
use LWP;

All these modules can be downloaded from CPAN.

You will need to create a Facebook application, or you can use the application I have added. Before you can use the Facebook API, your application needs to be registered and known to Facebook. If you are not sure how to create and register an application at Facebook, please use mine. (No worries, I won’t do evil stuff)

After the module have been called in the script, we need to initialize some variables:

my $TMP    = $ENV{HOME}.'/tmp';
my %MONTHS = (
        January => '01',      February => '02',     March     => '03',
        April   => '04',      May      => '05',     June      => '06',
        July    => '07',      August   => '08',     September => '09',
        October => '10',      November => '11',     December  => '12',
);

my $facebook_api      = 'dad7ea6af99ba4ee11d6007f0a27cc6a';
my $facebook_secret   = '19d45131916886ffdad8d0a6899d6794';
my $facebook_clientid = '141446449211973';
my $facebook_browser  = '/usr/bin/firefox';
my $gmail_user        = 'user@gmail.com';
my $gmail_password    = 'secret';
  • $TMP = we need to save the profile pics from Facebook and GMail somewhere on disk
  • %MONTHS = conversion table for updating birthdates on GMail
  • $facebook_ variables = numbers you get when you register an application on Facebook
  • $gmail_ variables = obviously you will need a GMail account to update your contacts
my $client = WWW::Facebook::API->new(
    desktop         => 1,
    api_version     => '1.0',
    api_key         => $facebook_api,
    secret          => $facebook_secret,
);
$client->app_id($facebook_clientid);

local $SIG{INT} = sub {
    print "Logging out of Facebookn";
    my $r = $client->auth->logout;
    exit(1);
};

my $token = $client->auth->login(browser => $facebook_browser);
$client->auth->get_session($token);

my $google = WWW::Google::Contacts->new( username => $gmail_user, password => $gmail_password );
my $http   = LWP::UserAgent->new();

In the above part a Facebook object is created and a Facebook session will be created. If this is the first run that the program runs, it will ask on a Facebook page in your browser, to allow this application. Once allowed, the Facebook page can be closed.

The script will then also create a GMail object and a LWP object. The LWP object is needed to download the profile picture from the Facebook friend page.

In the next part, the friends list will be downloaded from Facebook, binded with the fields of information we are searching for.

print "About to get friends from Facebook...n";
my $friends_info = $client->users->get_info(
        uids   => $client->friends->get, 
        fields => [ qw/name first_name last_name status pic_big birthday email website about_me/ ] 
);

foreach my $friend (@{$friends_info}){

Ok, now we are ready to start taking the information from Facebook and updating it in GMail. The next part is the full content of the foreach loop, that was started above.

    # search google contact
    print "Searching for $friend->{name}...n";
    my @contacts = $google->contacts->search({full_name => $friend->{name}});
    if(not scalar @contacts){
        print "- $friend->{name} not found in Gmail Contacts Listn";
        next;
    }

    my $contact = pop @contacts;
    next unless defined $contact;

    if( defined $friend->{birthday} and $friend->{birthday} ne ''){
        my ($month, $day, $year) = ($friend->{birthday} =~ /^(D+) (d+)(?:, (d+))/);
        if(defined $year and defined $month and defined $day){
            $day   = sprintf '%02d', $day;
            $contact->birthday("${year}-$MONTHS{$month}-$day");
        }
    }

    if( defined $friend->{about_me} and $friend->{about_me} ne ''){
        $contact->notes($friend->{about_me});
    }

    if( defined $friend->{website} and $friend->{website} ne ''){
        my $websites = $contact->website;
        $websites ||= [];
        $contact->website($friend->{website}, @$websites) 
                        unless grep /Q$friend->{website}E/, @$websites;
    }

    if( defined $friend->{email} and $friend->{email} ne ''){
        my $emails = $contact->email;
        $emails ||= [];
        $contact->email($friend->{email}, @$emails) 
                        unless grep /Q$friend->{email}E/, @$emails;
    }

    if( defined $friend->{status}->{message} and $friend->{status}->{message} ne ''){
        my $jots = $contact->jot;
        $jots ||= [];
        $contact->jot($friend->{status}->{message}, @$jots)
                        unless grep /Q$friend->{status}->{message}E/, @$jots;
    }

    eval {
        $contact->update();
        print "- Contact information updatedn";
    };
    print "- Updating ".$contact->full_name." failed: $@n" if $@;

    # First update the contact information and then update the profile photo
    if( defined $friend->{pic_big} and $friend->{pic_big} ne ''){
        my $req = HTTP::Request->new('GET', $friend->{pic_big});
        my $file = $http->request($req);

        if($file->is_success){
            my $fpic = $TMP.'/fpic'.$friend->{uid}.'.jpg';
            my $gpic = $TMP.'/gpic'.$friend->{uid}.'.jpg';

            # save the Facebook profile pic to disk
            open my $fh, '>', $fpic or die "ERROR: $!n";
            print $fh $file->decoded_content;
            close $fh;

            # create a backup of the existing profile pic and then
            # delete it from Gmail Contacts
            if ( $contact->photo->exists ) {
                eval {
                    $contact->photo->to_file($gpic);
                };
                print "- Save of GMail profile pic failed: $@n" if $@;
            }

            # if a Facebook profile pic was downloaded, now upload it to 
            # Gmail Contacts
            if ( -f $fpic ) {
                eval {
                    $contact->photo->from_file($fpic);
                    $contact->photo->update;
                    print "- Profile pic ".$contact->full_name." updatedn";
                };
                print "- Failed to update profile pic: $@n" if $@;
            }
        }
        else {
            print "Failed to download profile picture of ". $friend->{name} ."n";
        }
    }

Set Permissions on Facebook:
The Facebook application needs more permissions than the basic permissions which are granted the first time you use the application. Copy paste the following URL into browser and you will presented a Facebook to allow or disallow the extended permissions for this application:

http://www.facebook.com/dialog/oauth?client_id=141446449211973&redirect_uri=https://jmorano.moretrix.com&scope=email,read_stream,user_birthday,friends_birthday,user_website,friends_website,export_stream,friends_online_presence,friends_status,sms,user_status,friends_about_me,friends_hometown,friends_location,publish_stream,read_stream,status_update

References:

2 comments
Leave a Reply

Your email address will not be published. Required fields are marked *

This site uses Akismet to reduce spam. Learn how your comment data is processed.

Previous Post

Retrieve a file from an authenticated website (in Perl)

Next Post

Writing and reading to pipes (Perl)

Related Posts