File Coverage

blib/lib/Roku/RCP.pm

Criterion	Covered	Total	%
statement	15	146	10.2
branch	0	70	0.0
condition	0	39	0.0
subroutine	5	20	25.0
pod	9	13	69.2
total	29	288	10.0

# Roku::RCP.pm
#
# Copyright (c) 2007 Robert J Powers . All rights reserved.
# This program is free software; you can redistribute it and/or modify it
# under the same terms as Perl itself.

package Roku::RCP;

use strict;

use Net::Cmd;
use IO::Socket::INET;
use vars qw(@ISA $VERSION);

$VERSION = '0.08';
@ISA = qw(Net::Cmd IO::Socket::INET);

our %MetaData = ('TransactionInitiated' => 1, #Start of results
		 'ListResultSize'       => 1,
		 'ListResultEnd'        => 2, #End of results
		 'TransactionComplete'  => 2,
		 );
sub new
{
 my $self = shift;
 my $class = ref($self) || $self;
 my ($host, %args);
 $host = shift if (scalar(@_) % 2);
 %args = @_;

 $args{Host} = $host if $host;
 $args{Timeout} = 60 unless defined $args{Timeout};

 return undef unless $args{Host};

 $self = $class->SUPER::new(PeerAddr => $args{Host},
			    PeerPort => $args{Port} || '5555',
			    Proto    => 'tcp',
			    Timeout  => $args{Timeout});

 return undef unless defined $self;
 $self->debug($args{Debug});
 ${*$self}{'_RawResults'} = $args{RawResults};

 $self->autoflush(1);

 if (!$self->response("ready")) {
   $self->close();
   return undef;
 }

### if ($args{AutoRPC} && !$self->command('rcp')->response("ready")) {

 return bless $self, $class;
}

sub unRaw
{
  my $self = shift;
  my $raw = ${*$self}{'_RawResults'};
  ${*$self}{'_RawResults'} = 0;
  return $raw;
}

sub ServerConnectByName
{
    my ($self, $name) = @_;
    my (@servers, $i, $raw);
    return undef unless $name;
    $self->ServerDisconnect();

    $raw = $self->unRaw();
    @servers = $self->ListServers();
    ${*$self}{'_RawResults'} = $raw;

    foreach $i (0..$#servers) {
	if ($servers[$i] =~ m/$name/i) {
	    $self->myLog("Attempting to connect to $servers[$i]: $i");
	    return ($self->ServerConnect($i));
	    return undef;
	}
    }
    $self->myLog("No matching server found for $name");
    return undef;
}

sub PlayPlaylist
{
    my ($self, $name) = @_;
    my $raw = $self->unRaw();
    my @plists = $self->ListPlaylists();
    my $i;
    ${*$self}{'_RawResults'} = $raw;
    foreach $i (0..$#plists) {
	if ($plists[$i] =~ m/$name/i) {
	    $self->myLog("Attempting to queue and play $plists[$i]: $i");
	    $self->SetListResultType("partial");
	    $self->ListPlaylistSongs($i);
	    return $self->QueueAndPlay(0);
	}
    }
    $self->myLog("No matching playlist found for $name");
    return undef;
}

sub Standby
{
  my $self = shift;
  return $self->IrDispatchCommand('CK_POWER_OFF');
}

sub PlayArtist
{
    my ($self, $name) = @_;

    $self->myLog("Attempting to queue and play artist $name");
    $self->SetListResultType("partial") or return undef;
    $self->SetBrowseFilterArtist($name) or return undef;
    $self->ListSongs() or return undef;
    return $self->QueueAndPlay(0);
}

sub PlayAlbum
{
    my ($self, $name) = @_;

    $self->myLog("Attempting to queue and play album $name");
    $self->SetListResultType("partial") or return undef;
    $self->SetBrowseFilterAlbum($name) or return undef;
    $self->ListSongs() or return undef;
    return $self->QueueAndPlay(0);
}

sub PlaySong
{
    my ($self, $name) = @_;

    $self->myLog("Attempting to queue and play song $name");
    $self->SetListResultType("partial") or return undef;
    $self->SearchSongs($name) or return undef;
    return $self->QueueAndPlay(0);
}

sub InsertSong
{
    my ($self, $name, $position) = @_;
    $position = 1 unless defined $position;

    $self->myLog("Attempting to search for songs matching $name and insert them into Queue at position $position");
    $self->SearchSongs($name) or return undef;
    return $self->NowPlayingInsert("all", $position);
}

sub AUTOLOAD
{
  my $self = shift;
  my $rcp_cmd;
  use vars qw($AUTOLOAD);
  if ($AUTOLOAD =~ m/::([^:]+)$/o) {
    $rcp_cmd = $1;
    $self->myLog("Issuing: $AUTOLOAD @_");
    return $self->command($rcp_cmd,@_)->response(undef, $AUTOLOAD);
  }
  return undef;
}

sub Quit
{
 my $self = shift;
 $self->command("exit");
 $self->close;
}

sub DESTROY
{
 my $self = shift;

 $self->Quit if (defined fileno($self));
}

sub isMeta
{
    my ($self, $line) = @_;
    return 0 unless $line;
    return 0 unless $line =~ m/^(\S+)/o;
    $line = $1;
    return 1 if $MetaData{$line};
    return 0;
}

sub myLog
{
    my $self = shift;
    return unless ($self->debug);
    $self->debug_print(0, join("\n", @_) . "\n");
}

sub response
{
  my $self  = shift;
  my $prompt = shift;
  my $cmd = shift || "";
  my (@result, $line, $async, $nResults);

  $self->timeout(0.65);
  $async = 0;

  while (1) {
      $line = $self->getline();
      $line =~ s/[\r\n]//og;

      if (index($line, "TransactionInitiated") >= 0) {
	  $async = 1;
	  $self->myLog("Setting async to true");
      }

      if (!$line && ${*$self}{'net_cmd_partial'}) {
          $line = ${*$self}{'net_cmd_partial'};
          ${*$self}{'net_cmd_partial'} = "";
      }
      $nResults = $1 if ($line =~ m/ListResultSize (\d+)/o);

      $self->myLog("Disconnected"), return undef if (!$line && !defined(fileno($self)));
      $line =~ s/^[^:]+: //om;
      push @result, $line if ($line && (${*$self}{'_RawResults'} || !$self->isMeta($line)));
      #$self->debug_print(0, "From wire: $line\n") if ($self->debug);
      last if ((!defined $line && !$async && scalar @result) ||
               ($prompt && index($line, $prompt) >= 0) ||
               (index($line, "TransactionComplete") == 0));
  }

  $self->myLog("For cmd $cmd: got: ", @result);

  if (defined $nResults && $nResults == 0) {
    $self->myLog("Got back empty list");
    return undef;
  }

  if (index($result[$#result], "Error") < 0 &&
     index($result[$#result], "UnknownCommand") < 0) {
#index($result[$#result], $prompt) >= 0 ||
#      index($result[$#result], "TransactionComplete") >= 0) {
      push @result, "OK" unless scalar @result;
      $self->myLog("For cmd $cmd: returning: ", @result);
      return wantarray ? @result : join("\n", @result);
  }
  $self->myLog("Returning undef because of result: $result[$#result]");
  return undef;
}

1;

__END__