The Apache configuration in the below example will actually require 2 web servers:

• one proxy host, which will accept the SSL connection, verify, check for ACLs and then forward the connection unencrypted internally
• one internal web server which will actually contain the WebAPI scripts

This article explains how to use Mojolicious for the WebAPI side and LWP::UserAgent to send and receive the WebAPI calls. We will furthermore use JSON to send and receive information.

First we need to have or create a set of OpenSSL certificates.
The below example uses self signed certificates, since they don’t cost any money and suit perfect for the purpose of this example.
There a million howto’s on the internet which explains these steps very thoroughly, so I won’t reinvent the wheel. I’m just going to post the steps I took to create:

• a CA certificate
• a client certificate
• a server certificate

cd /path/to/SSL
cp /etc/ssl/openssl.cnf example.cnf
vim example.cnf  # Edit the file to your needs
openssl genrsa -aes256 -out private/example_com_ca.key 4096
openssl req -config example.cnf -new -x509 -extensions v3_ca -key private/example_com_ca.key -out certs/example_com_ca.crt -days 3650
openssl req -config example.cnf -new -nodes -keyout private/client01.key -out client01.csr -days 365
openssl ca -config example.cnf -policy policy_anything -out certs/client01.crt -infiles client01.csr
openssl req -config example.cnf -new -nodes -keyout private/server.key -out server.csr -days 365
openssl ca -config example.cnf -policy policy_anything -out certs/server.crt -infiles server.csr

Next we will need to configure our web server (this example uses the Apache web server) in order to use our self signed certificates, and to proxy forward our WebAPI calls.

SSLEngine on
SSLCertificateFile       /path/to/SSL/certs/server.crt
SSLCertificateKeyFile    /path/to/SSL/private/server.key
SSLCertificateChainFile  /path/to/SSL/certs/example_com_ca.crt
SSLCACertificateFile     /path/to/SSL/certs/example_com_ca.crt
SSLVerifyClient require

ProxyPass /send/         http://internal-host/send.pl/
ProxyPassReverse /send/  http://internal-host/send.pl/

<Proxy *>
            Options FollowSymLinks MultiViews
            AllowOverride All
            Order deny,allow
            allow from localhost
            allow from 8.8.8.8 # The client IP address
            deny from all
</Proxy>

The above the configuration for the external proxy server. The internal web server should have a pretty straight-forward configuration:

• a cgi-handler for the Perl extension ‘.pl’

I could have also send those proxy requests to an internal Mojolicious application, listening on a specific port. I’ll leave that for another article.

The test client script is going to make a SSL connection to the external web server, send some JSON and wait for the server to send some JSON data back. The interesting part in the below script is how to set up the SSL connection.

#!/usr/bin/perl
use strict; use warnings;

use HTTP::Request;
use LWP::UserAgent;
use IO::Socket::SSL;
use JSON;

my $data = {
    username  => 'skipper',
    password  => 'secret',
    variable  => 'value',
};

my $uri = 'https://example.com/send/event';
my $json = encode_json( $data );
my $req = HTTP::Request->new( 'POST', $uri );
$req->header( 'Content-Type' => 'application/json' );
$req->content( $json );
 
my $lwp = LWP::UserAgent->new(
    ssl_opts => {
        SSL_use_cert    => 1,
        SSL_version     => 'TLSv12',
        SSL_verify_mode => SSL_VERIFY_PEER,
        SSL_ca_file     => "/path/to/SSL/certs/example_com_ca.crt",
        SSL_cert_file   => "/path/to/SSL/certs/client01.crt",
        SSL_key_file    => "/path/to/SSL/private/client01.key",
    },
) or die "SSL Connection failed: $!";
my $res = $lwp->request( $req );
if ($res->is_success) {
    print "RESPONSE:", $res->content . "\n";
} 
else {
    print "ERROR: ", $res->status_line . "\n";
}

The server example uses the Mojolicious frame work. Mojolicious is the porn for every Perl WebAPI developer. If you don’t know it, you should be ashamed and start reading about it right away.

#!/usr/bin/env perl
 
use Mojolicious::Lite;

# A helper to identify visitors
helper whois => sub {
    my $c               = shift;
    my $headers         = $c->req->headers;
    my $agent           = $c->req->headers->user_agent || 'Anonymous';
    my $local_ip        = $c->tx->remote_address;
    my $remote_ip       = $headers->header('x-forwarded-for');

    return { 
        agent      => $agent, 
        local_ip   => $local_ip,
        remote_ip  => $remote_ip,
   };
};

any '/' => sub {
  my $c = shift;
  $c->render( text => "There is nothing to see here, move along" );
};
 
post '/event' => sub {
    my $c = shift;
    my $json = $c->req->json;
    my $data = {
        username        => $json->{username},
        password        => $json->{password},
        whois           => $c->whois,
    };
    $c->render( json => $data );
};



