view release on metacpan or  search on metacpan

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

	'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
	},
	'8002'	=> {
		# The way verbosity works now, we won't see PID info.  Verbosity must not include channel updates or it only sends those
		# (mostly because PIDs are part of channel updates).
		name		=> 'pid_info',
		handler	=> undef,
	},
	'8003'	=> {
		name		=> 'time_info',
		handler	=> \&_time_update,
		removefirst	=> 2
	},
	'8004'	=> {
		# 1 1 0 - acquiring signal
		# 1 0 0 - all's well
		# 2 1 0 - antenna disconnected
		# 2 0 1 - antenna back
		name		=> 'tuner_info',
		handler	=> undef,
		removefirst	=> 2
	},
	'8005'	=> {
		name		=> 'signal_info',
		handler	=> \&_signal_update,
		removefirst	=> 2
	},
);

our %TYPES = (
	command	=> '00',
	ack		=> '80',
	e_busy	=> '82',
	e_checksum	=> '83'
);

our %ITEM_TYPES = (
	0x1	=> 'artist',
	0x2	=> 'title',
	0x6	=> 'composer',
	0x86	=> 'pid'
);


our $START = 'a40300'; # Const that prefaces each command

=head1 SYNOPSIS

Sirius satellite radio (L<http://www.sirius.com>) is a US based satellite radio serice.  While none of the tuners they make have serial or USB connectors,
it has been found that generation 2.5 tuners (Sportster, Starmate, * Replay, Sirius Connect, and others) have a common tuner module.  Furthermore
this tuner module generally has a serial interface.  Presently only one commercial site is offering a modification for adding a serial port to a 
Sirius tuner: L<http://www.rush2112.net>.  Google should reveal schematics and parts needed for adding ports to other tuners.

Once your tuner is connected to your system and accessible via a serial port like device, you can use this module to access it:

  use Audio::Radio::Sirius;
  use Win32::SerialPort; # or Device::SerialPort on Linux

  my $serial = new Win32::SerialPort('com1');
  my $tuner = new Audio::Radio::Sirius;

  $tuner->connect($serial);
  $tuner->power(1);
  $tuner->channel(184); # tune in the preview channel

=head1 CONSTRUCTOR

=head2 new 

Call new to create an instance of the Sirius radio object.  Once the object is created, you will probably want to L<connect|/"connect (serialport object)"> to it.

=cut

 sub new {
 	my $class = shift;
	my $self = { %DEFAULTS };
	bless $self, $class;
 	return $self;
 }

sub AUTOLOAD {
	my $self = shift;
	my $type = ref($self) or croak "$self is not an object";

	my $name = $AUTOLOAD;
	$name =~ s/.*://; # Remove Audio::Radio::Sirius:: bit

	unless (exists $self->{$name}) { croak "$name is not a field in class $type"; }

	if (@_) {
		# setter
		if (defined($SETTABLE{$name}) ) { return $self->{$name} = shift; }
		else { croak "$name cannot be changed."; }

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

	}
	my $remainder = length($data);
	if ($remainder > 0) { warn "Got a remainder when reading channel update."; }
}

sub _send_ack {
	my $self = shift;
	my ($seq) = @_;

	my $rawdata = pack('H6C1H2C1', $START, $seq, $TYPES{ack}, 0);
	my $checksum = $self->_checksum($rawdata);
	my $data = $rawdata.$checksum;
	if ($self->debug >= 3) {print '>> '.$self->_pformat($data)."\n"; }

	my $serial = $self->{_serial};
	my $count_out = $serial->write($data);
	warn "Not enough data written" unless ($count_out == length($data));
}

sub _send_checksum_error {
	my $self = shift;
	my ($seq) = @_;

	my $rawdata = pack('H6C1H2C1', $START, $seq, $TYPES{e_checksum}, 0);
	my $checksum = $self->_checksum($rawdata);
	my $data = $rawdata.$checksum;
	if ($self->debug >= 3) {print '>> '.$self->_pformat($data)."\n"; }

	my $serial = $self->{_serial};
	my $count_out = $serial->write($data);
	warn "Not enough data written" unless ($count_out == length($data));
}

sub _send_command {
	### TODO: Handle escape char (1B)
	# returns true/false results
	my $self = shift;
	my ($hexcommand) = @_;
	my $command = pack('H*', $hexcommand);
	my $cmdlength = length($command);
	my $sequence = $self->{_sequence};

	my $rawdata = pack('H6C1H2C1a*', $START, $sequence, $TYPES{command}, $cmdlength, $command);
	my $checksum = $self->_checksum($rawdata);
	# oddly enough the double escapes don't count as length.  don't change original length.
	my $data = pack('H6C1H2C1a*a1', $START, $sequence, $TYPES{command}, $cmdlength, $command, $checksum);

	# handle the escape character anywhere in the sent data.  must be done after checksum.
	$data =~ s/\x1b/\x1b\x1b/g;

	my $serial = $self->{_serial};

	my $attempts=0;
	SEND: foreach $attempts (1..5) {
		# send/retry logic
		if ($self->{debug}) { print "Sending command: $hexcommand sequence: $sequence\n"; }
		if ($self->debug >= 3) {print '>> '.$self->_pformat($data)."\n"; }
		$serial->write($data);
		$self->_receive;
		last SEND if ($self->{_lastack} == $sequence );
		# we're still here...  receiver is probably busy.  give it a bit.
		sleep(3);
	}

	$self->{_sequence} = ($self->{_sequence} + 1);
	if ($self->{_sequence} > 255) { $self->{_sequence} = 0; }
	
	if (($attempts == 3) && ($self->{lastack} != $sequence) ) {
		carp "Command not acknowledged by tuner after 3 attempts.";
		return 0;
	}
	return 1;
}


sub _checksum {
	# returns 1 byte (char) of checksum data
	# i can replace this with unpack.  just need to do the 256-result thing.
	# is there a bug here when $sum % 256 = 0?
	my $self = shift;
	my ($data) = @_;

	my $char;
	my $sum = 0;
	foreach $char (split(//, $data)) {
		$sum += ord($char);
	}
	if ( ($sum % 0x100) == 0) { return chr(0); }
	my $cs = 0x100 - ($sum % 0x100);
	return chr($cs);
}

sub _pformat {
	my $self = shift;
	my ($data) = @_;
	my $buffer = '';

	my $char;

	foreach $char (split(//, $data)) {
		$char = ord($char);
		if (($char >= 32) && ($char <= 126)) {
#			$buffer .= chr($char);
			$buffer .= sprintf ("0x%02x ", $char);
		} else {
			$buffer .= sprintf ("0x%02x ", $char);
		}
	}
	return $buffer;
}

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

	return (unpack('H2', pack ('c1', $data) ) );
}

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