#!/usr/bin/perl

# Copyright 2007 by Philipp Kolmann (philipp@kolmann.at)
#
# Revision: $Id: action_handler 163 2008-02-08 13:36:42Z pkolmann $
# SVN URL:  $HeadURL: https://wspk.zid.tuwien.ac.at/svn/skype/trunk/action_handler.pl/action_handler $
#
# 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  = "";
my $multiuser = 0;

if ($arg =~ /^(skype|callto):([\+]?[\.\w]+[;[\.\w]+]?)$/) {
    $user = $2;
    $cmd  = "call";
} elsif ($arg =~ /^(skype|callto):([\+]?[.\w]+[;[\.\w]+]?)\?(\w+)$/) {
    $user = $2;
    $cmd  = $3;
} else {
    print stderr "Invalid argument!\n";
    print stderr "Looking for skype:echo123?call\n";
    exit(-98);
}

if ($user =~ /;/) {
    $user =~ s/;/, /g;
    $multiuser = 1;
}

# 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 = call_skype($DEBUG, "NAME action_handler");
if ($answer ne "OK") {
    print stderr "Error communicating with Skype!";
    exit(-2);
}

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

$cmd = lc($cmd);
if ($cmd eq "add") {
    die ("Command add takes only one user!\n") if ($multiuser);
    call_skype($DEBUG, "OPEN ADDAFRIEND $user")
} elsif ($cmd eq "call") {
    call_skype($DEBUG, "CALL $user");
} elsif ($cmd eq "chat") {
    $answer = call_skype($DEBUG, "CHAT CREATE $user");
    my @chats = split(' ', $answer);
    call_skype($DEBUG, "OPEN CHAT ".$chats[1]);
} elsif ($cmd eq "sendfile") {
    call_skype($DEBUG, "OPEN FILETRANSFER $user");
} elsif ($cmd eq "userinfo") {
    die ("Command userinfo takes only one user!\n") if ($multiuser);
    call_skype($DEBUG, "OPEN USERINFO $user");
} else {
    print stderr "Command $cmd currently unhandled!\n";
    exit(-4);
}

exit 0;

sub call_skype() {
    my ($DEBUG, $cmd) = @_;
    print stderr "$cmd\n" if ($DEBUG > 0);
    my $answer = $api->Invoke($cmd);
    print stderr "$answer\n" if ($DEBUG > 0);
    return $answer;
}