#!/usr/bin/perl

=head1 NAME

roxee - Remote control your Boxee from another computer

=cut

my($VERSION)='1.3';

use IO::Socket;
use IO::Select;
use IPC::Open3;
use Getopt::Long;
use File::Basename;
use Sys::Hostname;
use Pod::Usage;
use Data::Dumper;
use LWP::UserAgent;
use Tk;
use Tk::ProgressBar;
use Tk::Listbox;
use Tk::Label;
use Tk::Text;

=head1 SYNOPSIS

roxee [-pudhHv] [-s boxee] [--<jsonrpc|httpapi> port] [X11-specific options]

=head2 Options

=over 8

=item --pair or -p

Pair this program with a Boxee. This operation must be done the first
time you connect for the Boxee to develop a relationship with B<roxee>.

=item --unpair or -u

Unpair with your Boxee.  This option deletes your relationship with your
Boxee.

=item --volume or -v #

The Boxee likes to crank up the volume to 100% on boot.  For some setups,
this is very very loud.  With this option, if B<roxee> ever finds your
system volume to be 100%, it will reset it to this value.

=item --debug or -d

Run in debugging mode.  This mode will print a lot of information to the
screen.  Specifying this option twice will enable debug on the internal
JSON implementation.

=item --server or -s boxee-name

Specify the Boxee name or IP address to connect.  This overrides the
Zeroconf behavior and forces the Boxee.  This is useful if B<roxee> cannot
find your Boxee via Zeroconf, or if you have more than one Boxee.

=item --jsonrpc #

Specify an alternate port for the JSON RPC protocol to the default C<9090>.
You probably don't need to set this.

=item --httpapi #

Specify an alternate port for the HTTPAPI protocol to the default C<8800>.
You probably don't need to set this.

=item --help or -h

Print a program synopsis and exit.

=item --manual or -H

Print the full manual for B<roxee> and exit.

=item --version or -V

Print a version statement and exit.

=back

=cut

my(%ARG)=(
	'server'		=> undef,
	'jsonrpc'		=> 9090,
	'httpapi'		=> 8800,
);

my(@options)=qw(
	pair|p
	unpair|u
	volume|v=i
	debug|d+
	jsonrpc=i
	httpapi=i
	server|s=s
	help|h
	manual|H
	version|V
);

Getopt::Long::Configure('gnu_compat', 'pass_through', 'no_ignore_case');
GetOptions(\%ARG, @options);

if($ARG{'help'}) {
	pod2usage(-verbose => 1, -exitval => 0);
} elsif($ARG{'manual'}) {
	pod2usage(-verbose => 2, -exitval => 0);
} elsif($ARG{'version'}) {
	print "roxee $VERSION\n";
	exit(0);
}

my($light, $medium, $dark, $grey, $black)
	=('#7D4', '#472', '#231', '#777', '#000');

my($SOCKET)=IO::Socket::INET->new();
my($DEVICE)=hostname;
my($VOLUME)=0;

=head1 DESCRIPTION

B<roxee> is a very simple remote control application for your Boxee.
You run this software on any computer and can control various functions of
the Boxee, including navigation, volume, etc.

The B<roxee> window is very simple, it consists of a volume meter,
the Roxee logo, and a small number of buttons.
When the window has focus, the keys entered on the keyboard will be sent as
commands to your Boxee.  This window is created using the L<perl(1)>
Tk module, which must be installed on your system for B<roxee> to
function.

The small design of B<roxee> is purposeful.  It is designed so you can keep
it running in a corner of your window and input keys, control volume, etc.
quickly, and at any time.  You can run B<roxee> for days and accross reboots
of your Boxee, it will reconnect if it needs to.

=cut

sub xpm {
	my($width, $height)=(length($_[0]), scalar(@_));
	my(@xpm)=map(qq("$_",), 
		"$width $height 4 1",
		" 	c None",
		".	c $dark",
		"o	c $medium",
		"O	c $light",
		@_
	);

	return(join("\n", '/* XPM */', 'static char * image[] = {', @xpm, "};\n"));
}


