ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/Linux-DVB/DVB.pm
Revision: 1.12
Committed: Wed May 24 21:00:09 2006 UTC (17 years, 11 months ago) by root
Branch: MAIN
Changes since 1.11: +30 -8 lines
Log Message:
*** empty log message ***

File Contents

# Content
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/docs/dvbapi/dvbapi.html
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 = '1.0';
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 =over 4
99
100 =cut
101
102 sub new {
103 my ($class, $path, $mode) = @_;
104 my $self = $class->SUPER::new ($path, $mode ? &Fcntl::O_RDWR : &Fcntl::O_RDONLY);
105
106 %$self = ( %$self, %{ $self->frontend_info } );
107
108 $self;
109 }
110
111 =item $fe->set (parameter => value, ...)
112
113 Sets frontend parameters. All values are stuffed into the
114 C<dvb_frontend_parameters> structure without conversion and passed to
115 FE_SET_FRONTEND.
116
117 Returns true on success.
118
119 All modes:
120
121 frequency =>
122 inversion =>
123
124 QPSK frontends:
125
126 symbol_rate =>
127 fec_inner =>
128
129 QAM frontends:
130
131 symbol_rate =>
132 modulation =>
133
134 QFDM frontends:
135
136 bandwidth =>
137 code_rate_HP =>
138 code_rate_LP =>
139 constellation =>
140 transmission_mode =>
141
142 =cut
143
144 sub set {
145 my ($self) = shift;
146 _set $self->{fd}, { @_ }, $self->{type}
147 }
148
149 =item $fe->parameters
150
151 Calls FE_GET_FRONTEND and returns a hash reference that contains the same keys
152 as given to the C<set> method.
153
154 Example:
155
156 Data::Dumper::Dumper $fe->get
157
158 {
159 frequency => 426000000, # 426 Mhz
160 inversion => 0, # INVERSION_OFF
161 symbol_rate => 6900000, # 6.9 MB/s
162 modulation => 3, # QAM_64
163 }
164
165 =cut
166
167 sub parameters { _get ($_[0]{fd}, $_[0]{type}) }
168 sub get { _get ($_[0]{fd}, $_[0]{type}) } # unannounced alias
169 sub event { _event ($_[0]{fd}, $_[0]{type}) }
170
171 =item $ok = $fe->diseqc_reset_overload
172
173 If the bus has been automatically powered off due to power overload, this
174 call restores the power to the bus. The call requires read/write access
175 to the device. This call has no effect if the device is manually powered
176 off. Not all DVB adapters support this call.
177
178 =item $ok = $fe->diseqc_voltage (13|18)
179
180 Set the DiSEqC voltage to either 13 or 18 volts.
181
182 =item $ok = $fe->diseqc_tone (1|0)
183
184 Enables (1) or disables (0) the DiSEqC continuous 22khz tone generation.
185
186 =item $ok = $fe->diseqc_send_burst (0|1)
187
188 Sends a 22KHz tone burst of type SEC_MINI_A (0) or SEC_MINI_B (1).
189
190 =item $ok = $fe->diseqc_cmd ($command)
191
192 Sends a DiSEqC command.
193
194 =item $reply = $fe->diseqc_reply ($timeout)
195
196 Receives a reply to a DiSEqC 2.0 command (or undef).
197
198 =cut
199
200 package Linux::DVB::Demux;
201
202 @ISA = qw(Linux::DVB);
203
204 =back
205
206 =head1 Linux::DVB::Demux CLASS
207
208 =head2 SYNOPSIS
209
210 my $dmx = new Linux::DVB::Demux
211 "/dev/dvb/adapter0/demux0";
212
213 $fe->fh; # filehandle
214 $fe->fd; # fileno
215 $fe->blocking (1); # non-blocking is default
216
217 $dmx->buffer (16384);
218 $dmx->sct_filter ($pid, "filter", "mask", $timeout=0, $flags=DMX_CHECK_CRC);
219 $dmx->pes_filter ($pid, $input, $output, $type, $flags=0);
220 $dmx->start;
221 $dmx->stop;
222
223 =over 4
224
225 =cut
226
227 sub new {
228 my ($class, $path) = @_;
229 my $self = $class->SUPER::new ($path, &Fcntl::O_RDWR);
230
231 $self;
232 }
233
234 sub start { _start ($_[0]{fd}) }
235 sub stop { _stop ($_[0]{fd}) }
236
237 sub sct_filter { _filter ($_[0]{fd}, @_[1, 2, 3, 4, 5]) }
238 sub pes_filter { _pes_filter ($_[0]{fd}, @_[1, 2, 3, 4, 5]) }
239 sub buffer { _buffer ($_[0]{fd}, $_[1]) }
240
241 package Linux::DVB::Decode;
242
243 =back
244
245 =head1 Linux::DVB::Decode CLASS
246
247 =head2 SYNOPSIS
248
249 $si_decoded_hashref = Linux::DVB::Decode::si $section_data;
250
251 =over 4
252
253 =cut
254
255 =item $hashref = Linux::DVB::Decode::si $section_data
256
257 Tries to parse the string inside C<$section_data> as an SI table and
258 return it as a hash reference. Only the first SI table will be returned
259 as hash reference, and the C<$section_data> will be modified in-place by
260 removing the table data.
261
262 The way to use this function is to append new data to your
263 C<$section_data> and then call C<Linux::DVB::Decode::si> in a loop until
264 it returns C<undef>. Please ntoe, however, that the Linux DVB API will
265 return only one table at a time from sysread, so you can safely assume
266 that every sysread will return exactly one (or zero in case of errors) SI
267 table.
268
269 Here is an example of what to expect:
270
271 {
272 'segment_last_section_number' => 112,
273 'table_id' => 81,
274 'service_id' => 28129,
275 'original_network_id' => 1,
276 'section_syntax_indicator' => 1,
277 'current_next_indicator' => 1,
278 'events' => [
279 {
280 'running_status' => 0,
281 'start_time_hms' => 2097152,
282 'event_id' => 39505,
283 'free_CA_mode' => 0,
284 'start_time_mjd' => 53470,
285 'descriptors' => [
286 {
287 'event_name' => 'Nachrichten',
288 'text' => '',
289 'ISO_639_language_code' => 'deu',
290 'type' => 77
291 },
292 {
293 'programme_identification_label' => 337280,
294 'type' => 105
295 },
296 {
297 'raw_data' => '22:0010.04#00',
298 'type' => 130
299 }
300 ],
301 'duration' => 1280
302 },
303 {
304 'running_status' => 0,
305 'start_time_hms' => 2098432,
306 'event_id' => 39506,
307 'free_CA_mode' => 0,
308 'start_time_mjd' => 53470,
309 'descriptors' => [
310 {
311 'event_name' => 'SR 1 - Nachtwerk',
312 'text' => '',
313 'ISO_639_language_code' => 'deu',
314 'type' => 77
315 },
316 {
317 'programme_identification_label' => 337285,
318 'type' => 105
319 },
320 {
321 'raw_data' => '22:0510.04#00',
322 'type' => 130
323 }
324 ],
325 'duration' => 87296
326 }
327 ],
328 'last_table_id' => 81,
329 'section_number' => 112,
330 'last_section_number' => 176,
331 'version_number' => 31,
332 'transport_stream_id' => 1101
333 }
334
335
336 =item $text = Linux::DVB::Decode::text $data
337
338 Converts text found in DVB si tables into perl text. Only iso-8859-1..-11
339 and UTF-16 is supported, other encodings (big5 etc. is not. Bug me if you
340 need this).
341
342 =cut
343
344 sub text($) {
345 use Encode;
346
347 for ($_[0]) {
348 s/^([\x01-\x0b])// and $_ = decode sprintf ("iso-8859-%d", 4 + ord $1), $_;
349 # 10 - pardon you???
350 s/^\x11// and $_ = decode "utf16-be", $_;
351 # 12 ksc5601, DB
352 # 13 db2312, DB
353 # 14 big5(?), DB
354 s/\x8a/\n/g;
355 #s/([\x00-\x09\x0b-\x1f\x80-\x9f])/sprintf "{%02x}", ord $1/ge;
356 s/([\x00-\x09\x0b-\x1f\x80-\x9f])//ge;
357 }
358 }
359
360 =item %Linux::DVB::Decode::nibble_to_genre
361
362 A two-level hash mapping genre nibbles to genres, e.g.
363
364 $Linux::DVB::Decode::nibble_to_genre{7}{6}
365 => 'film/cinema'
366
367 =cut
368
369 our %nibble_to_genre = (
370 0x1 => {
371 0x0 => 'Movie/Drama (general)',
372 0x1 => 'Movie - detective/thriller',
373 0x2 => 'Movie - adventure/western/war',
374 0x3 => 'Movie - science fiction/fantasy/horror',
375 0x4 => 'Movie - comedy',
376 0x5 => 'Movie - soap/melodrama/folkloric',
377 0x6 => 'Movie - romance',
378 0x7 => 'Movie - serious/classical/religious/historical movie/drama',
379 0x8 => 'Movie - adult movie/drama',
380 },
381 0x2 => {
382 0x0 => 'News/Current Affairs (general)',
383 0x1 => 'news/weather report',
384 0x2 => 'news magazine',
385 0x3 => 'documentary',
386 0x4 => 'discussion/interview/debate',
387 },
388 0x3 => {
389 0x0 => 'Show/Game Show (general)',
390 0x1 => 'game show/quiz/contest',
391 0x2 => 'variety show',
392 0x3 => 'talk show',
393 },
394 0x4 => {
395 0x0 => 'Sports (general)',
396 0x1 => 'special events (Olympic Games, World Cup etc.)',
397 0x2 => 'sports magazines',
398 0x3 => 'football/soccer',
399 0x4 => 'tennis/squash',
400 0x5 => 'team sports (excluding football)',
401 0x6 => 'athletics',
402 0x7 => 'motor sport',
403 0x8 => 'water sport',
404 0x9 => 'winter sports',
405 0xA => 'equestrian',
406 0xB => 'martial sports',
407 },
408 0x5 => {
409 0x0 => 'Childrens/Youth (general)',
410 0x1 => "pre-school children's programmes",
411 0x2 => 'entertainment programmes for 6 to 14',
412 0x3 => 'entertainment programmes for 10 to 16',
413 0x4 => 'informational/educational/school programmes',
414 0x5 => 'cartoons/puppets',
415 },
416 0x6 => {
417 0x0 => 'Music/Ballet/Dance (general)',
418 0x1 => 'rock/pop',
419 0x2 => 'serious music or classical music',
420 0x3 => 'folk/traditional music',
421 0x4 => 'jazz',
422 0x5 => 'musical/opera',
423 0x6 => 'ballet',
424 },
425 0x7 => {
426 0x0 => 'Arts/Culture (without music, general)',
427 0x1 => 'performing arts',
428 0x2 => 'fine arts',
429 0x3 => 'religion',
430 0x4 => 'popular culture/traditional arts',
431 0x5 => 'literature',
432 0x6 => 'film/cinema',
433 0x7 => 'experimental film/video',
434 0x8 => 'broadcasting/press',
435 0x9 => 'new media',
436 0xA => 'arts/culture magazines',
437 0xB => 'fashion',
438 },
439 0x8 => {
440 0x0 => 'Social/Policical/Economics (general)',
441 0x1 => 'magazines/reports/documentary',
442 0x2 => 'economics/social advisory',
443 0x3 => 'remarkable people',
444 },
445 0x9 => {
446 0x0 => 'Education/Science/Factual (general)',
447 0x1 => 'nature/animals/environment',
448 0x2 => 'technology/natural sciences',
449 0x3 => 'medicine/physiology/psychology',
450 0x4 => 'foreign countries/expeditions',
451 0x5 => 'social/spiritual sciences',
452 0x6 => 'further education',
453 0x7 => 'languages',
454 },
455 0xA => {
456 0x0 => 'Leisure/Hobbies (general)',
457 0x1 => 'tourism/travel',
458 0x2 => 'handicraft',
459 0x3 => 'motoring',
460 0x4 => 'fitness & health',
461 0x5 => 'cooking',
462 0x6 => 'advertizement/shopping',
463 0x7 => 'gardening',
464 },
465 0xB => {
466 0x0 => '(original language)',
467 0x1 => '(black & white)',
468 0x2 => '(unpublished)',
469 0x3 => '(live broadcast)',
470 },
471 );
472
473 =item ($sec,$min,$hour) = Linux::DVB::Decode::time $hms
474
475 =item ($mday,$mon,$year) = Linux::DVB::Decode::date $mjd
476
477 =item ($sec,$min,$hour,$mday,$mon,$year) = Linux::DVB::Decode::datetime $mjd, $hms
478
479 =item $sec = Linux::DVB::Decode::time_linear $hms
480
481 =item $sec = Linux::DVB::Decode::datetime_linear $mjd, $hms
482
483 Break down a "DVB time" (modified julian date + bcd encoded seconds) into
484 it's components (non-C<_linear>) or into a seconds count (C<_linear>
485 variants) since the epoch (C<datetime_linear>) or the start of the day
486 (C<time_linear>).
487
488 The format of the returns value of the date and datetime functions is
489 I<not> compatible with C<Time::Local>. Use the C<_linear> functions
490 instead.
491
492 Example:
493
494 my $time = Linux::DVB::Decode::datetime_linear $mjd, $hms
495 printf "Starts at %s\n",
496 POSIX::strftime "%Y-%m-%d %H:%M:%S",
497 localtime $time;
498
499 =cut
500
501 sub time($) {
502 my ($time) = @_;
503
504 # Time is in UTC, 24 bit, every nibble one digit in BCD from right to left
505 my $hour = sprintf "%02x", ($time >> 16) & 0xFF;
506 my $minute = sprintf "%02x", ($time >> 8) & 0xFF;
507 my $second = sprintf "%02x", ($time ) & 0xFF;
508
509 ($second, $minute, $hour)
510 }
511
512 sub date($) {
513 my ($mjd) = @_;
514
515 # Date is given in Modified Julian Date
516 # Decoding routines taken from ANNEX C, ETSI EN 300 468 (DVB SI)
517 my $y_ = int (($mjd - 15078.2) / 365.25);
518 my $m_ = int (($mjd - 14956.1 - int ($y_ * 365.25)) / 30.6001);
519 my $day = $mjd - 14956 - int ($y_ * 365.25) - int ($m_ * 30.6001);
520 my $k = $m_ == 14 or $m_ == 15 ? 1 : 0;
521 my $year = $y_ + $k + 1900;
522 my $month = $m_ - 1 - $k * 12;
523
524 ($day, $month, $year)
525 }
526
527 sub datetime($$) {
528 (Linux::DVB::Decode::time $_[1], date $_[0])
529 }
530
531 sub time_linear($) {
532 my ($s, $m, $h) = Linux::DVB::Decode::time $_[0];
533
534 (($h * 60) + $m * 60) + $s
535 }
536
537 sub datetime_linear($$) {
538 my ($sec, $min, $hour, $mday, $mon, $year) =
539 Linux::DVB::Decode::datetime $_[0], $_[1];
540
541 require Time::Local;
542 Time::Local::timegm ($sec, $min, $hour, $mday, $mon - 1, $year)
543 }
544
545 =back
546
547 =head1 AUTHORS
548
549 Marc Lehmann <schmorp@schmorp.de>, http://home.schmorp.de/
550 Magnus Schmidt, eMail at http://www.27b-6.de/email.php
551
552 =cut
553
554 1