### IMPORTANT
app->secret('some_cool_secret');
app->start;

Example output of the test client script:

$ perl test_send.pl 
RESPONSE:
{"whois":{"remote_ip":"176.9.64.17","agent":"libwww-perl\/6.04","local_ip":"176.9.64.17"},"password":"secret","username":"skipper"}

These new features now simply for instance saving web forms in your Postgresql database. Or actually any kind of dynamic data, such as for instance Perl hashes. Plus, thanks to the new JSON functions, this data can be easily searched and indexed.

Let’s start with creating a test table.

CREATE SEQUENCE data_seq    
    START WITH 1    
    INCREMENT BY 1    
    NO MINVALUE    
    NO MAXVALUE    
    CACHE 1;

CREATE TABLE data (    
    id bigint DEFAULT nextval('data_seq'::regclass) NOT NULL,
    form_name TEXT,
    form_data JSON
);

I’ve inserted into this table 100k rows of test data with a very simple Perl script.

#!/usr/bin/perl
use strict;
use DBI;
use AnyEvent;
use AnyEvent::Util;
$AnyEvent::Util::MAX_FORKS = 25;

print "Inserting test data...\n";
my $cv = AnyEvent->condvar;
$cv->begin;
foreach my $d (0..100000){
    $cv->begin;
    fork_call {
        my($d) = @_;
        my $name = do{local $/; open my $c, '-|', 'pwgen -B -s -c1 64'; <$c>};
        chomp($name);
        my $dbh = DBI->connect("dbi:Pg:host=/var/run/postgresql;dbname=test;port=5432",'postgres', undef);
        $dbh->do(qq{insert into data (form_name,form_data) VALUES('test_form', '{"c":{"d":"ddddd"},"name":"$name","b":"bbbbb", "count":$d}')});
        $dbh->disconnect;
        return $d;
    } $d,
    sub {
        my ($count) = @_;
        print "$d ";
        $cv->end;
    }
} 
$cv->end;
$cv->recv;
print "\n\nDone\n";

Now let’s assume that the JSON data we are going to insert (or have inserted) always contains the attribute field ‘name’. On this attribute we will create the following database index:

CREATE INDEX ON data USING btree (form_name, json_extract_path_text(form_data,'name'));

The above example creates a multi-column index.

Now let’s a make our first test.
The first test will not use the index we have created previously.

EXPLAIN ANALYZE VERBOSE SELECT * FROM data WHERE form_name = 'test_form' AND form_data->>'name' = 'cbcO5twuPnAYJ1VLV6gsEv9zWs2AbQxQ9PoALLr2w6Rwpr2PtoQHCCK0hyOMuIME';
                                                                             QUERY PLAN                                                                              
---------------------------------------------------------------------------------------------------------------------------------------------------------------------
 Seq Scan on data  (cost=0.00..4337.28 rows=500 width=102) (actual time=28.608..129.945 rows=1 loops=1)
   Filter: ((data.form_name = 'test_form'::text) AND ((data.form_data ->> 'name'::text) = 'cbcO5twuPnAYJ1VLV6gsEv9zWs2AbQxQ9PoALLr2w6Rwpr2PtoQHCCK0hyOMuIME'::text))
   Rows Removed by Filter: 100000
 Total runtime: 129.968 ms
(5 rows)

130ms for searching through 100k rows, is actually quite ok.

Now let’s see how we can speed up this query by using the index we’ve created.

EXPLAIN ANALYZE VERBOSE SELECT * FROM data WHERE form_name = 'test_form' AND json_extract_path_text(form_data,'name') = 'cbcO5twuPnAYJ1VLV6gsEv9zWs2AbQxQ9PoALLr2w6Rwpr2PtoQHCCK0hyOMuIME';
                                                                             QUERY PLAN                                                                                                
---------------------------------------------------------------------------------------------------------------------------------------------------------------------
 Index Scan using data_form_name_json_extract_path_text_idx on data  (cost=0.42..8.44 rows=1 width=102) (actual time=0.056..0.057 rows=1 loops=1)
   Index Cond: ((data.form_name = 'test_form'::text) AND (json_extract_path_text(data.form_data, VARIADIC '{name}'::text[]) = 'cbcO5twuPnAYJ1VLV6gsEv9zWs2AbQxQ9PoALLr2w6Rwpr2PtoQHCCK0hyOMuIME'::text))
 Total runtime: 0.084 ms
(4 rows)

0.084ms! That’s is about 1625 times faster! What makes this index extremely interesting is that the index has only been created on one attribute of the JSON data and not on the entire JSON data. This will keep the index data small and thus will be kept longer in your database’ memory.

• sorted
• searched
• paginated
• scroll infinitely
• themed
• …

And most important: it’s for free! I’ve always wanted to create an infinite scrolling table and now it’s just too easy:

