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.13 by root, Wed May 24 21:03:08 2006 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.0';
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.
192
193=item $reply = $fe->diseqc_reply ($timeout)
194
195Receives a reply to a DiSEqC 2.0 command (or undef).
196
197=cut
198
178package Linux::DVB::Demux; 199package Linux::DVB::Demux;
179 200
180@ISA = qw(Linux::DVB); 201@ISA = qw(Linux::DVB);
202
203=back
181 204
182=head1 Linux::DVB::Demux CLASS 205=head1 Linux::DVB::Demux CLASS
183 206
184=head2 SYNOPSIS 207=head2 SYNOPSIS
185 208
194 $dmx->sct_filter ($pid, "filter", "mask", $timeout=0, $flags=DMX_CHECK_CRC); 217 $dmx->sct_filter ($pid, "filter", "mask", $timeout=0, $flags=DMX_CHECK_CRC);
195 $dmx->pes_filter ($pid, $input, $output, $type, $flags=0); 218 $dmx->pes_filter ($pid, $input, $output, $type, $flags=0);
196 $dmx->start; 219 $dmx->start;
197 $dmx->stop; 220 $dmx->stop;
198 221
222=over 4
223
199=cut 224=cut
200 225
201sub new { 226sub new {
202 my ($class, $path) = @_; 227 my ($class, $path) = @_;
203 my $self = $class->SUPER::new ($path, &Fcntl::O_RDWR); 228 my $self = $class->SUPER::new ($path, &Fcntl::O_RDWR);
212sub pes_filter { _pes_filter ($_[0]{fd}, @_[1, 2, 3, 4, 5]) } 237sub pes_filter { _pes_filter ($_[0]{fd}, @_[1, 2, 3, 4, 5]) }
213sub buffer { _buffer ($_[0]{fd}, $_[1]) } 238sub buffer { _buffer ($_[0]{fd}, $_[1]) }
214 239
215package Linux::DVB::Decode; 240package Linux::DVB::Decode;
216 241
217use Encode; 242=back
243
244=head1 Linux::DVB::Decode CLASS
245
246=head2 SYNOPSIS
247
248 $si_decoded_hashref = Linux::DVB::Decode::si $section_data;
249
250=over 4
251
252=cut
253
254=item $hashref = Linux::DVB::Decode::si $section_data
255
256Tries to parse the string inside C<$section_data> as an SI table and
257return it as a hash reference. Only the first SI table will be returned
258as hash reference, and the C<$section_data> will be modified in-place by
259removing the table data.
260
261The way to use this function is to append new data to your
262C<$section_data> and then call C<Linux::DVB::Decode::si> in a loop until
263it returns C<undef>. Please ntoe, however, that the Linux DVB API will
264return only one table at a time from sysread, so you can safely assume
265that every sysread will return exactly one (or zero in case of errors) SI
266table.
267
268Here is an example of what to expect:
269
270 {
271 'segment_last_section_number' => 112,
272 'table_id' => 81,
273 'service_id' => 28129,
274 'original_network_id' => 1,
275 'section_syntax_indicator' => 1,
276 'current_next_indicator' => 1,
277 'events' => [
278 {
279 'running_status' => 0,
280 'start_time_hms' => 2097152,
281 'event_id' => 39505,
282 'free_CA_mode' => 0,
283 'start_time_mjd' => 53470,
284 'descriptors' => [
285 {
286 'event_name' => 'Nachrichten',
287 'text' => '',
288 'ISO_639_language_code' => 'deu',
289 'type' => 77
290 },
291 {
292 'programme_identification_label' => 337280,
293 'type' => 105
294 },
295 {
296 'raw_data' => '22:0010.04#00',
297 'type' => 130
298 }
299 ],
300 'duration' => 1280
301 },
302 {
303 'running_status' => 0,
304 'start_time_hms' => 2098432,
305 'event_id' => 39506,
306 'free_CA_mode' => 0,
307 'start_time_mjd' => 53470,
308 'descriptors' => [
309 {
310 'event_name' => 'SR 1 - Nachtwerk',
311 'text' => '',
312 'ISO_639_language_code' => 'deu',
313 'type' => 77
314 },
315 {
316 'programme_identification_label' => 337285,
317 'type' => 105
318 },
319 {
320 'raw_data' => '22:0510.04#00',
321 'type' => 130
322 }
323 ],
324 'duration' => 87296
325 }
326 ],
327 'last_table_id' => 81,
328 'section_number' => 112,
329 'last_section_number' => 176,
330 'version_number' => 31,
331 'transport_stream_id' => 1101
332 }
333
334
335=item $text = Linux::DVB::Decode::text $data
336
337Converts text found in DVB si tables into perl text. Only iso-8859-1..-11
338and UTF-16 is supported, other encodings (big5 etc. is not. Bug me if you
339need this).
340
341=cut
218 342
219sub text($) { 343sub text($) {
344 use Encode;
345
220 for ($_[0]) { 346 for ($_[0]) {
221 s/^([\x01-\x0b])// and $_ = decode sprintf ("iso-8859-%d", 4 + ord $1), $_; 347 s/^([\x01-\x0b])// and $_ = decode sprintf ("iso-8859-%d", 4 + ord $1), $_;
222 # 10 - pardon you??? 348 # 10 - pardon you???
223 s/^\x11// and $_ = decode "utf16-be", $_; 349 s/^\x11// and $_ = decode "utf16-be", $_;
224 # 12 ksc5601, DB 350 # 12 ksc5601, DB
228 #s/([\x00-\x09\x0b-\x1f\x80-\x9f])/sprintf "{%02x}", ord $1/ge; 354 #s/([\x00-\x09\x0b-\x1f\x80-\x9f])/sprintf "{%02x}", ord $1/ge;
229 s/([\x00-\x09\x0b-\x1f\x80-\x9f])//ge; 355 s/([\x00-\x09\x0b-\x1f\x80-\x9f])//ge;
230 } 356 }
231} 357}
232 358
2331; 359=item %Linux::DVB::Decode::nibble_to_genre
234 360
361A two-level hash mapping genre nibbles to genres, e.g.
362
363 $Linux::DVB::Decode::nibble_to_genre{7}{6}
364 => 'film/cinema'
365
366=cut
367
368our %nibble_to_genre = (
369 0x1 => {
370 0x0 => 'Movie/Drama (general)',
371 0x1 => 'Movie - detective/thriller',
372 0x2 => 'Movie - adventure/western/war',
373 0x3 => 'Movie - science fiction/fantasy/horror',
374 0x4 => 'Movie - comedy',
375 0x5 => 'Movie - soap/melodrama/folkloric',
376 0x6 => 'Movie - romance',
377 0x7 => 'Movie - serious/classical/religious/historical movie/drama',
378 0x8 => 'Movie - adult movie/drama',
379 },
380 0x2 => {
381 0x0 => 'News/Current Affairs (general)',
382 0x1 => 'news/weather report',
383 0x2 => 'news magazine',
384 0x3 => 'documentary',
385 0x4 => 'discussion/interview/debate',
386 },
387 0x3 => {
388 0x0 => 'Show/Game Show (general)',
389 0x1 => 'game show/quiz/contest',
390 0x2 => 'variety show',
391 0x3 => 'talk show',
392 },
393 0x4 => {
394 0x0 => 'Sports (general)',
395 0x1 => 'special events (Olympic Games, World Cup etc.)',
396 0x2 => 'sports magazines',
397 0x3 => 'football/soccer',
398 0x4 => 'tennis/squash',
399 0x5 => 'team sports (excluding football)',
400 0x6 => 'athletics',
401 0x7 => 'motor sport',
402 0x8 => 'water sport',
403 0x9 => 'winter sports',
404 0xA => 'equestrian',
405 0xB => 'martial sports',
406 },
407 0x5 => {
408 0x0 => 'Childrens/Youth (general)',
409 0x1 => "pre-school children's programmes",
410 0x2 => 'entertainment programmes for 6 to 14',
411 0x3 => 'entertainment programmes for 10 to 16',
412 0x4 => 'informational/educational/school programmes',
413 0x5 => 'cartoons/puppets',
414 },
415 0x6 => {
416 0x0 => 'Music/Ballet/Dance (general)',
417 0x1 => 'rock/pop',
418 0x2 => 'serious music or classical music',
419 0x3 => 'folk/traditional music',
420 0x4 => 'jazz',
421 0x5 => 'musical/opera',
422 0x6 => 'ballet',
423 },
424 0x7 => {
425 0x0 => 'Arts/Culture (without music, general)',
426 0x1 => 'performing arts',
427 0x2 => 'fine arts',
428 0x3 => 'religion',
429 0x4 => 'popular culture/traditional arts',
430 0x5 => 'literature',
431 0x6 => 'film/cinema',
432 0x7 => 'experimental film/video',
433 0x8 => 'broadcasting/press',
434 0x9 => 'new media',
435 0xA => 'arts/culture magazines',
436 0xB => 'fashion',
437 },
438 0x8 => {
439 0x0 => 'Social/Policical/Economics (general)',
440 0x1 => 'magazines/reports/documentary',
441 0x2 => 'economics/social advisory',
442 0x3 => 'remarkable people',
443 },
444 0x9 => {
445 0x0 => 'Education/Science/Factual (general)',
446 0x1 => 'nature/animals/environment',
447 0x2 => 'technology/natural sciences',
448 0x3 => 'medicine/physiology/psychology',
449 0x4 => 'foreign countries/expeditions',
450 0x5 => 'social/spiritual sciences',
451 0x6 => 'further education',
452 0x7 => 'languages',
453 },
454 0xA => {
455 0x0 => 'Leisure/Hobbies (general)',
456 0x1 => 'tourism/travel',
457 0x2 => 'handicraft',
458 0x3 => 'motoring',
459 0x4 => 'fitness & health',
460 0x5 => 'cooking',
461 0x6 => 'advertizement/shopping',
462 0x7 => 'gardening',
463 },
464 0xB => {
465 0x0 => '(original language)',
466 0x1 => '(black & white)',
467 0x2 => '(unpublished)',
468 0x3 => '(live broadcast)',
469 },
470);
471
472=item ($sec,$min,$hour) = Linux::DVB::Decode::time $hms
473
474=item ($mday,$mon,$year) = Linux::DVB::Decode::date $mjd
475
476=item ($sec,$min,$hour,$mday,$mon,$year) = Linux::DVB::Decode::datetime $mjd, $hms
477
478=item $sec = Linux::DVB::Decode::time_linear $hms
479
480=item $sec = Linux::DVB::Decode::datetime_linear $mjd, $hms
481
482Break down a "DVB time" (modified julian date + bcd encoded seconds) into
483it's components (non-C<_linear>) or into a seconds count (C<_linear>
484variants) since the epoch (C<datetime_linear>) or the start of the day
485(C<time_linear>).
486
487The format of the returns value of the date and datetime functions is
488I<not> compatible with C<Time::Local>. Use the C<_linear> functions
489instead.
490
491Example:
492
493 my $time = Linux::DVB::Decode::datetime_linear $mjd, $hms
494 printf "Starts at %s\n",
495 POSIX::strftime "%Y-%m-%d %H:%M:%S",
496 localtime $time;
497
498=cut
499
500sub time($) {
501 my ($time) = @_;
502
503 # Time is in UTC, 24 bit, every nibble one digit in BCD from right to left
504 my $hour = sprintf "%02x", ($time >> 16) & 0xFF;
505 my $minute = sprintf "%02x", ($time >> 8) & 0xFF;
506 my $second = sprintf "%02x", ($time ) & 0xFF;
507
508 ($second, $minute, $hour)
509}
510
511sub date($) {
512 my ($mjd) = @_;
513
514 # Date is given in Modified Julian Date
515 # Decoding routines taken from ANNEX C, ETSI EN 300 468 (DVB SI)
516 my $y_ = int (($mjd - 15078.2) / 365.25);
517 my $m_ = int (($mjd - 14956.1 - int ($y_ * 365.25)) / 30.6001);
518 my $day = $mjd - 14956 - int ($y_ * 365.25) - int ($m_ * 30.6001);
519 my $k = $m_ == 14 or $m_ == 15 ? 1 : 0;
520 my $year = $y_ + $k + 1900;
521 my $month = $m_ - 1 - $k * 12;
522
523 ($day, $month, $year)
524}
525
526sub datetime($$) {
527 (Linux::DVB::Decode::time $_[1], date $_[0])
528}
529
530sub time_linear($) {
531 my ($s, $m, $h) = Linux::DVB::Decode::time $_[0];
532
533 (($h * 60) + $m * 60) + $s
534}
535
536sub datetime_linear($$) {
537 my ($sec, $min, $hour, $mday, $mon, $year) =
538 Linux::DVB::Decode::datetime $_[0], $_[1];
539
540 require Time::Local;
541 Time::Local::timegm ($sec, $min, $hour, $mday, $mon - 1, $year)
542}
543
544=back
545
235=head1 AUTHOR 546=head1 AUTHORS
236 547
237 Marc Lehmann <schmorp@schmorp.de> 548 Marc Lehmann <schmorp@schmorp.de>, http://home.schmorp.de/
238 http://home.schmorp.de/ 549 Magnus Schmidt, eMail at http://www.27b-6.de/email.php
239 550
240=cut 551=cut
241 552
5531

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines