#!/usr/bin/perl

# Copyright 2007 by Philipp Kolmann (philipp@kolmann.at)
#
# Version 0.5
# Date    July 31st, 2007
#
# This needs the Perl DBus module.
#
# In Debian you can get it via: apt-get install libnet-dbus-perl

# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
# USA
#
use strict;
use Net::DBus;
my $DEBUG = 0;

# Parse args
if ($#ARGV != 0) {
    print stderr "Usage: ./action_handler SkypeCommand\n";
    exit(-99);
}
my $arg = $ARGV[0];

# Split ARG skype:echo123?call
my $user = "";
my $cmd  = "";
if ($arg =~ /^skype:(\w+)\?(\w+)$/) {
    $user = $1;
    $cmd  = $2;
} else {
    print stderr "Invalid argument!\n";
    print stderr "Looking for skype:echo123?call\n";
    exit(-98);
}

# go for the session bus
my $bus = Net::DBus->session;

my $system_service_list = $bus->get_service("org.freedesktop.DBus");
my $objects = $system_service_list->get_object("/org/freedesktop/DBus");

my $skype_api_found = 0;
foreach my $service (@{$objects->ListNames}) {
     if ($service eq 'com.Skype.API') {
         $skype_api_found = 1;
	 last;
     }
}

if (!$skype_api_found) {
    print stderr 'No running API-capable Skype found';
    exit(-1);
}

my $skype = $bus->get_service("com.Skype.API");

my $api = $skype->get_object("/com/Skype", "com.Skype.API");

my $answer = $api->Invoke('NAME action_handler');
print stderr "$answer\n" if ($DEBUG > 0);

if ($answer ne "OK") {
    print stderr "Error communicating with Skype!";
    exit(-2);
}

$answer = $api->Invoke('PROTOCOL 7');
print stderr "$answer\n" if ($DEBUG > 0);

if ($answer ne "PROTOCOL 7") {
    print stderr "Skype client too old!";
    exit(-3);
}

$cmd = lc($cmd);
if ($cmd eq "call") {
    $answer = $api->Invoke("CALL $user");
    print stderr "$answer\n" if ($DEBUG > 0);

} elsif ($cmd eq "chat") {
    $answer = $api->Invoke("CHAT CREATE $user");
    print stderr "$answer\n" if ($DEBUG > 0);
    my @chats = split(' ', $answer);
    $answer = $api->Invoke("OPEN CHAT ".$chats[1]);
    print stderr "$answer\n" if ($DEBUG > 0);

} else {
    print stderr "Command $cmd currently unhandled!\n";
    exit(-4);
}