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"
			if $multiuser
		;
		$self->raw_skype("OPEN ADDAFRIEND $user")
	}
	
	elsif ($cmd eq 'call') {
		$self->raw_skype("CALL $user");
	}
	
	elsif ($cmd eq 'chat') {
		my $answer = $self->raw_skype("CHAT CREATE $user");
		my @chats = split(' ', $answer);
		$self->raw_skype("OPEN CHAT ".$chats[1]);
	}
	
	elsif ($cmd eq 'sendfile') {
		$self->raw_skype("OPEN FILETRANSFER $user");
	}
	
	elsif ($cmd eq 'userinfo') {
		croak "Command userinfo takes only one user!\n"
			if $multiuser
		;
		$self->raw_skype("OPEN USERINFO $user");
	}

	else {
		croak "Command $cmd currently unhandled!\n";
	}

}


sub raw_skype {
	my ($self, $cmd) = @_;

	my $answer = $self->skype->Invoke($cmd);
	print "$cmd: $answer\n" if $self->debug;
	
	return $answer;
}

1;

__END__

=head1 NAME

Net::DBus::Skype - Perl access to Skype's DBus API

=head1 DESCRIPTION

This module supplies a perl API into Skype via DBus. It was inspired by the discussion at L<http://forum.skype.com/lofiversion/index.php/t92761.html>, and adapted from Philipp Kolmann's code base. Nothing much of Philipps code remains other than his choice of error messagses.

B<If what your doing isn't specific to Skype, use the non proprietary "callto" protocol in your code! Example, href="callto:8325555555">

=head1 SYNOPSIS

	use Net::DBus::Skype;

	my $s = Net::DBus::Skype->new;
	my $s = Net::DBus::Skype->new({ debug => 1 });

	$s->action('skype:echo123?call');
	# -or-
	$s->action('skype:echo123');
	# -or-
	$s->action('skype://echo123');
	# -or-
	$s->raw_skype('CALL echo123');

=head1 SCRIPTS

This module also installs two scripts, B<skype-action-handler>, and B<skype-simple-dialer>. The first script, skype-action-handler, takes Skype action uris on the command line and simply creates an instance and feeds them to C<-E<gt>action>. The second script, skype-simple-dialer, takes a phone number, and simply feeds it to the C<-E<gt>raw_skype> CALL. The skype-action-handler script should be fully compatable with the C program by the same name that once was distributed with Skype.

=head1 METHODS

=head2 ->action

Takes a skype pseudo-uri, or pseudo-url, ex. skype://echo123?call. This is parsed into three components: protocol, user, and command. Valid options for protocol are "skype", "callto", and "tel". It is then translated into raw_skype and sent off through the DBus communication link. The default command is I<call>.

=head2 ->raw_skype

Issuess raw_skype commands exposed through the DBus API. An example of this command would be, "CALL echo123".

=head1 AUTHOR

Evan Carroll, C<< <me at evancarroll.com> >>

=head1 BUGS

Please report any bugs or feature requests to C<bug-net-dbus-skype at rt.cpan.org>, or through
the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Net-DBus-Skype>.  I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.

=head1 SUPPORT

You can find documentation for this module with the perldoc command.

perldoc Net::DBus::Skype


You can also look for information at:

=over 4

=item * RT: CPAN's request tracker

L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Net-DBus-Skype>

=item * AnnoCPAN: Annotated CPAN documentation

L<http://annocpan.org/dist/Net-DBus-Skype>

=item * CPAN Ratings

L<http://cpanratings.perl.org/d/Net-DBus-Skype>

=item * Search CPAN

L<http://search.cpan.org/dist/Net-DBus-Skype>

=back


=head1 ACKNOWLEDGEMENTS


=head1 COPYRIGHT & LICENSE

Copyright 2008 Evan Carroll, all rights reserved.

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.


=cut