view release on metacpan or  search on metacpan

lib/Net/DBus/Skype.pm  view on Meta::CPAN

package Net::DBus::Skype;

use Moose;
use File::Basename;
use Carp;

use Net::DBus;

our $VERSION = '0.02';

has 'debug' => ( isa => 'Bool', is => 'ro', default => 0 );

has 'dbus' => (
	isa       => 'Net::DBus'
	, is      => 'ro'
	, lazy    => 1
	, default => sub { Net::DBus->session }
);

has 'skype' => (
	isa            => 'Net::DBus::RemoteObject'
	, is           => 'rw'
	, lazy_build   => 1
);

around '_build_skype' => sub {
	my ( $sub, $self, @args ) = @_;
	my $skype = $self->$sub;
	$self->skype( $skype );
	$self->_init_skype;
	$skype;
};

sub _build_skype {
	my $self = shift;
	
	my $objects = $self->dbus
		->get_service("org.freedesktop.DBus")
		->get_object("/org/freedesktop/DBus")
	;

	my $skype_found = grep $_ eq 'com.Skype.API', @{$objects->ListNames};
	die 'No running API-capable Skype found'
		unless $skype_found
	;
	
	my $skype = $self->dbus
		->get_service('com.Skype.API')
		->get_object('/com/Skype', 'com.Skype.API')
	;

}

sub _init_skype {
	my $self = shift;

	{
		my $name = $0 eq '-e' ? 'action_handle' : File::Basename::basename($0);
		my $answer = $self->raw_skype("NAME $name");
		die 'Error communicating with Skype!'
			if $answer ne 'OK'
		;
	}

	{
		my $answer = $self->raw_skype('PROTOCOL 7');
		die 'Skype client too old!'
			if $answer ne 'PROTOCOL 7'
		;
	}

}

sub action {
	my ( $self, $arg ) = @_;

	my ( $user, $cmd, $multiuser );
	if ( $arg =~ /
		^
		(?:skype|callto|tel)
		:\/{0,2}
		([^?]+)
		(?:\??(.*))?
		$
	/x ) {
		$user = $1;
		$cmd  = $2 || 'call';
	}
	else {
		croak "Invalid argument! (format: skype:echo123?call)\n";
	}

	$multiuser = 1
		if $user =~ s/;/, /g
	;

	$cmd = lc($cmd);
	if ($cmd eq 'add') {
		croak "Command add takes only one user!\n"