File Coverage

blib/lib/Audio/MadJACK.pm

Criterion	Covered	Total	%
statement	4	6	66.6
branch			n/a
condition			n/a
subroutine	2	2	100.0
pod			n/a
total	6	8	75.0

package Audio::MadJACK;

################
#
# MadJACK: perl control interface
#
# Copyright 2005 Nicholas J. Humfrey
#

use Carp;

use Net::LibLO;
use strict;

use vars qw/$VERSION $ATTEMPTS/;

$VERSION="0.04";
$ATTEMPTS=5;


sub new {
    my $class = shift;

    croak( "Missing MadJACK server port or URL" ) if (scalar(@_)<1);

    # Bless the hash into an object
    my $self = {
    	pong => 0,
    	state => undef,
    	version => undef,
    	error => undef,
    	duration => undef,
    	position => undef,
    	filepath => undef
    };
    bless $self, $class;

    # Create address of MadJACK server
    $self->{addr} = new Net::LibLO::Address( @_ );
    if (!defined $self->{addr}) {
    	carp("Error creating Net::LibLO::Address");
    	return undef;
    }

    # Create new LibLO instance
    $self->{lo} = new Net::LibLO();
    if (!defined $self->{lo}) {
    	carp("Error creating Net::LibLO");
    	return undef;
    }

    # Add reply handlers
    $self->{lo}->add_method( '/deck/state', 's', \&_state_handler, $self );
    $self->{lo}->add_method( '/deck/duration', 'd', \&_duration_handler, $self );
    $self->{lo}->add_method( '/deck/position', 'd', \&_position_handler, $self );
    $self->{lo}->add_method( '/deck/filepath', 's', \&_filepath_handler, $self );
    $self->{lo}->add_method( '/version', 'ss', \&_version_handler, $self );
    $self->{lo}->add_method( '/error', 's', \&_error_handler, $self );
    $self->{lo}->add_method( '/pong', '', \&_pong_handler, $self );

    # Check MadJACK server is there
    if (!$self->ping()) {
    	carp("MadJACK server is not responding");
    	return undef;
    }

   	return $self;
}

sub load {
	my $self=shift;
	my ($filepath) = @_;
	return $self->_send( '/deck/load', 'LOADING|READY|ERROR', 's', $filepath);
}


sub play {
	my $self=shift;
	return $self->_send( '/deck/play', 'PLAYING');
}

sub pause {
	my $self=shift;
	return $self->_send( '/deck/pause', 'PAUSED');
}

sub stop {
	my $self=shift;
	return $self->_send( '/deck/stop', 'STOPPED');
}

sub cue {
	my $self=shift;
	my ($cuepoint) = @_;
	if (defined $cuepoint) {
		return $self->_send( '/deck/cue', 'LOADING|READY', 'd', $cuepoint);
	} else {
		return $self->_send( '/deck/cue', 'LOADING|READY');
	}
}

sub eject {
	my $self=shift;
	return $self->_send( '/deck/eject', 'EMPTY');
}


sub get_state {
	my $self=shift;
	$self->{state} = undef;
	$self->_wait_reply( '/deck/get_state' );
	return $self->{state};
}

sub _state_handler {
	my ($serv, $mesg, $path, $typespec, $userdata, @params) = @_;
	$userdata->{state}=$params[0];
	return 0; # Success
}

sub get_duration {
	my $self=shift;
	$self->{duration} = undef;
	$self->_wait_reply( '/deck/get_duration' );
	return $self->{duration};
}

sub _duration_handler {
	my ($serv, $mesg, $path, $typespec, $userdata, @params) = @_;
	$userdata->{duration}=$params[0];
	return 0; # Success
}

sub get_position {
	my $self=shift;
	$self->{postion} = undef;
	$self->_wait_reply( '/deck/get_position' );
	return $self->{position};
}

sub _position_handler {
	my ($serv, $mesg, $path, $typespec, $userdata, @params) = @_;
	$userdata->{position}=$params[0];
	return 0; # Success
}

sub get_filepath {
	my $self=shift;
	$self->{filepath} = undef;
	$self->_wait_reply( '/deck/get_filepath' );
	return $self->{filepath};
}

sub _filepath_handler {
	my ($serv, $mesg, $path, $typespec, $userdata, @params) = @_;
	$userdata->{filepath}=$params[0];
	return 0; # Success
}

sub get_version {
	my $self=shift;
	$self->{version} = undef;
	$self->_wait_reply( '/get_version' );
	return $self->{version};
}

sub _version_handler {
	my ($serv, $mesg, $path, $typespec, $userdata, @params) = @_;
	$userdata->{version}=$params[0].'/'.$params[1];
	return 0; # Success
}


sub get_error {
	my $self=shift;
	$self->{error} = undef;
	$self->_wait_reply( '/get_error' );
	return $self->{error};
}

sub _error_handler {
	my ($serv, $mesg, $path, $typespec, $userdata, @params) = @_;
	$userdata->{error}=$params[0];
	return 0; # Success
}

sub ping {
	my $self=shift;
	$self->{pong} = 0;
	$self->_wait_reply( '/ping' );
	return $self->{pong};
}

sub _pong_handler {
	my ($serv, $mesg, $path, $typespec, $userdata, @params) = @_;
	$userdata->{pong}++;
	return 0; # Success
}

sub get_url {
	my $self=shift;
	return $self->{addr}->get_url();
}


sub _send {
	my $self=shift;
	my ($path, $desired, $typespec, @params) = @_;
	my $state = undef;

	# Empty typespec if non specified
	$typespec = '' unless (defined $typespec);

	# Try a few times
	for(1..$ATTEMPTS) {
		my $result = $self->{lo}->send( $self->{addr}, $path, $typespec, @params );
		warn "Warning: failed to send '$path' OSC message.\n" if ($result<1);

		# Check what state the player is in now
		if (defined $desired) {
			$state = $self->get_state();
			last if ($state =~ /^$desired$/i);
		} else {
			return 0;
		}
	}

	# Finally return true if we are in desired state
	if ($state =~ /^$desired$/i) { return 1 }
	else { return 0 }
}


sub _wait_reply {
	my $self=shift;
	my ($path) = @_;
	my $bytes = 0;

	# Throw away any old incoming messages
	for(1..$ATTEMPTS) { $self->{lo}->recv_noblock( 0 ); }

	# Try a few times
	for(1..$ATTEMPTS) {

		# Send Query
		my $result = $self->{lo}->send( $self->{addr}, $path, '' );
		if ($result<1) {
			warn "Failed to send message ($path): ".$self->{addr}->errstr()."\n";
			sleep(1);
			next;
		}

		# Wait for reply within one second
		$bytes = $self->{lo}->recv_noblock( 1000 );
		if ($bytes<1) {
			warn "Timed out waiting for reply after one second.\n";
		} else { last; }
	}

	# Failed to get reply ?
	if ($bytes<1) {
		warn "Failed to get reply from MadJACK server after $ATTEMPTS attempts.\n";
	}

	return $bytes;
}


1;

__END__