my($roxee_xpm)=&xpm(
"                                     .oooo.                                  ",
"                                  .oOOOOOOOOo.                               ",
"                                 OOOOOOOOOOOOOOo                             ",
"                               oOOOOOOOOOOOOOOOOO                            ",
"                             .oOOOOOOOOOOOOOOOOOOO.                          ",
"                            .oOOOOOOOOOOOOOOOOOOOOOo                         ",
"                           .oOOOOOOOOOOOOOOOOOOOOOOO.                        ",
"                           oOOOOOOOOOOOOOOOOOOOOOOOOO.                       ",
"                          oOOOOOOOOOOOOOOOOOOOOOOOOOOo                       ",
"                         .OOOOOOOOOOOOOOOOOOOOOOOOOOOO.                      ",
"                         oOOOOOOOOOOOOOOOOOOOOOOOOOOOOO                      ",
"                        .OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOo                     ",
"                        .OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOo                     ",
"           .oo.         oOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO                     ",
"        .oOOOOOo        OOOOOOOOOOOOOOo..oOOOOOOOOOOOOOO                     ",
"       oOOOOOOOO       .OOOOOOOOOOOOO.    .OOOOOOOOOOOOO.                    ",
"     .OOOOOOOOOO       .OOOOOOOOOOOOo      oOOOOOOOOOOOO.                    ",
"    .OOOOOOOOOOo       .OOOOOOOOOOOOo      oOOOOOOOOOOOO                     ",
"   .OOOOOOOOOo.         OOOOOOOOOOOOo      oOOOOOOOOOOOO                     ",
"  .OOOOOOOOo.      ...  OOOOOOOOOOOOO.    .OOOOOOOOOOOOo                     ",
"  OOOOOOOo      .ooOOOOOOOOOOOOOOOOOOOo..oOOOOOOOOOOOOO.                     ",
" oOOOOOO.     .oOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOo                      ",
".OOOOOO.     oOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO.                     ",
"oOOOOOo    .OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO.                    ",
"OOOOOO    .OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOo.                 ",
"OOOOO.   .OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOo.              ",
"OOOOO    OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOo.           ",
"OOOOo   oOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOo.        ",
"oOOO.  .OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOo.     ",
" oo    oOOOOOOOOOOOo.  .oOOOOOOOOOOOOOOOOOOOOOOOooOOOOOOOOOOOOOOOOOOOOOOOo.  ",
"      .OOOOOOOOOOo       .oOOOOOOOOOOOOOOOOOOOOo   .oOOOOOOOOOOOOOOOOOOOOOOOo",
"      oOOOOOOOOOo          oOOOOOOOOOOOOOOOOOOo       .oOOOOOOOOOOOOOOOOOOOOo",
"      oOOOOOOOOO.            OOOOOOOOOOOOOOOOo           .oOOOOOOOOOOOOOOOOo ",
"      OOOOOOOOOo     .oo.     OOOOOOOOOOOOOOOO.             .oOOOOOOOOOOOOo  ",
"     .OOOOOOOOOo    oOOOOo     OOOOOOOOOOOOOOOO                .oOOOOOOOOo   ",
"     .OOOOOOOOOo   .OOOOOO.     OOOOOOOOOOOOOOOO                  .oOOOO.    ",
"     .OOOOOOOOOo   .OOOOOO.      OOOOOOOOOOOOOOOO                    ..      ",
"     .OOOOOOOOOo   .OOOOOO.       OOOOOOOOOOOOOOOO                           ",
"      OOOOOOOOOo    oOOOOo         OOOOOOOOOOOOOOOO                          ",
"      oOOOOOOOOO.    .oo.           OOOOOOOOOOOOOOOO                         ",
"      oOOOOOOOOOo                    OOOOOOOOOOOOOOOO                        ",
"      .OOOOOOOOOO.                    OOOOOOOOOOOOOOOO                       ",
"       OOOOOOOOOOO                     OOOOOOOOOOOOOOOO                      ",
"       oOOOOOOOOOOO                     OOOOOOOOOOOOOOOO                     ",
"        OOOOOOOOOOOO                     OOOOOOOOOOOOOOOO                    ",
"        .OOOOOOOOOOOO                     OOOOOOOOOOOOOOOO                   ",
"         oOOOOOOOOOOOO                     OOOOOOOOOOOOOOOO                  ",
"          oOOOOOOOOOOOO                     OOOOOOOOOOOOOOOO                 ",
"           oOOOOOOOOOOOO                    .OOOOOOOOOOOOOOOO.               ",
"            oOOOOOOOOOOOO                    oOOOOOOOOOOOOOOo.               ",
"             oOOOOOOOOOOOO                   .OOOOOOOOOOOOOo.                ",
"              oOOOOOOOOOOOO                   oOOOOOOOOO ..                  ",
"               oOOOOOOOOOOOO                  oOOOOOOOOO                     ",
"                oOOOOOOOOOOOO                 oOOOOOOOOO                     ",
"                 oOOOOOOOOOOOO                oOOOOOOOOO                     ",
"                  oOOOOOOOOOOOO               oOOOOOOOOo                     ",
"                   oOOOOOOOOOOOO             .OOOOOOOOO.                     ",
"                    oOOOOOOOOOOOO            oOOOOOOOOO                      ",
"                     oOOOOOOOOOOOO.         .OOOOOOOOOo                      ",
"                      oOOOOOOOOOOOOo       oOOOOOOOOOO                       ",
"                       oOOOOOOOOOOOOo.   ooOOOOOOOOOO.                       ",
"                        oOOOOOOOOOOOOOOOOOOOOOOOOOOOo                        ",
"                         oOOOOOOOOOOOOOOOOOOOOOOOOOo                         ",
"                          oOOOOOOOOOOOOOOOOOOOOOOOo.                         ",
"                           oOOOOOOOOOOOOOOOOOOOOOo.                          ",
"                            .OOOOOOOOOOOOOOOOOOOo.                           ",
"                              oOOOOOOOOOOOOOOOOo                             ",
"                               .OOOOOOOOOOOOOo                               ",
"                                 .oOOOOOOOOo.                                ",
"                                     ....                                    ",
"                                                                             ",
);

