cvsroot/Linux-DVB/DVB.pm

=head1 NAME

Linux::DVB - interface to (some parts of) the Linux DVB API

=head1 SYNOPSIS

 use Linux::DVB;

=head1 DESCRIPTION

This module provides an interface to the Linux DVB API. It is a straightforward
translation of the C API. You should read the Linux DVB API description to make
any sense of this module. It can be found here:

   http://www.linuxtv.org/developer/dvbapi.xml

All constants from F<frontend.h> and F<demux.h> are exported by their C
name and by default.

Noteworthy differences to the C API: unions and sub-structs are usually
translated into flat perl hashes, i.e C<struct.u.qam.symbol_rate>
becomes C<< $struct->{symbol_rate} >>.

Noteworthy limitations of this module include: no way to set the
frequency or diseqc. No interface to the video, audio and net devices.
If you need this functionality bug the author.

=cut

package Linux::DVB;

use Fcntl ();

BEGIN {
   $VERSION = '0.02';
   @ISA = qw(Exporter);

   require XSLoader;
   XSLoader::load __PACKAGE__, $VERSION;

   require Exporter;

   my %consts = &_consts;
   my $consts;
   while (my ($k, $v) = each %consts) {
      push @EXPORT, $k;
      $consts .= "sub $k(){$v}\n";
   }
   eval $consts;
}

sub new {
   my ($class, $path, $mode) = @_;

   my $self = bless { path => $path, mode => $mode }, $class;
   sysopen $self->{fh}, $path, $mode | &Fcntl::O_NONBLOCK
      or die "$path: $!";
   $self->{fd} = fileno $self->{fh};

   $self;
}

sub fh { $_[0]{fh} }
sub fd { $_[0]{fd} }

sub blocking {
   fcntl $_[0]{fh}, &Fcntl::F_SETFL, $_[1] ? 0 : &Fcntl::O_NONBLOCK;
}

package Linux::DVB::Frontend;

@ISA = qw(Linux::DVB);

=head1 Linux::DVB::Frontend CLASS

=head2 SYNOPSIS

 my $fe = new Linux::DVB::Frontend $path, $writable;

 my $fe = new Linux::DVB::Frontend
             "/dev/dvb/adapter0/frontend0", 1;

 $fe->fh; # filehandle
 $fe->fd; # fileno
 $fe->blocking (0); # or 1

 $fe->{name}
 $fe->{type}
 $fe->frontend_info->{name}

 $fe->status & FE_HAS_LOCK
 print $fe->ber, $fe->snr, $fe->signal_strength, $fe->uncorrected;

 my $tune = $fe->parameters;
 $tune->{frequency};
 $tune->{symbol_rate};

=cut

sub new {
   my ($class, $path, $mode) = @_;
   my $self = $class->SUPER::new ($path, $mode ? &Fcntl::O_RDWR : &Fcntl::O_RDONLY);

   %$self = ( %$self, %{ $self->frontend_info } );
   
   $self;
}

sub frontend_info   { _frontend_info   ($_[0]{fd}) }
sub status          { _read_status     ($_[0]{fd}) }
sub ber             { _read_ber        ($_[0]{fd}) }
sub snr             { _snr             ($_[0]{fd}) }
sub signal_strength { _signal_strength ($_[0]{fd}) }
sub uncorrected     { _uncorrected     ($_[0]{fd}) }

#sub set             { _set   ($_[0]{fd}, $_[0]{type}) }
sub parameters      { _get   ($_[0]{fd}, $_[0]{type}) }
sub event           { _event ($_[0]{fd}, $_[0]{type}) }

package Linux::DVB::Demux;

@ISA = qw(Linux::DVB);

=head1 Linux::DVB::Demux CLASS

=head2 SYNOPSIS

 my $dmx = new Linux::DVB::Demux
             "/dev/dvb/adapter0/demux0";

 $fe->fh; # filehandle
 $fe->fd; # fileno
 $fe->blocking (1); # non-blocking is default

 $dmx->buffer (16384);
 $dmx->sct_filter ($pid, "filter", "mask", $timeout=0, $flags=DMX_CHECK_CRC);
 $dmx->pes_filter ($pid, $input, $output, $type, $flags=0);
 $dmx->start; 
 $dmx->stop; 

=cut

sub new {
   my ($class, $path) = @_;
   my $self = $class->SUPER::new ($path, &Fcntl::O_RDWR);
   
   $self;
}

sub start      { _start      ($_[0]{fd}) }
sub stop       { _stop       ($_[0]{fd}) }

sub sct_filter { _filter     ($_[0]{fd}, @_[1, 2, 3, 4, 5]) }
sub pes_filter { _pes_filter ($_[0]{fd}, @_[1, 2, 3, 4, 5]) }
sub buffer     { _buffer     ($_[0]{fd}, $_[1]) }

package Linux::DVB::Decode;

use Encode;

sub text($) {
   for ($_[0]) {
      s/^([\x01-\x0b])// and $_ = decode sprintf ("iso-8859-%d", 4 + ord $1), $_;
      # 10 - pardon you???
      s/^\x11// and $_ = decode "utf16-be", $_;
      # 12 ksc5601, DB
      # 13 db2312, DB
      # 14 big5(?), DB
      s/\x8a/\n/g;
      #s/([\x00-\x09\x0b-\x1f\x80-\x9f])/sprintf "{%02x}", ord $1/ge;
      s/([\x00-\x09\x0b-\x1f\x80-\x9f])//ge;
   }
}

1;

=head1 AUTHOR

 Marc Lehmann <schmorp@schmorp.de>
 http://home.schmorp.de/

=cut

Revision:	1.3
Committed:	Thu Mar 3 17:27:40 2005 UTC (21 years, 6 months ago) by root
Branch:	MAIN
Changes since 1.2:	+3 -3 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.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	root	1.3	$VERSION = '0.02';
36	root	1.1	@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	root	1.2	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	root	1.1	1;
176
177			=head1 AUTHOR
178
179	root	1.3	Marc Lehmann <schmorp@schmorp.de>
180			http://home.schmorp.de/
181	root	1.1
182			=cut
183