ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/Linux-DVB/DVB.pm
Revision: 1.17
Committed: Sun Jun 14 13:39:13 2015 UTC (9 years, 1 month ago) by root
Branch: MAIN
CVS Tags: rel-1_03, HEAD
Changes since 1.16: +1 -1 lines
Log Message:
1.03

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 interface to the video,
25 audio and net devices. If you need this functionality bug the author.
26
27 =cut
28
29 package Linux::DVB;
30
31 use Fcntl ();
32
33 BEGIN {
34 $VERSION = '1.03';
35 @ISA = qw(Exporter);
36
37 require XSLoader;
38 XSLoader::load __PACKAGE__, $VERSION;
39
40 require Exporter;
41
42 my %consts = &_consts;
43 my $consts;
44 while (my ($k, $v) = each %consts) {
45 push @EXPORT, $k;
46 $consts .= "sub $k(){$v}\n";
47 }
48 eval $consts;
49 }
50
51 sub new {
52 my ($class, $path, $mode) = @_;
53
54 my $self = bless { path => $path, mode => $mode }, $class;
55 sysopen $self->{fh}, $path, $mode | &Fcntl::O_NONBLOCK
56 or die "$path: $!";
57 $self->{fd} = fileno $self->{fh};
58
59 $self;
60 }
61
62 sub fh { $_[0]{fh} }
63 sub fd { $_[0]{fd} }
64
65 sub blocking {
66 fcntl $_[0]{fh}, &Fcntl::F_SETFL, $_[1] ? 0 : &Fcntl::O_NONBLOCK;
67 }
68
69 package Linux::DVB::Frontend;
70
71 @ISA = qw(Linux::DVB);
72
73 =head1 Linux::DVB::Frontend CLASS
74
75 =head2 SYNOPSIS
76
77 my $fe = new Linux::DVB::Frontend $path, $writable;
78
79 my $fe = new Linux::DVB::Frontend
80 "/dev/dvb/adapter0/frontend0", 1;
81
82 $fe->fh; # filehandle
83 $fe->fd; # fileno
84 $fe->blocking (0); # or 1
85
86 $fe->{name}
87 $fe->{type}
88 $fe->frontend_info->{name}
89
90 $fe->status & FE_HAS_LOCK
91 print $fe->ber, $fe->snr, $fe->signal_strength, $fe->uncorrected;
92
93 my $tune = $fe->parameters;
94 $tune->{frequency};
95 $tune->{symbol_rate};
96
97 =over 4
98
99 =cut
100
101 sub new {
102 my ($class, $path, $mode) = @_;
103 my $self = $class->SUPER::new ($path, $mode ? &Fcntl::O_RDWR : &Fcntl::O_RDONLY);
104
105 %$self = ( %$self, %{ $self->frontend_info } );
106
107 $self;
108 }
109
110 =item $fe->set (parameter => value, ...)
111
112 Sets frontend parameters. All values are stuffed into the
113 C<dvb_frontend_parameters> structure without conversion and passed to
114 FE_SET_FRONTEND.
115
116 Returns true on success.
117
118 All modes:
119
120 frequency =>
121 inversion =>
122
123 QPSK frontends:
124
125 symbol_rate =>
126 fec_inner =>
127
128 QAM frontends:
129
130 symbol_rate =>
131 modulation =>
132
133 QFDM frontends:
134
135 bandwidth =>
136 code_rate_HP =>
137 code_rate_LP =>
138 constellation =>
139 transmission_mode =>
140
141 =cut
142
143 sub set {
144 my ($self) = shift;
145 _set $self->{fd}, { @_ }, $self->{type}
146 }
147
148 =item $fe->parameters
149
150 Calls FE_GET_FRONTEND and returns a hash reference that contains the same keys
151 as given to the C<set> method.
152
153 Example:
154
155 Data::Dumper::Dumper $fe->get
156
157 {
158 frequency => 426000000, # 426 Mhz
159 inversion => 0, # INVERSION_OFF
160 symbol_rate => 6900000, # 6.9 MB/s
161 modulation => 3, # QAM_64
162 }
163
164 =cut
165
166 sub parameters { _get ($_[0]{fd}, $_[0]{type}) }
167 sub get { _get ($_[0]{fd}, $_[0]{type}) } # unannounced alias
168 sub event { _event ($_[0]{fd}, $_[0]{type}) }
169
170 =item $ok = $fe->diseqc_reset_overload
171
172 If the bus has been automatically powered off due to power overload, this
173 call restores the power to the bus. The call requires read/write access
174 to the device. This call has no effect if the device is manually powered
175 off. Not all DVB adapters support this call.
176
177 =item $ok = $fe->diseqc_voltage (13|18)
178
179 Set the DiSEqC voltage to either 13 or 18 volts.
180
181 =item $ok = $fe->diseqc_tone (1|0)
182
183 Enables (1) or disables (0) the DiSEqC continuous 22khz tone generation.
184
185 =item $ok = $fe->diseqc_send_burst (0|1)
186
187 Sends a 22KHz tone burst of type SEC_MINI_A (0) or SEC_MINI_B (1).
188
189 =item $ok = $fe->diseqc_cmd ($command)
190
191 Sends a DiSEqC command ($command is 3 to 6 bytes of binary data).
192
193 =item $reply = $fe->diseqc_reply ($timeout)
194
195 Receives a reply to a DiSEqC 2.0 command and returns it as a binary octet
196 string 0..4 bytes in length (or C<undef> in the error case).
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