my($stop_xpm)=&xpm(
	" OOOOO ",
	" OOOOO ",
	" OOOOO ",
	" OOOOO ",
	" OOOOO ",
);

my($playpause_xpm)=&xpm(
	"OO  OO. ",
	"OO  OOO.",
	"OO  OOOO",
	"OO  OOO.",
	"OO  OO. ",
);

my($last_xpm)=&xpm(
	"  Oo  Oo",
	" Oo  Oo ",
	"Oo  Oo  ",
	" Oo  Oo ",
	"  Oo  Oo",
);

my($next_xpm)=&xpm(
	"oO  oO  ",
	" oO  oO ",
	"  oO  oO",
	" oO  oO ",
	"oO  oO  ",
);

my($minus_xpm)=&xpm(
	"       ",
	"OOOOOOO",
	"OOOOOOO",
	"       ",
	"       ",
);

my($plus_xpm)=&xpm(
	"   O   ",
	"   O   ",
	"OOOOOOO",
	"   O   ",
	"   O   ",
);

my($filemgr_xpm)=&xpm(
	"     ooo",
	"    oOOO",
	"oOOOOOOO",
	"OOOOOOOO",
	"OOOOOOOO",
);

=pod

B<roxee> works by making a L<socket(3)> call to your Boxee and
communicating via the published JSON API.  This network connection
only works if your network allows communication between
devices.

=cut

sub connect {
	my($response);
	my(%connection)=(
		'PeerAddr'	=> "$ARG{'server'}:$ARG{'jsonrpc'}",
		'Timeout'		=> 5,
		'Blocking'	=> 0,
	);

	print "Connecting to $ARG{'server'}\n" if($ARG{'debug'});
	close($SOCKET);
	if($SOCKET=IO::Socket::INET->new(%connection)) {
		$response=&remote('Device.Connect', 'deviceid' => $DEVICE);
		if(exists($response->{'error'})) {
			print "Boxee not paired, run with '--pair' option first.\n";
			print "Error from Boxee: ",$response->{'error'}{'message'}, "\n";
			exit(4);
		}
	}
}

=pod

To increase portability, B<roxee> implements it's own JSON encoding
and decoding routines.  These routines are not fully standards conformant, but
are sufficient for communicating with the Boxee JSON implementation.  These
routines are based on the L<Data::Dumper> module which is part of perl-core.

=cut

$Data::Dumper::Pair=':';
$Data::Dumper::Terse=1;

sub my_encode_json {
	my($json)=Dumper(@_);

	$json=~s/:undef/:false/g;
	$json=~s/:'false'/:false/g;
	$json=~s/:'true'/:true/g;

	#Can't Useqq=1 because it turns numeric strings to integers
	$json=~s/"/\\"/g;
	#$json=~s/([^\\])'/$1"/g;
	$json=~s/(?<!\\)'/"/g;
	$json=~s/\\'/'/g;

	print "encode= $json\n" if($ARG{'debug'}>1);
	return($json);
}

sub my_decode_json {
	my($data)=@_;

	print "decode= $data\n" if($ARG{'debug'}>1);

	$data=~s/:true/:1/g;
	$data=~s/:false/:0/g;
	$data=~s/":/"=>/g;

	return(eval($data));
}

=pod

If run in debug mode (using the C<--debug> command-line options),
B<roxee> will print all method calls and their responses to
standard output.

=cut

sub show_label {
	my($label)=&player('State')->{'state'}{'label'};
	my($showmw)=MainWindow->new(-title => 'Roxee label', -background => $black);
	my($song)=$showmw->Label(
		-textvariable => \$label,
		-foreground => $light,
		-font => [-family => 'Arial', -size => 14, -weight => 'bold'],
		-height => 1
	);
	$label=~s/\..*?$//;
	$label=~s/_/ - /g;
	$showmw->overrideredirect(1);
	$showmw->geometry('-1+1');
	$song->configure(-width => length($label)+2);
	$song->pack;

	$showmw->after(5000, sub { $showmw->withdraw });
}

