callbacks results from the CPAN

Audio-Radio-Sirius

package Audio::Radio::Sirius;

use 5.008;

use warnings;
use strict;

use Carp;
use Time::HiRes qw(sleep); # need to sleep for milliseconds in some receive loops

=head1 NAME

Audio::Radio::Sirius - Control a Sirius satellite radio tuner

=head1 VERSION

Version 0.03

=cut

our $VERSION = '0.03';
our $AUTOLOAD;

our %DEFAULTS = (
	power 	=> 0,
	connected	=> 0,
	channel	=> 0,
	gain		=> 0,
	debug		=> 0,
	mute		=> 0,
	verbosity	=> 0,
	_sequence	=> 0,
	_serial	=> undef,
	_lastack	=> -1,
	_lastreq	=> -1,
	_callbacks	=> {
		'channel_update'	=> undef,
	},
	_buffer	=> '',
);

our %SETTABLE = (
	debug		=> 1,
);

our %COMMANDS = (
	poweroff		=> '000800',
	reset			=> '0009',
	poweron		=> '000803',
	volume		=> '0002',
	mute			=> '0003',
	channel		=> '000a', channel_suffix	=> '000b',
	request_signal	=> '4018',
	request_unkn1	=> '4017',
	request_sid		=> '4011',
	verbosity		=> '000d000000'
);

our %UPDATES = (
	'2008' 	=> {
		name		=> 'power',
		handler	=> undef
	},
	'2002'	=> {
		name		=> 'volume',
		handler	=> undef
	},
	'2003'	=> {
		name		=> 'mute',
		handler	=> undef
	},
	'200a'	=> {
		name		=> 'channel',
		handler	=> \&_channel_update,
		removefirst	=> 4
	},
	'200d'	=> {
		name		=> 'verbosity',
		handler	=> undef
	},
	'6011'	=> {
		name		=> 'reply_sid',
		handler	=> undef
	},
	'6017'	=> {
		name		=> 'reply_unkn1',
		handler	=> undef
	},
	'6018'	=> {
		name		=> 'reply_signal',
		handler	=> undef
	},
	'8001'	=> {
		name		=> 'channel_info',
		handler	=> \&_channel_item_update,
		removefirst	=> 2

lib/Audio/Radio/Sirius.pm view on Meta::CPAN


  $tuner->channel(100); # Tune directly to channel 100

=cut
sub channel {
	my $self = shift;
	if (!ref($self)) { croak "$self isn't an object"; }

	my ($chanreq, $offsetreq) = @_;
	my $offset = 0;

	if (!defined($chanreq)) { return $self->{channel}; } # accessor
	if (defined($offsetreq) && ($offsetreq =~ /0|1|-1/) ) { $offset = $offsetreq; }

	### TODO: Channel validation.

	# channel command: $COMMAND, channel, [0,1,-1], $COMMAND suffix
	my $chanhex = $self->_num_to_unsigned_hex($chanreq);
	my $offsethex = $self->_num_to_signed_hex($offset);
	my $cmd = $COMMANDS{channel} . $chanhex . $offsethex . $COMMANDS{channel_suffix};
	return $self->_send_command($cmd);	
}

=head2 monitor (cycles)

Monitor is called to watch for updates from the tuner.  The Sirius tuner is pretty chatty and sends relevant data, such as Artist/Title updates, 
PIDs, signal strength, and other information.  Calling monitor initiates reads of this data.

Reads happen automatically when commands are executed (for example changing the channel or muting the tuner).  Still, monitor generally needs
to be called as often as possible to gather the latest data from the Tuner.

A monitor cycle will take a minimum of one second.  If data is received, this timer resets.  In other words, monitor may take longer than you anticipate.
The amount of time monitor takes will depend on the C<verbosity> of the tuner.

If no number of cycles is specified, monitor runs one cycle.

B<Note:> As of version 0.02, the cycle parameter is no longer a true count of the number of cycles.  The number specified is multiplied by 20.
Each cycle now sleeps 50 msec so the result is roughly the same, although this may increase the drift of cycles vs. seconds even more.

  $tuner->monitor(5); # spin 5 times

=cut

sub monitor {
	my $self = shift;
	if (!ref($self)) { croak "$self isn't an object"; }

	my ($spins) = @_;

	if (!defined($spins)) { $spins = 1; }
	$spins = $spins * 20;
	foreach (1..$spins) {
		$self->_receive_if_waiting;
		sleep (.05); # chill .05 second
	}
}

=head2 set_callback (callback type, function reference)

When the tuner sends an update, such as new artist/title information on the current channel, it may be helpful to execute some code which handles this
event.  To accomidate this, you may define function callbacks activated when each event occurs.  Note that some of the parameters below are marked with 
an asterisk.  This indicates that they may be undefined when your function is called.  You should account for this in your callback function.

=head3 channel_update (channel, *pid, *artist, *title, *composer)

 $tuner->set_callback ('channel_update', \&channel);

 sub channel {
	my ($channel, $pid, $artist, $title, $composer) = @_;
	print "Channel $channel is now playing $title.\n";
 }

=head3 signal_update

Not yet implemented.

=head3 time_update

Not yet implemented.

=head3 status_update

Not yet implemented.

=cut

sub set_callback {
	my $self = shift;
	if (!ref($self) eq 'CODE') { croak "$self isn't an object"; }
	my ($reqtype, $funcref) = @_;
	if (!ref $funcref) { croak "$funcref must be a reference to a function"; }
	if (!exists($DEFAULTS{'_callbacks'}{$reqtype}) ) { croak "$reqtype is not a supported update type"; }
	# validated enough for 'ya??

	$self->{'_callbacks'}{$reqtype} = $funcref;
}

=head2 verbosity (level)

Not to be confused with C<debug>, verbosity changes the updates the tuner sends.  By default, the tuner only sends updates for artist/title/PID
on the current channel.  The Generation 2.5 tuners can send artist/title on all channels, the current time, signal strength, and PID information on all 
channels.

Internally the tuner treats verbosity as a bitmap allowing you to control each type of update you are interested in.  For now, this module treats it
as a boolean.  0 (default) requests that no updates be sent.  1 requests that all of the following updates are sent:

=over

=item *

Artist/Title information for every channel

=item *

PID information for every channel

=item *

Signal strength

=item *

Current time

=back

  $tuner->verbosity(1); #request all of these updates
  $current_verbosity=$tuner->verbosity;

=cut

sub verbosity {
	my $self = shift;
	if (!ref($self)) { croak "$self isn't an object"; }
	my ($verbreq) = @_;

	if (!defined($verbreq)) { return $self->{verbosity}; } # accessor
	if ($verbreq == 0) {
		# 0 = no verbosity, 1b = full verbosity
		my $cmd = $COMMANDS{verbosity}.'0000';
		$self->_send_command($cmd);
		$self->{verbosity} = $verbreq;
	}
	if ($verbreq == 1) {
		# 0 = no verbosity, 1b = full verbosity
#		my $cmd = $COMMANDS{verbosity}.'1b00';
		my $cmd = $COMMANDS{verbosity}.'1f00';
		$self->_send_command($cmd);
		$self->{verbosity} = $verbreq;
	}
}

sub _read {
	# _read works like read from $serial.  except better.
	# returns ($count, $data)

lib/Audio/Radio/Sirius.pm view on Meta::CPAN

				next READ;
			}
			$self->{_lastreq} = $seq;
			# handle the update, then send an ack
			my $updatetype = unpack ('H4', $data);
			if (defined($UPDATES{$updatetype})) {
				# OK... I recognize this update.
				my $updatename = $UPDATES{$updatetype}{name};
				my $updatehandler = $UPDATES{$updatetype}{handler};
				if ($debug) {
					print "Received an update: $updatename\n";
				}
				if (defined($updatehandler)) {
					# some responses are identical but the identical part starts
					# somewhere after the command...  chop it off to the identical bits
					my $removefirst = $UPDATES{$updatetype}{removefirst};
					$data=substr($data,$removefirst);
					$self->$updatehandler($data);
				}
					
			} else {
				# unknown command.
				if ($debug) {
					my $datahex = $self->_pformat($data);
					print "Unknown update: $updatetype data: $datahex\n";
				}
			}
		}
	}
}