$(document).ready( function() {
    oTable = $('#ip_data').dataTable( {
        "bProcessing":     true,
        "bServerSide":     true,
        "bPaginate":       true,  
        "bScrollInfinite": true,
        "bScrollCollapse": true,
        "sScrollY":        "200px",
        "sAjaxSource":     "get_ip_data.pl",
    } );
} );

And that’s it! Well, ok, you need to include the Javascript file and CSS files of the Datatables Project of course and you need to create the table in HTML.

For instance:

And then you will need a Perl script providing you the data for the table.
The below example allows to

• search the tables
• scroll infinitely
• sort on the columns

It also supplies the Datatables table with a total amount or rows in the database table.

This following script will be saved as ”get_ip_data.pl”

#!/usr/bin/perl
use strict; use warnings;
use DBI;
use JSON;
use CGI;

my @columns = qw/ip country_name city latitude longitude/;

my $q = CGI->new;
my $db = DBI->connect("dbi:mysql:host=localhost;db=testdb", 'testuser', 'xxxsecret');

my $params = $q->Vars;

# Get the total count of rows in the table
my $sql_count = "select count(id) from geo_data";
my $count = $db->selectrow_arrayref($sql_count)->[0];

# Start building up the database query
my @values;
my $sql = "select ip,country_name,city,latitude,longitude from geo_data";

# if a search parameter was supplied in the AJAX call, build the WHERE part in the SQL statement
if( $params->{sSearch} ){
    $sql .= ' WHERE ';
    $sql .= 'ip LIKE ? OR country_name LIKE ? or city LIKE ? or latitude LIKE ? or longitude LIKE ?';
    push @values, ('%'.$params->{sSearch}.'%','%'.$params->{sSearch}.'%','%'.$params->{sSearch}.'%','%'.$params->{sSearch}.'%','%'.$params->{sSearch}.'%');
}

# if a sorting parameter was supplied in the AJAX call, build up the ORDER BY part in the SQL statement
if( $params->{iSortingCols} ){
    $sql .= ' ORDER BY';
    foreach my $c (0 .. ( $params->{iSortingCols} -1 )){
        $sql .= ' ' . $columns[ $params->{"iSortCol_$c"} ] . ' ' . $params->{"sSortDir_$c"};
        $sql .= ','
    }
    $sql =~ s/,$//;
}