sub read_announcements {
	my($connection_test)=IO::Select->new();
	my($playback)=0;

	$connection_test->add($SOCKET);

	while($connection_test->can_read(0)) {
		$recv=my_decode_json(<$SOCKET>);
		unless($recv->{'method'} eq 'Announcement') {
			print "Unexpected transmission from Boxee\n";
		}

		if($recv->{'params'}{'message'}=~m/PlaybackStarted|QueueNextItem/) {
			$playback=1;
		}

		if($ARG{'debug'}) {
			print 'recv  = ', Dumper($recv->{'params'}), "\n";
		}
	}

	&show_label if($playback);
}

sub remote {
	my($method)=shift;
	my($send)={ 'jsonrpc'=>'2.0', 'id'=>1, 'method'=>$method, params=>{@_} };
	my($recv)={};
	my($connection_test)=IO::Select->new();
	local($_);

	$connection_test->add($SOCKET);

	&read_announcements;

	print $SOCKET my_encode_json($send) if($SOCKET);
	do {
		$_='';
		if($connection_test->can_read(10)) {
			$_.=<$SOCKET> while(!m/\n$/s && $connection_test->can_read(10));
			$recv=my_decode_json($_);
			&connect unless(defined($recv));
		} else {
			&connect;
		}
	} while($recv->{'method'} eq 'Announcement');

	if($ARG{'debug'}) {
		print 'send  = ', Dumper({
					'method' => $send->{'method'},
					'params' => $send->{'params'}}),
			'recv  = ', Dumper($recv->{'result'}), "\n";
	}

	return($recv->{'result'});
}

=pod

Features which are not available via the standard Boxee GUI (such as volume
control in all applications) are always available via B<roxee>.
N.B. volume functions are purposely disables in areas of Boxee and changing
the volume can sometimes produce negative artifacts in the audio output.

=cut

sub getvolume {
	my($value)=&remote('XBMC.GetVolume');
	return(-1) if($value<0 || $value>100);

	if($value==100 && $ARG{'volume'}) {
		&remote('XBMC.SetVolume', 'value' => $ARG{'volume'});
		$value=$ARG{'volume'};
	}

	return($VOLUME=$value);
}

sub setvolume {
	my($value)=&getvolume+$_[0];
	$value-=$value%$_[0];

	return if($value<0 || $value>100);

	&remote('XBMC.SetVolume', 'value' => $value);
	$VOLUME=$value;
}

=pod

The Boxee has multiple players, and each one can play/pause/skip/etc.
B<roxee> will search for active players and send your action requests
based on the following order: Picture, Video, Audio

=cut

sub player {
	my($cmd)=shift;
	my($players)=&remote('Player.GetActivePlayers');

	if($players->{'picture'}) {
		&remote("PicturePlayer.$cmd", @_);
	} elsif($players->{'video'}) {
		&remote("VideoPlayer.$cmd", @_);
	} elsif($players->{'audio'}) {
		&remote("AudioPlayer.$cmd", @_);
	}	
}

=pod

The legacy protocol support (the XBMC HTTP port) is disabled by default
in Boxee.  You can enable this functionality by going
into the C<Settings> -> C<Network> -> C<Servers> section and check
C<Enable webserver> and make sure the port is set to the default 8800.
If you don't allow this access, the sending of printable characters will
not function.  This means, no typing into search boxes.  Hopefully this
functionality will be added into the Boxee JSON protocol before the
XBMC HTTP protocol is disabled.

=cut

sub xbmc_sendkey {
	my($key)=ord($_[0]);
	my($get)="http://%s:%d/xbmcCmds/xbmcHttp?command=SendKey(%d)";
	my($agent)=LWP::UserAgent->new('timeout' => 5);
	my($response);

	return if($key<010 || $key>177);

	$response=$agent->get(sprintf($get, @ARG{'server','httpapi'},$key|0xF100));

	if($ARG{'debug'}) {
		print "XBMC HTTP SendKey($key)=", $response->is_success, "\n";
	}

	return($response->is_success);
}

=pod

The bottom of the Roxee window has a set of icons.  These can be used if
you forget the keyboard shortcuts for actions.  These are (from left to
right) Stop, Play/Pause, Skip back, Skip forward, Volume down, Volume up,
and File manager.

=cut

