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