# Limit the output and also allow to paginate or scroll infinitely
$sql .= " LIMIT ? OFFSET ?";
push @values, (($params->{iDisplayLength} > 0 ? $params->{iDisplayLength} : 25), ( $params->{iDisplayStart} // 0));

# Fetch the data from the database
my $data = $db->selectall_arrayref($sql, { Slice => [] }, @values);

# Return the JSON object
print $q->header('application/json');
my $json = encode_json({ aaData => $data, iTotalRecords => $count, iTotalDisplayRecords => $count, sEcho => int($params->{sEcho}) });
print $json;

An example can be found overhere: http://www.moretrix.com/~insaniac/map/map.pl

Before we look at the Google API for GeoChart, let’s first set up a script which will get data out of a database and return it in a JSON formatted object.
In this example we will use Perl and three Perl modules:

• DBI
• JSON
• CGI

When converting database values to a JSON object (or text string), it is very important that all data is properly type-casted.
In the following example you will see that we do:

$_->[1] = int($_->[1]) foreach @$data;

This snippet will actually make our INTEGER value into a real integer. The DBI module had returned it as a normal string (that’s just how DBI works).

#!/usr/bin/perl
use strict; use warnings;
use DBI;
use JSON;
use CGI;

my $q = CGI->new;
my $db = DBI->connect("dbi:mysql:host=localhost;db=testdb", 'testuser', 'xxxsecret');

my $sql = "SELECT country_name, count(id) as total from geo_data group by country_name";
my $data = $db->selectall_arrayref($sql);
$_->[1] = int($_->[1]) foreach @$data;
unshift(@$data, ['Country', 'Attacks']);

print $q->header('application/json');
my $json = encode_json($data);
print $json;

The above Perl script will be saved as ”get_countries_data.pl”.

In the below Javascript example, we will use the Google API for the GeoChart Map and jQuery for making the AJAX call to our Perl script. Since the Perl script already provides the data in a JSON format, we do not need to convert or parse it.
Furthermore the Javascript code is pretty straightforward and based on the example found at https://developers.google.com/chart/interactive/docs/gallery/geochart, except for the AJAX part.

    google.load('visualization', '1', {packages: ['geochart']});
    google.setOnLoadCallback(drawVisualization);

    function drawVisualization() {
        var options = {
            height: '500',
            width: '1200',
            colorAxis: {minValue: 0,  colors: ['#FFC26B', 
                                               '#FFAF3B', 
                                               '#FF9700', 
                                               '#C1852F', 
                                               '#A86400']},
            datalessRegionColor: '#FAFAFA',
            backgroundColor: '#F4EFE7',
        };
    
        $.ajax({
            type: 'POST',
            url: "get_countries_data.pl",
            dataType: "json",
            async: false,
            success: function(json_data) {
                var data = google.visualization.arrayToDataTable(json_data);
                var chart = new google.visualization.GeoChart(
                                   document.getElementById('visualization') );

                chart.draw(data, options);
            }
        });
    }

An example of this setup can be found at http://www.moretrix.com/~insaniac/map/map.pl

Nowadays, a lot of people have iPhone or like me, an Android phone. A descent Android phone contains a GPS device. A GPS device connected to a computer (or Android phone) could record your GPS positions during a certain period. Ok … that’s cool actually!
Because, when you’re shooting photos, you practically always have your mobile phone with you!

So, all we need now is a handy tool on your Android phone, which will record or track your GPS positions during a certian period. Behold ‘Open GPS Tracker‘. Open GPS Tracker is a tool which allows you to track your GPS positions and then afterwards, when you stop the program, you can export and share this information. The export is done using the GPX format, sharing is done through email.

Of course, any GPS device (plus software) which generates GPX files, will do just fine

This GPX file is nothing more than an XML file. And XML files are easy to parse in Perl using the XML::LibXML module.
We will also need to other CPAN modules, Date::Parse and Image::ExifTool. The first one is used to parse the date strings in the GPX XML file and the date strings in the EXIF information of the photo. The second module is used to read the EXIF information into a Perl hash.

use strict; use warnings;
use XML::LibXML;
use Image::ExifTool;
use Date::Parse;

use constant MAX_TIME_THRESHOLD => 10;

my ($gpx_file) = './Track201104180901.gpx';
my ($gpx_obj)  = XML::LibXML->new() ;
my $xml        = $gpx_obj->parse_file($gpx_file);
my $root       = $xml->getDocumentElement;

my $gps_db;
foreach my $pt ( $root->getElementsByTagName('trkpt') ) {
    my($lat)  = $pt->findvalue('@lat');
    my($lon)  = $pt->findvalue('@lon');
    my($alt)  = $pt->getElementsByTagName('ele')->[0]->textContent();
    my($time) = $pt->getElementsByTagName('time')->[0]->textContent();
    my $utime = str2time($time);

    $gps_db->{$utime} = {
        'time'   => $time,
        'lat'    => $lat,
        'lon'    => $lon,
        'alt'    => $alt,
    };
}

In this first part, we read in the XML file and store relevant information – like latitude, longitude and altitude – in a hash.

When the hash is ready, we can start scanning some photos.

my @images = (qw/jmp151.jpg jmp152.jpg jmp154.jpg/);
foreach my $img (@images) {
    my $exif = Image::ExifTool->new();
    my $info = $exif->ImageInfo($img);
    if(not defined $info->{GPSLatitude} and not defined $info->{GPSLongitude}){
        next unless $info->{DateTimeOriginal};
        my $data = get_gps_fix($info->{DateTimeOriginal});
        
        next unless defined $data and keys %{$data};

        $exif->SetNewValue('GPSLatitude',  $data->{lat});
        $exif->SetNewValue('GPSLongitude', $data->{lon});
        $exif->SetNewValue('GPSAltitude',  $data->{alt});

        if( $exif->WriteInfo($img) ){
            print "Image [$img] EXIF info has been successfully updatedn";
        }
    }
}

sub get_gps_fix {
    my($time) = @_;
    $time =~ s/ /T/;
    $time =~ s/$/Z/;
    my $utime = str2time($time);

    for(my $count=0; $count < MAX_TIME_THRESHOLD; $count++) {
        my $index = $utime - $count;
        if(exists $gps_db->{"$index"}){
            return $gps_db->{"$index"}
        }
    }
}

I’m using a constant called MAX_TIME_THRESHOLD, because it may happen that at a certian timestamp, no GPS position was recorded or available. The threshold I use goes back maximum 10 seconds before giving up. Moreover, if the logging density has been set to Fine, Open GPS Tracker should record also every second a GPS position.

One thing you don’t have to do with those online services like Flickr etc. is generating smaller sizes of your photos, also called thumbnails. But if you maintain your own website, you will have to downsize them on your own.
Being a programmer, I’m the happiest when I’m the laziest. So, in case of websites and photos, I don’t want to create the zillion of thumbnails that I need on my page.
Zillion? Isn’t that a little bit exajurated? Well, mostly you will need more than one thumbnail for every picture you will upload:
– one thumbnail is needed for on the thumbnail page
– one smaller thumbnail is needed for a small thumbnail preview bar
– one even smaller thumbnail is needed for marking the photo on a Google Map
– one smaller sized photo is needed for previewing it on the website
– and finally the original image is also put available for download on the site

We’ll need at least 4 extra images for every photo. Okay, I could generate all those thumbs at home and then upload them all together, but that is wasting bandwidth and time and we know how precious they both are.

Being a programmer in my professional life, I have the deviation to automate everything I know or do, with a Perl script. And this situation is again perfect for such a script.

First of all, the following code will make heavy use of the Image::Magick Perl module, which can be downloaded from either CPAN or your distro’s repositry.

The several steps of manipulating the original image, were actually inspired by the following two links:
– http://www.imagemagick.org/Usage/thumbnails/#glass_bubble
– http://stackoverflow.com/questions/3973392/facebook-like-resizing-of-images-using-imagemagick

The second link explains how to resize and crop, the first link explains how create neat thumbnails using rounded corners, lighting effects and more. Now, both links give examples using the command line Image Magick tools. I’ve seen a lot of code which will call these command line tools instead of using the Image::Magick module. That is of course, NOT the way.

On with creating our thumbnails! First, the image needs to be resized:

my $img = 'image.png';
my $magick = new Image::Magick;
$magick->Read($img);
my ($width, $height) = $magick->Get('width', 'height');

$magick->Resize(geometry => int($width/2).'x'.int($height/2));
$magick->Resize(geometry => '180x');
$magick->Resize(geometry => 'x180<');
   
my($nwidth, $nheight) = $magick->Get('width', 'height');
my $xpos = int(( $nwidth - 120 ) / 2) - 60;
my $ypos = int(( $nheight - 120 ) / 2) - 60;
$magick->Crop(geometry => "120x120+$xpos+$ypos", gravity => 'Center');

The above code will generate a thumbnail which are 120px by 120px big (or small), using a cropped field out of the 180px by 180px scaled image. The position of the cropped field is somewhat in the middle of the image, where usually the object of the photo can be found.

Next we’ll add some effects to our downsized image. We’ll do this by cloning the resized Image Magick object, that was created in the code above:

my $thumb_mask = $magick->Clone();

Once the object has been cloned, we can start by adding effects to the new object:

$thumb_mask->Set('alpha' => 'Off');
$thumb_mask->Colorize( fill => 'white', opacity => '100%' );

$thumb_mask->Draw( fill => 'black',
                   primitive => 'polygon',
                   points => '0,0 0,15 15,0');
$thumb_mask->Draw( fill => 'white',
                       primitive => 'circle',
                       points => '15,15 15,0');
my $new_2 = $thumb_mask->Clone();
$new_2->Flip();
$thumb_mask->Composite( compose => 'Multiply', 'image' => $new_2 );

my $new_3 = $thumb_mask->Clone();
$new_3->Flop();
$thumb_mask->Composite( compose => 'Multiply', 'image' => $new_3 );

$thumb_mask->Set('background' => 'Gray50');
$thumb_mask->Set('alpha' => 'Shape');

$thumb_mask->Raise(raise => 'True', geometry => '4x4');

By now we should have a rounded gray icon, based on the size of the thumbnail we’ve created above.

Next we will create some lighting and shading effects so that the thumbnail will look more like a button.

my $thumb_lighting = $thumb_mask->Clone();
$thumb_lighting->Set('bordercolor' => 'None');
$thumb_lighting->Set('border'      => '1x1');
$thumb_lighting->Set('alpha'       => 'Extract');
$thumb_lighting->Blur('geometry'       => '0x10');
$thumb_lighting->Shade(geometry => '80x40');
$thumb_lighting->Set('alpha'       => 'On');
$thumb_lighting->Set('background'  => 'Gray50');
$thumb_lighting->Set('alpha'       => 'Background');
$thumb_lighting->AutoLevel(channel => 'alpha');
$thumb_lighting->[-1]->Function(function => 'polynomial', parameters => [3.5, -5.05, 2.05, 0.3]);

my $new_4 = $thumb_lighting->Clone();
$new_4->Set(alpha => 'Extract');
$new_4->Blur(geometry => '0x2');

$thumb_lighting->Composite(compose => 'Multiply', image => $new_4);
$thumb_lighting->Chop(geometry => '1x1');

Finally, all that rests is putting all the images togehter and saving the file to disk:

$magick->Set('alpha' => 'On');
$magick->Composite(compose => 'HardLight', image => $thumb_lighting);
$magick->Set('alpha' => 'Copy');
$magick->Composite(compose => 'CopyOpacity', image => $thumb_mask);
$magick->Write('thumbnail.png');

Important to know is, since creating rounded corner will add some transparency to the original image, the newly created thumbnail must be save as either a GIF or PNG image, while those are the only two image formats which support transparency in images.

I’m going to use to beef up my image browser which I quickly wrote to simply the contents of directory full with images. (can be found overhere http://yamamoto.moretrix.com/~insaniac/grtp/

Here’s the link to the article.

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:

• http://developers.facebook.com/docs/reference/api/user/
• http://developers.facebook.com/docs/authentication/
• http://search.cpan.org/~merixzon/WWW-Google-Contacts-0.28/lib/WWW/Google/Contacts.pm
• http://search.cpan.org/~unobe/WWW-Facebook-API-0.4.18/lib/WWW/Facebook/API.pm

Working as a contractor, we have to fill in timesheets which have to be approved and so. Now, I also like to view in my agenda when I’ve worked and how long. This information is important at the end of the month when creating an invoice (which state the number of days I’ve worked).

The project management tool at my current job, sends out emails when a certain period has been approved by my manager. The email body looks somewhat like this:

Name:        Morano, Johnny
Status:      Approved
Week Ending: 25-Dec-2010
Manager:     Name, Manager
                                 HOURS                                 
=======================================================================
Ln|Work Request   |Act |  Sun|  Mon|  Tue|  Wed|  Thu|  Fri|  Sat|Total
-----------------------------------------------------------------------
1 |xxxxxx         |COD | 0.00| 8.00| 8.00| 8.00| 8.00| 0.00| 0.00|32.00
-----------------------------------------------------------------------
TOTAL                  | 0.00| 8.00| 8.00| 8.00| 8.00| 0.00| 0.00|32.00
=======================================================================

                                DETAILS                                
=======================================================================
Ln|Work Request Name        |Activity       |Site  |Asset    |SubAsset 
-----------------------------------------------------------------------
1 |xxxxxxxxxx               |Code & UnitTest|XXXXXX|XXXXX    |N/A      
=======================================================================

                            TIMESHEET NOTES                            
=======================================================================
 
=======================================================================

These emails all get sorted in my Courier IMAP email server into a specific mailbox, e.g. ‘INBOX.Moretrix.Timesheets’.

My agenda is currently held at Google Calendar, which is an excellent tool for creating private and public agenda’s.

The programming language I’ve used is, of course, Perl. In Perl, there are easy to use modules like Net::IMAP::Simple and Net::Google::Calendar which are going to help us building this automated process.

We will need to gather some information, before we start writing our code. The following is required:
– IMAP user login account
– IMAP password
– IMAP mailbox
– GMail user account
– GMail password
– Google Calendar name (you need to create a separate calendar in Google Calendar, I’ve called mine ‘Business’

The header of script shows which modules to use:

#!/usr/bin/perl
use strict; use warnings;

use Net::IMAP::Simple::SSL;
use Email::Simple;
use DateTime;
use Net::Google::Calendar;

my %months = (
    Jan => 1, May => 5, Sep => 9,
    Feb => 2, Jun => 6, Oct => 10,
    Mar => 3, Jul => 7, Nov => 11,
    Apr => 4, Aug => 8, Dec => 12,
);

my($imap_host, $imap_user, $imap_pass, $scan_box);
my ($gmail_username, $gmail_password, $gmail_calendar);
$imap_user      ||= 'IMAP username';
$imap_pass      ||= 'IMAP password';
$imap_host      ||= 'IMAP host';
$scan_box       ||= 'INBOX.Moretrix.Timesheets';
$gmail_username ||= 'GMail user@gmail.com';
$gmail_password ||= 'GMail password';
$gmail_calendar ||= 'Business';

This part is pretty basic and requires no explanation.

The following part will try to connect to the IMAP server and initialize a connection to the Google Calendar.

my $imap = Net::IMAP::Simple::SSL->new($imap_host)
        or die "Unable to connect to IMAP server: $Net::IMAP::Simple::errstr n";
die( "Login failed: " . $imap->errstr . "n" ) unless $imap->login($imap_user, $imap_pass);

my $number_of_messages = $imap->select($scan_box);
if( not defined $number_of_messages ){
    error "failed to get number of messages for $scan_box: " . $imap->errstr();
    next
}

#
# Log in on Google Calendars
#
my $gcal = Net::Google::Calendar->new();
$gcal->login($gmail_username, $gmail_password);
info "Logged in to Google Calendars";

#
# Search my 'Business' calendar
#
for my $c ($gcal->get_calendars) {
    debug "Calendar title: ". $c->title;
    debug "Calendar ID   : ". $c->id;
    if($c->title eq $gmail_calendar){
        $gcal->set_calendar($c);
        debug "Found calendar $gmail_calendar...";
        debug $c->title." has ".scalar($gcal->get_events)." events";
        last;
    }
}

Still no rocket science, we use the modules like they are described in their perldoc pages, and finally we search for the calendar we want to edit in Google Calendars.

So at this point we have an IMAP connection and a connection to Google Calendars. Now we will loop through all the messages in the configured IMAP folder and start parsing the messages.
We will only need the ‘TOTAL’ lines with all the working hours and the line stating ‘Week Ending’. The latter is used to calcute the dates of the working hours.
Since this IMAP folder also contains other emails than the timesheet emails, we’ll refine our search procedure by taking only those emails that match a certain subject.

#
# Loop through the emails
#
foreach my $message ( 1 .. $number_of_messages ){
    my $header = $imap->top($message);
    (warning( "No header found: ", $imap->errstr() ), next) unless $header;

    my $email = Email::Simple->new(join '', @{ $header });
    (warning( "No Email::Simple object", $imap->errstr() ), next) unless $email;

    next unless $email->header('Subject') =~ /Approved Business Timesheet/;

    info sprintf("n[%03d] %-29s | %-56s", $message, $email->header('Date'), $email->header('Subject'));

At this point, we know that the mail message number (which is in $message) is an email that we need to parse.
Now we will grab the information required from the body of the email and start the calculation of the dates.

    # Grab data from email body
    my $body = $imap->get( $message ) or die $imap->errstr;
    $body = "$body";
    my($week_ending) = ($body =~ /Week Ending:([^n]*)/m);
    my($totals)      = ($body =~ /TOTAL([^n]*)/m);
    $week_ending              =~ s/s+//g;
    $totals                   =~ s/s+//g;

    # Create DateTime object based on the 'Week Ending' string in the body of the email
    my($day,$month,$year) = split /-/, $week_ending;
    my $date_obj  = DateTime->new(year => $year, month => $months{$month}, day => $day);
    $date_obj->set(hour => 0);
    $date_obj->set(minute => 0);
    $date_obj->set(second => 0);
    $date_obj->set_time_zone('Europe/Brussels');
    # subtract 5 days since Week Ending shows Saturday, but we start on Monday
    $date_obj->subtract(days => 5);

In the next part, we cleanup the @totals array, since we don’t need the days Sunday and Saturday, nor do we need the grand total displayed in the email.

    #
    # Cleanup the @totals
    #
    my (@totals) = split /|/, $totals;
    # last value is grand total, we dont need that
    pop(@totals);
    # last value now is saturday, we dont need that
    pop(@totals);
    # first value is empty due to the leading | in $totals
    shift(@totals);
    # first value is sunday, we dont need that
    shift(@totals);

The comments in the code explain enough.
Now that we have our totals (which are the values per day), we can loop through the days and create the appropriate calendar items:

    # loop through the days of the week
    foreach my $t (@totals){

        # skip days with 0 working hours
        next unless $t > 0;

        # These values are to narrow down the search for Google Calendars events
        my $day_start  = DateTime->from_object(object => $date_obj);
        my $day_end    = DateTime->from_object(object => $date_obj);
        $day_end->add(days => 1);

        # Start and end time of the event we want to create/update
        my $start_date = DateTime->from_object(object => $date_obj);
        my $end_date   = DateTime->from_object(object => $date_obj);
        $start_date->add(hours => 9);
        $end_date->add(hours => 9 + $t);

        # Print some logging
        info 'From: '.$start_date->dmy. ' '.$start_date->hms. " | ".
             'Until: '.$end_date->dmy. ' '.$end_date->hms. "  => $t hours";

        # Create the author contact person
        my $author = Net::Google::Calendar::Person->new();
        $author->name('Johnny Morano');
        $author->email('johnny.morano@gmail.com');

        # Create Google Calendar entry object
        my $entry = Net::Google::Calendar::Entry->new();
        $entry->title('Approved Business Timesheet');
        $entry->content(
            "Worked $t hours. ".
            'From: ' .$start_date->dmy. ' '.$start_date->hms. " | ".
            'Until: '.$end_date->dmy  . ' '.$end_date->hms . 
            " Approved in email from " . $email->header('Date')
        );
        $entry->location('Leuven, Belgium');
        $entry->when($start_date, $end_date);
        $entry->author($author);

        my @cal_events = $gcal->get_events('start-min' => $day_start, 'start-max' => $day_end);
        my $found   = 0;
        foreach my $e (@cal_events) {
            if($e->title =~ /Approved Business Timesheet/){
                my $changes = 0;
                ($e->title($entry->title()), $changes++)            if $e->title    ne $entry->title;
                ($e->content($entry->content()), $changes++)        if $e->content  ne $entry->content;
                ($e->location($entry->location()), $changes++)      if $e->location ne $entry->location;
                ($e->when($entry->when()), $changes++)              if $e->when     ne $entry->when;
                ($e->author($entry->author()), $changes++)          if $e->author   ne $entry->author;

                if($changes){
                    $gcal->update_entry($e) if $changes;
                    info " --> UPDATED CALENDAR ENTRY with $changes changes";
                    $found++; last;
                }
            }
        }
        if(not $found){
            $gcal->add_entry($entry);
            info " --> ADDED CALENDAR ENTRY";
        }

        # go to next day
        $date_obj->add(days => 1);
    }

}

So using CSS and Javascript, this was actually a pretty easy job to do. The only hard thing to do, was making it browser indepedent. But in the end, even this wasn’t so hard at all since most of these steps have been thoroughly described on the Interweb.

What we will need is

• a CSS file
• a JavaScript file
• a HTML file

The CSS portion is actually very easy:
– Save this into a file called style.css

#blanket {
    display: block;
    position:absolute;
    width:100%;
    height: 100%;
    top:0px;
    left:0px;
    z-index: 9998;
    background-color:#111;
    opacity: 0.65;
    filter:alpha(opacity=65);
}
#popUpDiv {
    display: block;
    position:absolute;
    width:450px;
    height:500px;
    z-index: 9999;
    overflow: auto;
    padding-left: 4px;
    padding-right: 4px;
    background-color:#eeeeee;
}

As you can see: no rocket science. We create two layers: blanket and popUpDiv. The blanket layer will create a gray transparent layer over the entire page. The popUpDiv layer will create … well, I think it’s clear what this layer will do

The JavaScript portion contains a bit more code. It will contain four functions:

• toggle(): toggle the visibility of a layer
• create_blanket(): calculate the size of the blanket and display
• create_popup(): calculate the position of the popup layer and display
• popup(): wrapper function which calls toggle(), create_blanket(), create_popup()

Let’s start with the toggle() function, because that’s the shortest and easiest one.

function toggle(div_id) {
        var el = document.getElementById(div_id);

        if (el.style.display == 'none') {
                el.style.display = 'block';
        }
        else {
                el.style.display = 'none';
        }
}

Again, no rocket science. This procedure has been described and explained a million times on the Interweb, I will not redo it overhere.

Secondly, the create_blanket() function requires a bit more attention, since it’s more than 4 lines of code.
In this function, we will try to get the window height. We’ll do this in two different ways: one for Mozilla based browsers, one for Internet Exploder browsers.

if (typeof window.innerHeight != 'undefined') {
    height = window.innerHeight;
}
else {
    height = document.documentElement.clientHeight;
}

But then again … we could have just called document.documentElement.clientHeight since this is also supported by Mozilla based browsers.
The variable height will contain the browser height.
But, since we don’t all have huge screens which eliminates the usage of scrollbars, we will have to check if this height variable is smaller or bigger than the scroll area of the browser.

if ((height > document.body.parentNode.scrollHeight)
        && (height > document.body.parentNode.clientHeight)) {

        blanket_height = height;
}
else {
        if (document.body.parentNode.clientHeight > document.body.parentNode.scrollHeight) {
                blanket_height = document.body.parentNode.clientHeight;
        }
        else {
                blanket_height = document.body.parentNode.scrollHeight;
        }
}

And finally we’ll create this blanket:

var blanket = document.getElementById('blanket');
blanket.style.height = blanket_height + 'px';

So on with the create_popup() function. This function will first retrieve information about the different dimensions required to calculate the position of the popup. The following information is required:

• scroll_width: amount of pixels scrolled from left
• scroll_height: amount of pixels scrolled from top
• client_width: width of the browser (without scrollbars, menubars, padding, …)
• client_height: height of the browser (without scrollbars, menubars, padding, …)
• popup_width: popup width defined in CSS stylesheet file
• popup_height: popup height defined in CSS stylesheet file

First the scroll width and scroll height:

if( typeof( window.pageYOffset ) == 'number' ) {
        //Netscape compliant
        scroll_height = window.pageYOffset;
        scroll_width = window.pageXOffset;
} 
else if( document.body
        && ( document.body.scrollLeft || document.body.scrollTop ) ) {
        //DOM compliant
        scroll_height = document.body.scrollTop;
        scroll_width = document.body.scrollLeft;
} 
else if( document.documentElement
        && ( document.documentElement.scrollLeft
            || document.documentElement.scrollTop ) ) {
        //IE6 standards compliant mode
        scroll_height = document.documentElement.scrollTop;
        scroll_width = document.documentElement.scrollLeft;
}

Secondly the client height and width:

var client_height = document.body.parentNode.clientHeight;
var client_width  = document.body.parentNode.clientWidth;

And last the popup height and width as stated in the CSS stylesheet file:

var popup_height = parseInt(window.getComputedStyle(popUpDiv, "").getPropertyValue('height'));
var popup_width  = parseInt(window.getComputedStyle(popUpDiv, "").getPropertyValue('width'));

We need to wrap these values from the CSS stylesheet file around the JavaScript function parseInt() since the .getPropertyValue() function will return the values with ‘px’ at the end. (e.g.: 400px)

Based on the above information, the position from top and left will be calculated:

var left    = client_width  / 2 + scroll_width  - (popup_width / 2);
var top     = client_height / 2 + scroll_height - (popup_height / 2);

The only thing left to do is, is sending these position values to the browser by simply changing the CSS values for this DIV object:

popUpDiv.style.left  = left + 'px';
popUpDiv.style.top   = top + 'px';

The final function, popup(), will be the wrapper function called from within the HTML code.

function popup(windowname) {
    create_blanket(windowname);
    create_popup(windowname);
    toggle('blanket');
    toggle(windowname);
}   

So now we only need some HTML code to test this!
Click here to have a demo page (so where you could do right click + ‘View Source’)