sub button {
	my($mw, $pixmap, $hover)=@_;
	my($img)=$mw->Pixmap(-data => $pixmap);
	my($btn)=$mw->Label(
		-borderwidth => 0,
		-background => $black,
		-highlightthickness => 0,
		-highlightcolor => $light,
		-width => $img->width+4,
		-height => $img->height+2,
		-cursor => 'left_ptr',
		-padx => 2,
		-pady => 1,
		-image => $img,
	);

	if($hover) {
		$btn->bind('<Enter>', sub {$btn->configure(-background => $grey)});
		$btn->bind('<Leave>', sub {$btn->configure(-background => $black)});
	}

	return($btn);
}

=pod

If you have local shares mapped from your Boxee, B<roxee> can browse your
shares and play files.  B<roxee> opens a new file manager window which
allows you to navigate through your shares.  With this interface, you can
play content without the need to turn on your television.

=cut

my(%FMLIST, %SHARES);

sub display {
	my($list, $search)=@_;
	my($filter)='';

	chomp($filter=$search->Contents()) if($search);

	$list->delete(0, 'end');
	$list->insert('end', sort(grep(m/(^ \<=$|$filter)/i, keys(%FMLIST))));
	$list->activate(0);
	$list->pack(-fill => 'both', -expand => 1);
}

sub list {
	my($list, $search)=@_;
	my($item)=$list->get('active');
	my($path)=$FMLIST{$item};
	my(@files);

	print "FM Opening path: $path\n" if($ARG{'debug'}>1);

	unless($path=~m|/$|) {
		&remote('XBMC.Play', 'file' => $path);
		return();
	}
	
	%FMLIST=();
	$search->Contents('');

	$list->delete(0, 'end');
	$list->Busy();
	$list->pack;

	if($SHARES{$path}) {
		$FMLIST{' <='}='/';
	} elsif($path eq '/') {
		return(&shares($list));
	} else {
		$FMLIST{' <='}=dirname($path).'/';
	}
	@files=@{&remote('Files.GetDirectory', 'directory' => $path)->{'files'}};
	foreach my $e (@files) {
		print "fm insert $e->{'label'} : $e->{'file'}\n" if($ARG{'debug'}>1);
		$FMLIST{$e->{'label'}}=$e->{'file'};
	}

	&display($list, $search);

	$list->Unbusy();
}

sub shares {
	my($list)=shift;
	my(@shares)=();

	%FMLIST=();

	$list->Busy();
	@shares=@{&remote('Files.GetSources', 'media' => 'music')->{'shares'}};
	foreach my $e (@shares) {
		print "fm insert $e->{'label'} : $e->{'file'}\n" if($ARG{'debug'}>1);
		$FMLIST{$e->{'label'}}=$e->{'file'};
		$SHARES{$e->{'file'}}=1;
	}

	&display($list);

	$list->Unbusy();
}

=pod

All standard L<Tk::Listbox> keys apply for navigating through the 
file manager.  In addition, and to keep consistancy with the Boxee and
C<roxee>, the following keys are bound:

=over 8

=item Escape, Left

Go back

=item Return, Right

Select an item or enter a sub-directory.

=item Control-C, Control-D

Close the file manager window.

=back

=cut

sub fm {
	my($fm)=MainWindow->new(-title => 'Roxee Browser');
	my($list)=$fm->Scrolled('Listbox',
		-scrollbars => 'e',
		-foreground => $light,
		-selectbackground => $light,
		-highlightbackground => $light,
		-highlightcolor => $light,
		-selectmode => 'single',
		-borderwidth => 0,
		-selectborderwidth => 1,
		-activestyle => 'dotbox',
	);
	my($label)=$fm->Label(
		-foreground => $light,
		-anchor => 'w',
		-text => 'filter',
	);
	my($search)=$fm->Text(
		-foreground => $light,
		-highlightbackground => $light,
		-width => 16,
		-height => 1,
		-borderwidth => 1,
	);
	my($closebtn)=$fm->Button(
		-text => 'Close',
		-command => sub { $fm->withdraw },
		-foreground => $light,
		-activebackground => $light,
		-activeforeground => $black,
		-borderwidth => 0,
	);

	$fm->focusFollowsMouse;

	$list->pack();
	$label->pack(-side => 'left');
	$search->pack(-side => 'left');
	$closebtn->pack(-side => 'right');

	&shares($list);

	$fm->bind('<Control-Key-c>',	sub { $fm->withdraw; });
	$fm->bind('<Control-Key-d>',	sub { $fm->withdraw; });

	$list->bind('<Motion>',		[sub {
		$list->activate($list->nearest($_[1]));
	}, Ev('y')]);

	$list->bind('<<ListboxSelect>>',	sub { &list($list, $search); });

	$list->bind('<Key-Escape>',	sub { $list->activate(0); &list($list, $search);});
	$list->bind('<Key-Left>',	sub { $list->activate(0); &list($list, $search);});
	$list->bind('<Key-Return>',	sub { $list->eventGenerate('<Key-space>');});
	$list->bind('<Key-Right>',	sub { $list->eventGenerate('<Key-space>');});

	$search->bind('<Key>',		sub { &display($list, $search);});
}

