ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/Linux-DVB/DVB.pm
(Generate patch)

Comparing Linux-DVB/DVB.pm (file contents):
Revision 1.5 by root, Sun Apr 3 02:16:05 2005 UTC vs.
Revision 1.16 by root, Sun Jun 14 09:53:26 2015 UTC

19 19
20Noteworthy differences to the C API: unions and sub-structs are usually 20Noteworthy differences to the C API: unions and sub-structs are usually
21translated into flat perl hashes, i.e C<struct.u.qam.symbol_rate> 21translated into flat perl hashes, i.e C<struct.u.qam.symbol_rate>
22becomes C<< $struct->{symbol_rate} >>. 22becomes C<< $struct->{symbol_rate} >>.
23 23
24Noteworthy limitations of this module include: no way to set the 24Noteworthy limitations of this module include: No interface to the video,
25frequency or diseqc. No interface to the video, audio and net devices.
26If you need this functionality bug the author. 25audio and net devices. If you need this functionality bug the author.
27 26
28=cut 27=cut
29 28
30package Linux::DVB; 29package Linux::DVB;
31 30
32use Fcntl (); 31use Fcntl ();
33 32
34BEGIN { 33BEGIN {
35 $VERSION = '0.2'; 34 $VERSION = '1.02';
36 @ISA = qw(Exporter); 35 @ISA = qw(Exporter);
37 36
38 require XSLoader; 37 require XSLoader;
39 XSLoader::load __PACKAGE__, $VERSION; 38 XSLoader::load __PACKAGE__, $VERSION;
40 39
93 92
94 my $tune = $fe->parameters; 93 my $tune = $fe->parameters;
95 $tune->{frequency}; 94 $tune->{frequency};
96 $tune->{symbol_rate}; 95 $tune->{symbol_rate};
97 96
97=over 4
98
98=cut 99=cut
99 100
100sub new { 101sub new {
101 my ($class, $path, $mode) = @_; 102 my ($class, $path, $mode) = @_;
102 my $self = $class->SUPER::new ($path, $mode ? &Fcntl::O_RDWR : &Fcntl::O_RDONLY); 103 my $self = $class->SUPER::new ($path, $mode ? &Fcntl::O_RDWR : &Fcntl::O_RDONLY);
104 %$self = ( %$self, %{ $self->frontend_info } ); 105 %$self = ( %$self, %{ $self->frontend_info } );
105 106
106 $self; 107 $self;
107} 108}
108 109
109sub frontend_info { _frontend_info ($_[0]{fd}) }
110sub status { _read_status ($_[0]{fd}) }
111sub ber { _read_ber ($_[0]{fd}) }
112sub snr { _snr ($_[0]{fd}) }
113sub signal_strength { _signal_strength ($_[0]{fd}) }
114sub uncorrected { _uncorrected ($_[0]{fd}) }
115
116=item $fe->set (parameter => value, ...) 110=item $fe->set (parameter => value, ...)
117 111
118Sets frontend parameters. All values are stuffed into the 112Sets frontend parameters. All values are stuffed into the
119C<dvb_frontend_parameters> structure without conversion and passed to 113C<dvb_frontend_parameters> structure without conversion and passed to
120FE_SET_FRONTEND. 114FE_SET_FRONTEND.
132 fec_inner => 126 fec_inner =>
133 127
134QAM frontends: 128QAM frontends:
135 129
136 symbol_rate => 130 symbol_rate =>
137 fec_inner =>
138 modulation => 131 modulation =>
139 132
140QFDM frontends: 133QFDM frontends:
141 134
142 bandwidth => 135 bandwidth =>
163 156
164 { 157 {
165 frequency => 426000000, # 426 Mhz 158 frequency => 426000000, # 426 Mhz
166 inversion => 0, # INVERSION_OFF 159 inversion => 0, # INVERSION_OFF
167 symbol_rate => 6900000, # 6.9 MB/s 160 symbol_rate => 6900000, # 6.9 MB/s
168 fec_inner => 0, # FEC_NONE
169 modulation => 3, # QAM_64 161 modulation => 3, # QAM_64
170 } 162 }
171 163
172=cut 164=cut
173 165
174sub parameters { _get ($_[0]{fd}, $_[0]{type}) } 166sub parameters { _get ($_[0]{fd}, $_[0]{type}) }
175sub get { _get ($_[0]{fd}, $_[0]{type}) } # unannounced alias 167sub get { _get ($_[0]{fd}, $_[0]{type}) } # unannounced alias
176sub event { _event ($_[0]{fd}, $_[0]{type}) } 168sub event { _event ($_[0]{fd}, $_[0]{type}) }
177 169
170=item $ok = $fe->diseqc_reset_overload
171
172If the bus has been automatically powered off due to power overload, this
173call restores the power to the bus. The call requires read/write access
174to the device. This call has no effect if the device is manually powered
175off. Not all DVB adapters support this call.
176
177=item $ok = $fe->diseqc_voltage (13|18)
178
179Set the DiSEqC voltage to either 13 or 18 volts.
180
181=item $ok = $fe->diseqc_tone (1|0)
182
183Enables (1) or disables (0) the DiSEqC continuous 22khz tone generation.
184
185=item $ok = $fe->diseqc_send_burst (0|1)
186
187Sends a 22KHz tone burst of type SEC_MINI_A (0) or SEC_MINI_B (1).
188
189=item $ok = $fe->diseqc_cmd ($command)
190
191Sends a DiSEqC command ($command is 3 to 6 bytes of binary data).
192
193=item $reply = $fe->diseqc_reply ($timeout)
194
195Receives a reply to a DiSEqC 2.0 command and returns it as a binary octet
196string 0..4 bytes in length (or C<undef> in the error case).
197
198=cut
199
178package Linux::DVB::Demux; 200package Linux::DVB::Demux;
179 201
180@ISA = qw(Linux::DVB); 202@ISA = qw(Linux::DVB);
203
204=back
181 205
182=head1 Linux::DVB::Demux CLASS 206=head1 Linux::DVB::Demux CLASS
183 207
184=head2 SYNOPSIS 208=head2 SYNOPSIS
185 209
194 $dmx->sct_filter ($pid, "filter", "mask", $timeout=0, $flags=DMX_CHECK_CRC); 218 $dmx->sct_filter ($pid, "filter", "mask", $timeout=0, $flags=DMX_CHECK_CRC);
195 $dmx->pes_filter ($pid, $input, $output, $type, $flags=0); 219 $dmx->pes_filter ($pid, $input, $output, $type, $flags=0);
196 $dmx->start; 220 $dmx->start;
197 $dmx->stop; 221 $dmx->stop;
198 222
223=over 4
224
199=cut 225=cut
200 226
201sub new { 227sub new {
202 my ($class, $path) = @_; 228 my ($class, $path) = @_;
203 my $self = $class->SUPER::new ($path, &Fcntl::O_RDWR); 229 my $self = $class->SUPER::new ($path, &Fcntl::O_RDWR);
212sub pes_filter { _pes_filter ($_[0]{fd}, @_[1, 2, 3, 4, 5]) } 238sub pes_filter { _pes_filter ($_[0]{fd}, @_[1, 2, 3, 4, 5]) }
213sub buffer { _buffer ($_[0]{fd}, $_[1]) } 239sub buffer { _buffer ($_[0]{fd}, $_[1]) }
214 240
215package Linux::DVB::Decode; 241package Linux::DVB::Decode;
216 242
217use Encode; 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
257Tries to parse the string inside C<$section_data> as an SI table and
258return it as a hash reference. Only the first SI table will be returned
259as hash reference, and the C<$section_data> will be modified in-place by
260removing the table data.
261
262The way to use this function is to append new data to your
263C<$section_data> and then call C<Linux::DVB::Decode::si> in a loop until
264it returns C<undef>. Please ntoe, however, that the Linux DVB API will
265return only one table at a time from sysread, so you can safely assume
266that every sysread will return exactly one (or zero in case of errors) SI
267table.
268
269Here 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
338Converts text found in DVB si tables into perl text. Only iso-8859-1..-11
339and UTF-16 is supported, other encodings (big5 etc. is not. Bug me if you
340need this).
341
342=cut
218 343
219sub text($) { 344sub text($) {
345 use Encode;
346
220 for ($_[0]) { 347 for ($_[0]) {
221 s/^([\x01-\x0b])// and $_ = decode sprintf ("iso-8859-%d", 4 + ord $1), $_; 348 s/^([\x01-\x0b])// and $_ = decode sprintf ("iso-8859-%d", 4 + ord $1), $_;
222 # 10 - pardon you??? 349 # 10 - pardon you???
223 s/^\x11// and $_ = decode "utf16-be", $_; 350 s/^\x11// and $_ = decode "utf16-be", $_;
224 # 12 ksc5601, DB 351 # 12 ksc5601, DB
228 #s/([\x00-\x09\x0b-\x1f\x80-\x9f])/sprintf "{%02x}", ord $1/ge; 355 #s/([\x00-\x09\x0b-\x1f\x80-\x9f])/sprintf "{%02x}", ord $1/ge;
229 s/([\x00-\x09\x0b-\x1f\x80-\x9f])//ge; 356 s/([\x00-\x09\x0b-\x1f\x80-\x9f])//ge;
230 } 357 }
231} 358}
232 359
2331; 360=item %Linux::DVB::Decode::nibble_to_genre
234 361
362A 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
369our %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
483Break down a "DVB time" (modified julian date + bcd encoded seconds) into
484it's components (non-C<_linear>) or into a seconds count (C<_linear>
485variants) since the epoch (C<datetime_linear>) or the start of the day
486(C<time_linear>).
487
488The format of the returns value of the date and datetime functions is
489I<not> compatible with C<Time::Local>. Use the C<_linear> functions
490instead.
491
492Example:
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
501sub 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
512sub 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
527sub datetime($$) {
528 (Linux::DVB::Decode::time $_[1], date $_[0])
529}
530
531sub time_linear($) {
532 my ($s, $m, $h) = Linux::DVB::Decode::time $_[0];
533
534 (($h * 60) + $m * 60) + $s
535}
536
537sub 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
235=head1 AUTHOR 547=head1 AUTHORS
236 548
237 Marc Lehmann <schmorp@schmorp.de> 549 Marc Lehmann <schmorp@schmorp.de>, http://home.schmorp.de/
238 http://home.schmorp.de/ 550 Magnus Schmidt, eMail at http://www.27b-6.de/email.php
239 551
240=cut 552=cut
241 553
5541

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines