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