#!/usr/bin/perl -w

# This is a very basic example on how to use the Skype API via DBus using perl.
# Written by jlh at gmx dot ch.  I declare this to be public domain, use it for
# whatever you like.

# This requires the module Net::DBus to be installed.

use strict;
use warnings;

package SkypeAPI; # -----------------------------------------------------------

# We need two objects to communicate with Skype, one for the client -> Skype
# direction, and one for Skype -> client direction.  This class (SkypeAPI)
# inherits from Net::DBus::Object and represents the DBus /com/Skype/Client
# object that Skype uses to notify us about events (by calling its Notify
# method).  The other object, which is Skype's /com/Skype object, is held in
# $self->{invoker}; we call its Invoke method to tell Skype our commands.

# This class by itself only does the handshake with Skype and then merely
# prints all notifications it receives to the terminal.  If you want to do
# something useful, then you have to subclass this and override the Notify
# method to do whatever you want.  We do this as an example with the Example
# class further down.

use base 'Net::DBus::Object';
use Net::DBus;

sub new {
	my ($class, $name) = @_;

	my $bus = Net::DBus->session;

	# export a service and the object /com/Skype/Client, so Skype can
	# invoke the 'Notify' method on it in order to communicate with us.
	my $exp_service = $bus->export_service("com.Skype.API") or die;
	my $self = $class->SUPER::new($exp_service, '/com/Skype/Client') or die;
	bless $self, $class;

	# get a handle to Skype's /com/Skype object, so we can invoke the
	# 'Invoke' method on it to communicate with Skype.
	my $service = $bus->get_service("com.Skype.API") or die;
	$self->{invoker} = $service->get_object("/com/Skype") or die;

	# setup is done, let's shake hands
	my $r = $self->Invoke("NAME $name");
	die "Handshake failed: $r" unless $r eq 'OK';
	$r = $self->Invoke("PROTOCOL 5");
	die "Handshake failed: $r" unless $r eq 'PROTOCOL 5';

	return $self;
}

sub Notify {
	# only print to terminal.  override this in a subclass for something
	# more useful.
	my ($self, $string) = @_;
	print "Notify <- $string\n";
	if ( $string =~ m{CHATMESSAGE (\d+) STATUS RECEIVED} ) {
		my $id = $1;
		my $body = $self->Invoke("GET CHATMESSAGE $id BODY");
		print "# $body\n";
		my $chat = $self->Invoke("GET CHATMESSAGE $id CHATNAME");
		my $o = $self->Invoke($body);
		print "# $o\n";
		$self->Invoke("CHATMESSAGE $chat $o");
	}

	# be careful with what you return here!  DBus will try to serialize it,
	# returning it to skype.  you should explicitely return something
	# simple to avoid to leak something unserializable, causing odd errors.
	return 0;
}

sub Invoke {
	# this doesn't print $string, so that subclasses can call it without
	# that side effect.  subclass it yourself if you want it to do that.
	my ($self, $string) = @_;
	print "Invoke -> $string\n";
	my $response = $self->{invoker}->Invoke($string);
	print "Invoke <- $response\n";
	if ( $string =~ s/^get //i ) {
		$response =~ s/^\Q$string\E *//;
	}
	return $response;
}

package Example; # ------------------------------------------------------------

# This Example class inherits from SkypeAPI and does something very simple:
# Whenever you go into away-mode, it will put you in not-available-mode
# instead.  That's not very useful, but it's just an example.  This is where
# you would implement your interesting stuff and/or write a nicer wrapper
# around the whole Skype API.

use base 'SkypeAPI';

sub Notify {
	my ($self, $string) = @_;

	# call the parent's Notify method, so it still prints to the terminal.
	$self->SUPER::Notify($string);

	if ($string eq 'USERSTATUS AWAY') {
		# away mode is no good!  let's be not available
		$self->Invoke('SET USERSTATUS NA');
	}

	if ( $string =~ m{CALL (\d+) STATUS RINGING} ) {
		$self->Invoke("ALTER CALL $1 ANSWER");
	} elsif ( $string =~ m{CALL (\d+) STATUS INPROGRESS} ) {
		my $call_id = $1;
		my $port = 5000 + $call_id;

		my $gst = qq{
			gst-launch -v 
			tcpserversrc port=$port !
			"audio/x-raw-int,rate=16000,width=16,channels=1" !
			wavenc !
			filesink location=/tmp/$port.wav
		};
		$gst =~ s{[\s\n\r]+}{ }gs;

		warn "# $gst\n";
		open(my $g, '-|', $gst) || die $!;
		while(<$g>) {
			warn "## $_";
			last if m/PREROLL/;
		}

		$self->Invoke(qq|ALTER CALL $call_id set_output port="$port"|);
	} elsif ( $string =~ m{CALL (\d+) STATUS FINISHED} ) {
		my $port = $1 + 5000;
		my $path = "/tmp/$port.wav";
		warn "# $path ", -s $path, " bytes\n";
#	} elsif ( $string =~ m{} ) {
	}

	return 0;
}

package main; # ---------------------------------------------------------------

use Net::DBus::Reactor;

my $skype = Example->new('Example');

# Run main event loop, the $skype instance has automatically been attached to
# it (it's a singleton).  See the documentation for Net::DBus::Reactor to learn
# how to attach more stuff to this loop, like file handles or timer events.
my $reactor = Net::DBus::Reactor->main;
$reactor->run;

# end of file
