| 1 |
=head1 NAME |
| 2 |
|
| 3 |
Linux::DVB - interface to (some parts of) the Linux DVB API |
| 4 |
|
| 5 |
=head1 SYNOPSIS |
| 6 |
|
| 7 |
use Linux::DVB; |
| 8 |
|
| 9 |
=head1 DESCRIPTION |
| 10 |
|
| 11 |
This module provides an interface to the Linux DVB API. It is a straightforward |
| 12 |
translation of the C API. You should read the Linux DVB API description to make |
| 13 |
any sense of this module. It can be found here: |
| 14 |
|
| 15 |
http://www.linuxtv.org/developer/dvbapi.xml |
| 16 |
|
| 17 |
All constants from F<frontend.h> and F<demux.h> are exported by their C |
| 18 |
name and by default. |
| 19 |
|
| 20 |
Noteworthy differences to the C API: unions and sub-structs are usually |
| 21 |
translated into flat perl hashes, i.e C<struct.u.qam.symbol_rate> |
| 22 |
becomes C<< $struct->{symbol_rate} >>. |
| 23 |
|
| 24 |
Noteworthy limitations of this module include: no way to set the |
| 25 |
frequency or diseqc. No interface to the video, audio and net devices. |
| 26 |
If you need this functionality bug the author. |
| 27 |
|
| 28 |
=cut |
| 29 |
|
| 30 |
package Linux::DVB; |
| 31 |
|
| 32 |
use Fcntl (); |
| 33 |
|
| 34 |
BEGIN { |
| 35 |
$VERSION = '0.1'; |
| 36 |
@ISA = qw(Exporter); |
| 37 |
|
| 38 |
require XSLoader; |
| 39 |
XSLoader::load __PACKAGE__, $VERSION; |
| 40 |
|
| 41 |
require Exporter; |
| 42 |
|
| 43 |
my %consts = &_consts; |
| 44 |
my $consts; |
| 45 |
while (my ($k, $v) = each %consts) { |
| 46 |
push @EXPORT, $k; |
| 47 |
$consts .= "sub $k(){$v}\n"; |
| 48 |
} |
| 49 |
eval $consts; |
| 50 |
} |
| 51 |
|
| 52 |
sub new { |
| 53 |
my ($class, $path, $mode) = @_; |
| 54 |
|
| 55 |
my $self = bless { path => $path, mode => $mode }, $class; |
| 56 |
sysopen $self->{fh}, $path, $mode | &Fcntl::O_NONBLOCK |
| 57 |
or die "$path: $!"; |
| 58 |
$self->{fd} = fileno $self->{fh}; |
| 59 |
|
| 60 |
$self; |
| 61 |
} |
| 62 |
|
| 63 |
sub fh { $_[0]{fh} } |
| 64 |
sub fd { $_[0]{fd} } |
| 65 |
|
| 66 |
sub blocking { |
| 67 |
fcntl $_[0]{fh}, &Fcntl::F_SETFL, $_[1] ? 0 : &Fcntl::O_NONBLOCK; |
| 68 |
} |
| 69 |
|
| 70 |
package Linux::DVB::Frontend; |
| 71 |
|
| 72 |
@ISA = qw(Linux::DVB); |
| 73 |
|
| 74 |
=head1 Linux::DVB::Frontend CLASS |
| 75 |
|
| 76 |
=head2 SYNOPSIS |
| 77 |
|
| 78 |
my $fe = new Linux::DVB::Frontend $path, $writable; |
| 79 |
|
| 80 |
my $fe = new Linux::DVB::Frontend |
| 81 |
"/dev/dvb/adapter0/frontend0", 1; |
| 82 |
|
| 83 |
$fe->fh; # filehandle |
| 84 |
$fe->fd; # fileno |
| 85 |
$fe->blocking (0); # or 1 |
| 86 |
|
| 87 |
$fe->{name} |
| 88 |
$fe->{type} |
| 89 |
$fe->frontend_info->{name} |
| 90 |
|
| 91 |
$fe->status & FE_HAS_LOCK |
| 92 |
print $fe->ber, $fe->snr, $fe->signal_strength, $fe->uncorrected; |
| 93 |
|
| 94 |
my $tune = $fe->parameters; |
| 95 |
$tune->{frequency}; |
| 96 |
$tune->{symbol_rate}; |
| 97 |
|
| 98 |
=cut |
| 99 |
|
| 100 |
sub new { |
| 101 |
my ($class, $path, $mode) = @_; |
| 102 |
my $self = $class->SUPER::new ($path, $mode ? &Fcntl::O_RDWR : &Fcntl::O_RDONLY); |
| 103 |
|
| 104 |
%$self = ( %$self, %{ $self->frontend_info } ); |
| 105 |
|
| 106 |
$self; |
| 107 |
} |
| 108 |
|
| 109 |
sub frontend_info { _frontend_info ($_[0]{fd}) } |
| 110 |
sub status { _read_status ($_[0]{fd}) } |
| 111 |
sub ber { _read_ber ($_[0]{fd}) } |
| 112 |
sub snr { _snr ($_[0]{fd}) } |
| 113 |
sub signal_strength { _signal_strength ($_[0]{fd}) } |
| 114 |
sub uncorrected { _uncorrected ($_[0]{fd}) } |
| 115 |
|
| 116 |
#sub set { _set ($_[0]{fd}, $_[0]{type}) } |
| 117 |
sub parameters { _get ($_[0]{fd}, $_[0]{type}) } |
| 118 |
sub event { _event ($_[0]{fd}, $_[0]{type}) } |
| 119 |
|
| 120 |
package Linux::DVB::Demux; |
| 121 |
|
| 122 |
@ISA = qw(Linux::DVB); |
| 123 |
|
| 124 |
=head1 Linux::DVB::Demux CLASS |
| 125 |
|
| 126 |
=head2 SYNOPSIS |
| 127 |
|
| 128 |
my $dmx = new Linux::DVB::Demux |
| 129 |
"/dev/dvb/adapter0/demux0"; |
| 130 |
|
| 131 |
$fe->fh; # filehandle |
| 132 |
$fe->fd; # fileno |
| 133 |
$fe->blocking (1); # non-blocking is default |
| 134 |
|
| 135 |
$dmx->buffer (16384); |
| 136 |
$dmx->sct_filter ($pid, "filter", "mask", $timeout=0, $flags=DMX_CHECK_CRC); |
| 137 |
$dmx->pes_filter ($pid, $input, $output, $type, $flags=0); |
| 138 |
$dmx->start; |
| 139 |
$dmx->stop; |
| 140 |
|
| 141 |
=cut |
| 142 |
|
| 143 |
sub new { |
| 144 |
my ($class, $path) = @_; |
| 145 |
my $self = $class->SUPER::new ($path, &Fcntl::O_RDWR); |
| 146 |
|
| 147 |
$self; |
| 148 |
} |
| 149 |
|
| 150 |
sub start { _start ($_[0]{fd}) } |
| 151 |
sub stop { _stop ($_[0]{fd}) } |
| 152 |
|
| 153 |
sub sct_filter { _filter ($_[0]{fd}, @_[1, 2, 3, 4, 5]) } |
| 154 |
sub pes_filter { _pes_filter ($_[0]{fd}, @_[1, 2, 3, 4, 5]) } |
| 155 |
sub buffer { _buffer ($_[0]{fd}, $_[1]) } |
| 156 |
|
| 157 |
package Linux::DVB::Decode; |
| 158 |
|
| 159 |
use Encode; |
| 160 |
|
| 161 |
sub text($) { |
| 162 |
for ($_[0]) { |
| 163 |
s/^([\x01-\x0b])// and $_ = decode sprintf ("iso-8859-%d", 4 + ord $1), $_; |
| 164 |
# 10 - pardon you??? |
| 165 |
s/^\x11// and $_ = decode "utf16-be", $_; |
| 166 |
# 12 ksc5601, DB |
| 167 |
# 13 db2312, DB |
| 168 |
# 14 big5(?), DB |
| 169 |
s/\x8a/\n/g; |
| 170 |
#s/([\x00-\x09\x0b-\x1f\x80-\x9f])/sprintf "{%02x}", ord $1/ge; |
| 171 |
s/([\x00-\x09\x0b-\x1f\x80-\x9f])//ge; |
| 172 |
} |
| 173 |
} |
| 174 |
|
| 175 |
1; |
| 176 |
|
| 177 |
=head1 AUTHOR |
| 178 |
|
| 179 |
Marc Lehmann <pcg@goof.com> |
| 180 |
http://www.goof.com/pcg/marc/ |
| 181 |
|
| 182 |
=cut |
| 183 |
|
