File Coverage

blib/lib/Audio/JackMiniMix.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::JackMiniMix;

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

use Carp;

use Net::LibLO;
use strict;

use vars qw/$VERSION $ATTEMPTS/;

$VERSION="0.02";
$ATTEMPTS=5;


sub new {
    my $class = shift;

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

    # Bless the hash into an object
    my $self = {
    	channel_count => 0,
    	channels => {},
    	pong => 0
    };
    bless $self, $class;

    # Create address of JackMiniMix 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( '/mixer/channel/gain', 'if', \&_channel_gain_handler, $self );
    $self->{lo}->add_method( '/mixer/channel/label', 'is', \&_channel_label_handler, $self );
    $self->{lo}->add_method( '/mixer/channel_count', 'i', \&_channel_count_handler, $self );
	$self->{lo}->add_method( '/pong', '', \&_pong_handler, $self );

    # Get the number of channels
    if (!$self->channel_count()) {
    	carp("JackMiniMix server is not responding");
    	return undef;
    }

   	return $self;
}

sub channel_count {
	my $self=shift;
	$self->{channel_count} = 0;
	$self->_wait_reply( '/mixer/get_channel_count' );
	return $self->{channel_count};
}

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

sub get_channel_gain {
	my $self=shift;
	my ($channel) = @_;
	croak "Total number of channels is unknown" unless ($self->{channel_count});
	$self->{channels}->{$channel}->{gain} = undef;
	$self->_wait_reply( '/mixer/channel/get_gain', 'i', $channel );
	return $self->{channels}->{$channel}->{gain};
}

sub set_channel_gain {
	my $self=shift;
	my ($channel,$gain) = @_;
	croak "Total number of channels is unknown" unless ($self->{channel_count});
	$self->_wait_reply( '/mixer/channel/set_gain', 'if', $channel, $gain );
	return 1 if ($self->{channels}->{$channel}->{gain} == $gain);
	return 0; # Failed
}

sub _channel_gain_handler {
	my ($serv, $mesg, $path, $typespec, $userdata, @params) = @_;
	my ($channel, $gain) = @params;

	# Check channel exists
	if (!exists $userdata->{channels}->{$channel}) {
		$userdata->{channels}->{$channel} = {};
	}

	# Store the gain
	$userdata->{channels}->{$channel}->{gain} = $gain;

	return 0; # Success
}


sub get_channel_label {
	my $self=shift;
	my ($channel) = @_;
	croak "Total number of channels is unknown" unless ($self->{channel_count});
	$self->{channels}->{$channel}->{label} = undef;
	$self->_wait_reply( '/mixer/channel/get_label', 'i', $channel );
	return $self->{channels}->{$channel}->{label};
}

sub set_channel_label {
	my $self=shift;
	my ($channel,$label) = @_;
	croak "Total number of channels is unknown" unless ($self->{channel_count});
	$self->_wait_reply( '/mixer/channel/set_label', 'is', $channel, $label );
	return 1 if ($self->{channels}->{$channel}->{label} == $label);
	return 0; # Failed
}

sub _channel_label_handler {
	my ($serv, $mesg, $path, $typespec, $userdata, @params) = @_;
	my ($channel, $label) = @params;

	# Check channel exists
	if (!exists $userdata->{channels}->{$channel}) {
		$userdata->{channels}->{$channel} = {};
	}

	# Store the label
	$userdata->{channels}->{$channel}->{label} = $label;

	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 _wait_reply {
	my $self=shift;
	my (@args) = @_;
	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}, @args );
		if ($result<1) {
			warn "Failed to send message (".join(',',@args)."): ".$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 JackMiniMix server after $ATTEMPTS attempts.\n";
	}

	return $bytes;
}


1;

__END__