=pod

Boxee wants you to use Zeroconf (aka Avahi or Bonjour) to discover their
device.  The B<roxee> Zeroconf implementation relies on your system having
the L<dig(1)> binary installed.  This program is installed on nearly all
Linux systems and on all Mac OSX systems.
If you wish to disable this, or you do not have the L<dig(1)> program on
your system, use the C<--server> or C<-s> command-line options to specify
the name or IP address of your boxee.  Doing so will ensure Zeroconf is
not attempted.

=cut

sub zeroconf {
	my($dig)='dig @224.0.0.251 +short +time=2 +tries=2 -p 5353 %s.local ptr |';
	my($send, $recv, $err)=(IO::Handle->new, IO::Handle->new, IO::Handle->new);
	my(@response)=();
	my($ip, $port);

	if(open($recv, sprintf($dig, @_))) {
		while(<$recv>) {
			push(@response, split);
		}
		close($recv);
		($ip, $port)=@response[-1, -4];
	} else {
		open3($send, $recv, $err, 'nslookup');
		print $send "set timeout=2\n", "set retry=2\n", "set type=PTR\n",
			"set port=5353\n", "server 224.0.0.251\n", "$_[0].local\n";
		close($send);
		while(<$recv>) {
			$port=$1 if(m/service = \d+ \d+ (\d+)/);
			$ip=$1 if(m/Address:\s+([\d.]+)/);
		}
		close($recv);
		close($err);
	}

	if($ip=~m/^[\d.]+$/ && $port=~m/^\d+$/) {
		printf("zeroconf lookup=%s:%s\n", $ip, $port) if($ARG{'debug'});
		return($ip, $port);
	} else {
		print "zeroconf lookup failed\n" if($ARG{'debug'});
		return;
	}
}

unless($ARG{'server'}) {
	my(@service)=();

	if(@service=&zeroconf('_boxee-jsonrpc._tcp')) {
		@ARG{'server', 'jsonrpc'}=@service;

		if(@service=&zeroconf('_xbmc-web._tcp')) {
			$ARG{'httpapi'}=$service[1];
		}
	} else {
		print STDERR "Could not find a Boxee on your network.  ",
			"Try the --server option.\n";
		exit(2);
	}
}

=pod

Part of the Boxee API is a device "ping".  This is done upon successful
connection with a Boxee to ensure you are talking to the right device.  If
a successful "ping" response is not received, then B<roxee> will not
attempt to pair with whatever it is talking to and will exit.

=cut

&connect;

unless(&remote('JSONRPC.Ping') eq 'pong') {
	print STDERR "Could not communicate with ",
		"$ARG{'server'} on port $ARG{'jsonrpc'}\n";
	exit(3);
}

=pod

The first time you run B<roxee>, you must "pair" it with your Boxee.
This is part of the Boxee API and a requirement for successful remote control.
When you run B<roxee> with the C<--pair> command-line option, it will
initiate the sequence for your.  You should do this with your Boxee up and
visible, as it will print a 4-digit number on your screen.  You need to enter
this 4-digit code into B<roxee> for the pairing to be successful.

=cut

if($ARG{'pair'}) {
	&remote('Device.PairChallenge',
			'deviceid'		=> $DEVICE,
			'applicationid'	=> 'roxee',
			'label'			=> 'Roxee',
			'type'			=> 'remote',
	);
	print "Enter code from Boxee: ";
	chomp($key=<STDIN>);
	&remote('Device.PairResponse', 
			'deviceid'	=> $DEVICE,
			'code'		=> "$key",
	);
	sleep(1);
}

&connect;

if($ARG{'unpair'}) {
	&remote('Device.Unpair', 'deviceid' => $DEVICE);
	exit(0);
}

=head1 FEATURES

B<roxee> waits for you to enter keys and then performs the actions
you desire.  There are no prompts and you don't have to press enter to
send events.  Just type into the B<roxee> window, and it will forward
your keystrokes.  The following keys are supported.

=over 8

=cut

my($WIDTH, $HEIGHT, $VBAR, $BBAR, $MIN, $MAX)=(81, 73, 1, 7, 3, 70);