sub _channel_update {
	my $self = shift;
	my ($data) = @_;
	
	my ($channel, $categorynum, $shortchan, $longchan, $shortcat, $longcat);
	($channel, $categorynum, $shortchan, $longchan, $shortcat, $longcat, $data) = unpack ('C1xC1xxC1/aC/aC/aC/aa*', $data);

	$self->{channel} = $channel;

	$self->{categories}{$categorynum}{longname} = $longcat;
	$self->{categories}{$categorynum}{shortname} = $shortcat;
	$self->{channels}{$channel}{longname} = $longchan;
	$self->{channels}{$channel}{shortname} = $shortchan;

	$self->{channels}{$channel}{category} = $self->{categories}{$categorynum};
	$self->{categories}{$categorynum}{channels}{$channel} = $self->{channels}{$channel};

	# process left over items
	$self->_channel_items($channel, $data);

	# call handler
	$self->_call_channel_handler($channel);
}

sub _call_channel_handler {
	my $self = shift;
	my ($channel) = @_;

	# update handler: ($channel, $pid, $artist, $title, $composer)
	my $handler = $self->{'_callbacks'}{'channel_update'};
	if (ref($handler)) {
		&$handler (
			$channel,
			$self->{'channels'}{$channel}{'pid'},
			$self->{'channels'}{$channel}{'artist'},
			$self->{'channels'}{$channel}{'title'},
			$self->{'channels'}{$channel}{'composer'}
		);
	}
}

sub _signal_update {
	my $self = shift;
	my ($data) = @_;
	my $debug = $self->{debug};

	my ($overall, $sat, $terrestrial) = unpack ('CCC', $data);

	foreach my $signal ($overall, $sat, $terrestrial) {
		$signal = $signal * .33;
	}
	if ($debug>1) { print "Signal overall: $overall Sat: $sat Terrestrial: $terrestrial\n"; }
	$self->{signal}{overall} = $overall;
	$self->{signal}{sat} = $sat;
	$self->{signal}{terrestrial} = $terrestrial;
}

sub _time_update {
	my $self = shift;
	my ($data) = @_;
	my $debug = $self->{debug};

	my ($year, $month, $day, $hour, $minute, $second) = unpack ('nCCCCC', $data);
	if ($debug>1) { print "Time update: $year-$month-$day $hour:$minute:$second\n"; }

	# send to user functions as reverse list to conform with perl custom
}

sub _channel_item_update {
	my $self = shift;
	my ($data) = @_;

	my $channel;
	($channel, $data) = unpack ('C1a*', $data);
	$self->_channel_items($channel, $data);

	# call handler
	$self->_call_channel_handler($channel);
}

sub _channel_items {
	# multiple updates contain this stuff.  call this with $chan and $data.
	my $self = shift;
	my ($channel, $data) = @_;
	my $debug=$self->{debug};


	my $numitems;
	($numitems, $data) = unpack ('C1a*', $data);
	if ($numitems>0) {

( run in 1.662 second using v1.01-cache-2.11-cpan-cdf2f3d4e48 )