Tk::CmdLine::SetArguments(
	-background	=> $black,
	-title		=> 'Roxee',
	-geometry		=> sprintf("%dx%d", $WIDTH, $HEIGHT+$VBAR+$BBAR),
	@ARGV
);

my($app)=MainWindow->new;
my($img)=$app->Pixmap(-data => $roxee_xpm);
my($win)=&button($app, $roxee_xpm);
my($bar)=$app->ProgressBar(
	-width => $VBAR, -height => $WIDTH,
	-from => 0, -to => 100,
	-anchor => 'w',
	-blocks => 20,
	-troughcolor => $black,
	-colors => [0 => $light, 40 => 'yellow' , 75 => 'red'],
	-variable => \$VOLUME,
);
my($stopbtn)=&button($app, $stop_xpm, 1);
my($playpausebtn)=&button($app, $playpause_xpm, 1);
my($lastbtn)=&button($app, $last_xpm, 1);
my($nextbtn)=&button($app, $next_xpm, 1);
my($minusbtn)=&button($app, $minus_xpm, 1);
my($plusbtn)=&button($app, $plus_xpm, 1);
my($fmbtn)=&button($app, $filemgr_xpm, 1);

$app->Icon(-image => $img);
$win->repeat(600000, \&getvolume);
$win->repeat(10000, \&read_announcements);
$bar->pack;
$win->pack;

$stopbtn->pack(-side => 'left');
$playpausebtn->pack(-side => 'left');
$lastbtn->pack(-side => 'left');
$nextbtn->pack(-side => 'left');
$minusbtn->pack(-side => 'left');
$plusbtn->pack(-side => 'left');
$fmbtn->pack(-side => 'right');

$app->focusFollowsMouse;

&getvolume;

=item Control-O or F-4

Open a file manager window to navigate and select a file for playback.
This action is also available as an icon on the bottom-right corner
of the B<roxee> window.

=cut

$app->bind('<Key-F4>',			\&fm);
$app->bind('<Control-Key-o>',		\&fm);
$fmbtn->bind('<Button-1>',		\&fm);

=item Control-C or Control-D

Exit B<roxee>, closing the window.

=cut

$app->bind('<Control-Key-c>',		sub {$SOCKET->close(); exit(0)});
$app->bind('<Control-Key-d>',		sub {$SOCKET->close(); exit(0)});

=item Up, Right, Down, and Left

Using your arrow keys, you can control selected items.

=cut

$app->bind('<Key-Up>',			sub {&remote('Input.Up')});
$app->bind('<Key-Right>',		sub {&remote('Input.Right')});
$app->bind('<Key-Down>',			sub {&remote('Input.Down')});
$app->bind('<Key-Left>',			sub {&remote('Input.Left')});

=item Home

Go back to the Boxee home page.

=cut

$app->bind('<Key-Home>',			sub {&remote('Input.Home')});

=item F-3

Toggle Mute.

=cut

$app->bind('<Key-F3>',			sub {&remote('XBMC.ToggleMute')});

=item F-5, -

Volume down.
This action is also available as an icon on the bottom
of the B<roxee> window.

=cut

$app->bind('<Key-F5>',			sub {&setvolume(-5)});
$app->bind('<Key-minus>',		sub {&setvolume(-5)});
$minusbtn->bind('<Button-1>',		sub {&setvolume(-5)});

=item F-6, +, =

Volume up.
This action is also available as an icon on the bottom
of the B<roxee> window.

=cut

$app->bind('<Key-F6>',			sub {&setvolume(5)});
$app->bind('<Key-plus>', 		sub {&setvolume(5)});
$app->bind('<Key-equal>', 		sub {&setvolume(5)});
$plusbtn->bind('<Button-1>',		sub {&setvolume(5)});

=item Escape

Go back

=cut

$app->bind('<Key-Escape>',		sub {&remote('Input.Back')});

=item Enter

Select item or simulate mouse click

=cut

$app->bind('<Key-Return>',		sub {
	my($state)=&remote('Input.NavigationState');
	if($state && $state->{'state'}{'mouse-enabled'}) {
		&remote('Input.MouseClick');
	} else {
		&remote('Input.Select');
	}
});

=item `

Toggle Play/Pause.  This action is also available as an icon on the bottom
of the B<roxee> window.

=cut

$app->bind('<Key-quoteleft>',		sub {&player('PlayPause')});
$playpausebtn->bind('<Button-1>',	sub {&player('PlayPause')});

=item End

Stop playing. This action is also available as an icon on the bottom
of the B<roxee> window.

=cut

$app->bind('<Key-End>',			sub {&player('Stop')});
$stopbtn->bind('<Button-1>',		sub {&player('Stop')});

=item <, >

Goto next or previous items in playlist.
These actions is also available as icons on the bottom
of the B<roxee> window.

=cut

$app->bind('<Key-less>',			sub {&player('SkipPrevious')});
$lastbtn->bind('<Button-1>',		sub {&player('SkipPrevious')});
$app->bind('<Key-greater>',		sub {&player('SkipNext')});
$nextbtn->bind('<Button-1>',		sub {&player('SkipNext')});

=item [, ]

Move forward or backward in the current track by 10 seconds.

=cut

$app->bind('<Key-bracketleft>',	sub {&player('SmallSkipBackward')});
$app->bind('<Key-bracketright>',	sub {&player('SmallSkipForward')});

=item {, }

Leap forward or backward in the current track by one minute.

=cut

$app->bind('<Key-braceleft>',		sub {&player('BigSkipBackward')});
$app->bind('<Key-braceright>',	sub {&player('BigSkipForward')});

=item Mouse click

The left (or otherwise primary) mouse click will send the same event to
the Boxee.

=cut

$win->bind('<Button-1>',			sub {&remote('Input.MouseClick')});

=item Insert or Right mouse click

Take control of the mouse so motions can be sent to the Boxee.  The cursor
will change to help signify the difference in modes.  You will not be able
to leave the B<roxee> application until you press the C<Insert> key
again.

=cut

my($GRAB, $OLDX, $OLDY)=(0, 0, 0);

$app->bind('<Key-Insert>',		[sub {
	if($GRAB) {
		$app->grabRelease;
		$win->configure(-cursor => 'left_ptr');
		$GRAB=0;
	} else {
		$app->grabGlobal;
		$win->configure(-cursor => 'mouse');
		($OLDX, $OLDY)=@_[1,2];
		$GRAB=1;
	}
}, Ev('x'), Ev('y')]);
$app->bind('<Button-3>',			sub {$app->eventGenerate('<Key-Insert>')});

$app->bind('<Motion>',			[sub {
	my($x, $y)=@_[1,2];
	my(%motion);

	return unless($GRAB);

	if($x<$MIN) {
		$app->eventGenerate('<Motion>', -warp => 1, -x => $MAX, -y => $y);
		$OLDX=$WIDTH;
	} elsif($y<$MIN) {
		$app->eventGenerate('<Motion>', -warp => 1, -x => $x, -y => $MAX);
		$OLDY=$HEIGHT;
	} elsif($x>$MAX) {
		$app->eventGenerate('<Motion>', -warp => 1, -x => $MIN, -y => $y);
		$OLDX=$MIN;
	} elsif($y>$MAX) {
		$app->eventGenerate('<Motion>', -warp => 1, -x => $x, -y => $MIN+$VBAR);
		$OLDY=$MIN;
	} elsif($x==$MIN || $y==$MIN+$VBAR || $x==$MAX || $y==$MAX) {
		return;
	} else {
		$motion{'deltax'}=($x-$OLDX)*2;
		$motion{'deltay'}=($y-$OLDY)*2;

		&remote('Input.MouseMovement', %motion)
			if($motion{'deltax'} || $motion{'deltay'});

		($OLDX, $OLDY)=($x, $y);
	}
}, Ev('x'), Ev('y')]);

=item All else

send the key, this uses the legacy protocol and only works when it is
enabled on your Boxee.

=cut

$app->bind('<Key>',				[sub {
	&xbmc_sendkey($_[1]);
}, Ev('A')]);

=back

=head1 NOTES

B<roxee> should run forever as long as you don't try to communicate
with it while the Boxee is off-line.  If you want to exit, enter Control-C
or Control-D in the B<roxee> window, and it will exit.

=cut

MainLoop;

exit(-1); #This shouldn't happen

=head1 RETURN VALUE

=over 8

=item 0

B<roxee> completed successfully.

=item 1

An invalid command-line option was specified.

=item 2

B<roxee> could not find your boxee.  Try specifying it on the command-line.

=item 3

Attempts to communicate with the remote device via the Boxee published
JSON API failed.

=item 4

B<roxee> received an error during connection with the Boxee.  You probably
need to pair the device with Boxee first.  See the C<--pair> command-line
option for instructions.

=back

=head1 AUTHOR

William Totten

=head1 COPYRIGHT

Copyright (C) 2011 William Totten

License GPLv2: GNU GPL version 2
<http://www.gnu.org/licenses/old-licenses/gpl-2.0.html>.

This is free software: you are free  to  change  and  redistribute  it.
There is NO WARRANTY, to the extent permitted by law.

=head1 SEE ALSO

L<perl>, L<IO::Socket::INET>, Tk, L<http://developer.boxee.tv/JSON_RPC>,
L<http://roxee.glaciated.org/>

=cut