cvsroot/Linux-DVB/DVB.pm

=head1 NAME

Linux::DVB - interface to (some parts of) the Linux DVB API

=head1 SYNOPSIS

 use Linux::DVB;

=head1 DESCRIPTION

This module provides an interface to the Linux DVB API. It is a straightforward
translation of the C API. You should read the Linux DVB API description to make
any sense of this module. It can be found here:

   http://www.linuxtv.org/docs/dvbapi/dvbapi.html

All constants from F<frontend.h> and F<demux.h> are exported by their C
name and by default.

Noteworthy differences to the C API: unions and sub-structs are usually
translated into flat perl hashes, i.e C<struct.u.qam.symbol_rate>
becomes C<< $struct->{symbol_rate} >>.

Noteworthy limitations of this module include: no way to set the
frequency or diseqc. No interface to the video, audio and net devices.
If you need this functionality bug the author.

=cut

package Linux::DVB;

use Fcntl ();

BEGIN {
   $VERSION = '0.3';
   @ISA = qw(Exporter);

   require XSLoader;
   XSLoader::load __PACKAGE__, $VERSION;

   require Exporter;

   my %consts = &_consts;
   my $consts;
   while (my ($k, $v) = each %consts) {
      push @EXPORT, $k;
      $consts .= "sub $k(){$v}\n";
   }
   eval $consts;
}

sub new {
   my ($class, $path, $mode) = @_;

   my $self = bless { path => $path, mode => $mode }, $class;
   sysopen $self->{fh}, $path, $mode | &Fcntl::O_NONBLOCK
      or die "$path: $!";
   $self->{fd} = fileno $self->{fh};

   $self;
}

sub fh { $_[0]{fh} }
sub fd { $_[0]{fd} }

sub blocking {
   fcntl $_[0]{fh}, &Fcntl::F_SETFL, $_[1] ? 0 : &Fcntl::O_NONBLOCK;
}

package Linux::DVB::Frontend;

@ISA = qw(Linux::DVB);

=head1 Linux::DVB::Frontend CLASS

=head2 SYNOPSIS

 my $fe = new Linux::DVB::Frontend $path, $writable;

 my $fe = new Linux::DVB::Frontend
             "/dev/dvb/adapter0/frontend0", 1;

 $fe->fh; # filehandle
 $fe->fd; # fileno
 $fe->blocking (0); # or 1

 $fe->{name}
 $fe->{type}
 $fe->frontend_info->{name}

 $fe->status & FE_HAS_LOCK
 print $fe->ber, $fe->snr, $fe->signal_strength, $fe->uncorrected;

 my $tune = $fe->parameters;
 $tune->{frequency};
 $tune->{symbol_rate};

=over 4

=cut

sub new {
   my ($class, $path, $mode) = @_;
   my $self = $class->SUPER::new ($path, $mode ? &Fcntl::O_RDWR : &Fcntl::O_RDONLY);

   %$self = ( %$self, %{ $self->frontend_info } );
   
   $self;
}

sub frontend_info   { _frontend_info   ($_[0]{fd}) }
sub status          { _read_status     ($_[0]{fd}) }
sub ber             { _read_ber        ($_[0]{fd}) }
sub snr             { _snr             ($_[0]{fd}) }
sub signal_strength { _signal_strength ($_[0]{fd}) }
sub uncorrected     { _uncorrected     ($_[0]{fd}) }

=item $fe->set (parameter => value, ...)

Sets frontend parameters. All values are stuffed into the
C<dvb_frontend_parameters> structure without conversion and passed to
FE_SET_FRONTEND.

Returns true on success.

All modes:

  frequency         =>
  inversion         =>

QPSK frontends:

  symbol_rate       =>
  fec_inner         =>

QAM frontends:

  symbol_rate       =>
  fec_inner         =>
  modulation        =>

QFDM frontends:

  bandwidth         =>
  code_rate_HP      =>
  code_rate_LP      =>
  constellation     =>
  transmission_mode =>

=cut

sub set             {
   my ($self) = shift;
   _set $self->{fd}, { @_ }, $self->{type}
}

=item $fe->parameters

Calls FE_GET_FRONTEND and returns a hash reference that contains the same keys
as given to the C<set> method.

Example:

  Data::Dumper::Dumper $fe->get
  
  {
    frequency   => 426000000, # 426 Mhz
    inversion   => 0,         # INVERSION_OFF
    symbol_rate => 6900000,   # 6.9 MB/s
    fec_inner   => 0,         # FEC_NONE
    modulation  => 3,         # QAM_64
  }

=cut

sub parameters      { _get   ($_[0]{fd}, $_[0]{type}) }
sub get             { _get   ($_[0]{fd}, $_[0]{type}) } # unannounced alias
sub event           { _event ($_[0]{fd}, $_[0]{type}) }

package Linux::DVB::Demux;

@ISA = qw(Linux::DVB);

=back

=head1 Linux::DVB::Demux CLASS

=head2 SYNOPSIS

 my $dmx = new Linux::DVB::Demux
             "/dev/dvb/adapter0/demux0";

 $fe->fh; # filehandle
 $fe->fd; # fileno
 $fe->blocking (1); # non-blocking is default

 $dmx->buffer (16384);
 $dmx->sct_filter ($pid, "filter", "mask", $timeout=0, $flags=DMX_CHECK_CRC);
 $dmx->pes_filter ($pid, $input, $output, $type, $flags=0);
 $dmx->start; 
 $dmx->stop; 

=over 4

=cut

sub new {
   my ($class, $path) = @_;
   my $self = $class->SUPER::new ($path, &Fcntl::O_RDWR);
   
   $self;
}

sub start      { _start      ($_[0]{fd}) }
sub stop       { _stop       ($_[0]{fd}) }

sub sct_filter { _filter     ($_[0]{fd}, @_[1, 2, 3, 4, 5]) }
sub pes_filter { _pes_filter ($_[0]{fd}, @_[1, 2, 3, 4, 5]) }
sub buffer     { _buffer     ($_[0]{fd}, $_[1]) }

package Linux::DVB::Decode;

=back

=head1 Linux::DVB::Decode CLASS

=head2 SYNOPSIS

   $si_decoded_hashref = Linux::DVB::Decode::si $section_data;

=over 4

=cut

=item $hashref = Linux::DVB::Decode::si $section_data

Tries to parse the string inside C<$section_data> as an SI table and
return it as a hash reference.  Only the first SI table will be returned
as hash reference, and the C<$section_data> will be modified in-place by
removing the table data.

The way to use this function is to append new data to your
C<$section_data> and then call C<Linux::DVB::Decode::si> in a loop until
it returns C<undef>. Please ntoe, however, that the Linux DVB API will
return only one table at a time from sysread, so you can safely assume
that every sysread will return exactly one (or zero in case of errors) SI
table.

Here is an example of what to expect:

  {
    'segment_last_section_number' => 112,
    'table_id' => 81,
    'service_id' => 28129,
    'original_network_id' => 1,
    'section_syntax_indicator' => 1,
    'current_next_indicator' => 1,
    'events' => [
                  {
                    'running_status' => 0,
                    'start_time_hms' => 2097152,
                    'event_id' => 39505,
                    'free_CA_mode' => 0,
                    'start_time_mjd' => 53470,
                    'descriptors' => [
                                       {
                                         'event_name' => 'Nachrichten',
                                         'text' => '',
                                         'ISO_639_language_code' => 'deu',
                                         'type' => 77
                                       },
                                       {
                                         'programme_identification_label' => 337280,
                                         'type' => 105
                                       },
                                       {
                                         'raw_data' => '22:0010.04#00',
                                         'type' => 130
                                       }
                                     ],
                    'duration' => 1280
                  },
                  {
                    'running_status' => 0,
                    'start_time_hms' => 2098432,
                    'event_id' => 39506,
                    'free_CA_mode' => 0,
                    'start_time_mjd' => 53470,
                    'descriptors' => [
                                       {
                                         'event_name' => 'SR 1 - Nachtwerk',
                                         'text' => '',
                                         'ISO_639_language_code' => 'deu',
                                         'type' => 77
                                       },
                                       {
                                         'programme_identification_label' => 337285,
                                         'type' => 105
                                       },
                                       {
                                         'raw_data' => '22:0510.04#00',
                                         'type' => 130
                                       }
                                     ],
                    'duration' => 87296
                  }
                ],
    'last_table_id' => 81,
    'section_number' => 112,
    'last_section_number' => 176,
    'version_number' => 31,
    'transport_stream_id' => 1101
  }


=item $text = Linux::DVB::Decode::text $data

Converts text found in DVB si tables into perl text. Only iso-8859-1..-11
and UTF-16 is supported, other encodings (big5 etc. is not. Bug me if you
need this).

=cut

sub text($) {
   use Encode;

   for ($_[0]) {
      s/^([\x01-\x0b])// and $_ = decode sprintf ("iso-8859-%d", 4 + ord $1), $_;
      # 10 - pardon you???
      s/^\x11// and $_ = decode "utf16-be", $_;
      # 12 ksc5601, DB
      # 13 db2312, DB
      # 14 big5(?), DB
      s/\x8a/\n/g;
      #s/([\x00-\x09\x0b-\x1f\x80-\x9f])/sprintf "{%02x}", ord $1/ge;
      s/([\x00-\x09\x0b-\x1f\x80-\x9f])//ge;
   }
}

=item %Linux::DVB::Decode::nibble_to_genre

A two-level hash mapping genre nibbles to genres, e.g.

   $Linux::DVB::Decode::nibble_to_genre{7}{6}
   => 'film/cinema'

=cut

our %nibble_to_genre = (
     0x1 => {
              0x0 => 'Movie / Drama',
              0x1 => 'Movie - detective/thriller',
              0x2 => 'Movie - adventure/western/war',
              0x3 => 'Movie - science fiction/fantasy/horror',
              0x4 => 'Movie - comedy',
              0x5 => 'Movie - soap/melodrama/folkloric',
              0x6 => 'Movie - romance',
              0x7 => 'Movie - serious/classical/religious/historical movie/drama',
              0x8 => 'Movie - adult movie/drama',
            },
     0x2 => {
              0x0 => 'News / Current Affairs',
              0x1 => 'news/weather report',
              0x2 => 'news magazine',
              0x3 => 'documentary',
              0x4 => 'discussion/interview/debate',
            },
     0x3 => {
              0x0 => 'Show / Game Show',
              0x1 => 'game show/quiz/contest',
              0x2 => 'variety show',
              0x3 => 'talk show',
            },
     0x4 => {
              0x0 => 'Sports',
              0x1 => 'special events (Olympic Games, World Cup etc.)',
              0x2 => 'sports magazines',
              0x3 => 'football/soccer',
              0x4 => 'tennis/squash',
              0x5 => 'team sports (excluding football)',
              0x6 => 'athletics',
              0x7 => 'motor sport',
              0x8 => 'water sport',
              0x9 => 'winter sports',
              0xA => 'equestrian',
              0xB => 'martial sports',
            },
     0x5 => {
              0x0 => 'Childrens / Youth',
              0x1 => "pre-school children's programmes",
              0x2 => 'entertainment programmes for 6 to 14',
              0x3 => 'entertainment programmes for 10 to 16',
              0x4 => 'informational/educational/school programmes',
              0x5 => 'cartoons/puppets',
            },
     0x6 => {
              0x0 => 'Music / Ballet / Dance',
              0x1 => 'rock/pop',
              0x2 => 'serious music/classical music',
              0x3 => 'folk/traditional music',
              0x4 => 'jazz',
              0x5 => 'musical/opera',
              0x6 => 'ballet',
            },
     0x7 => {
              0x0 => 'Arts / Culture',
              0x1 => 'performing arts',
              0x2 => 'fine arts',
              0x3 => 'religion',
              0x4 => 'popular culture/traditional arts',
              0x5 => 'literature',
              0x6 => 'film/cinema',
              0x7 => 'experimental film/video',
              0x8 => 'broadcasting/press',
              0x9 => 'new media',
              0xA => 'arts/culture magazines',
              0xB => 'fashion',
            },
     0x8 => {
              0x0 => 'Social / Policical / Economics',
              0x1 => 'magazines/reports/documentary',
              0x2 => 'economics/social advisory',
              0x3 => 'remarkable people',
            },
     0x9 => {
              0x0 => 'Education / Science / Factual',
              0x1 => 'nature/animals/environment',
              0x2 => 'technology/natural sciences',
              0x3 => 'medicine/physiology/psychology',
              0x4 => 'foreign countries/expeditions',
              0x5 => 'social/spiritual sciences',
              0x6 => 'further education',
              0x7 => 'languages',
            },
     0xA => {
              0x0 => 'Leisure / Hobbies',
              0x1 => 'tourism/travel',
              0x2 => 'handicraft',
              0x3 => 'motoring',
              0x4 => 'fitness & health',
              0x5 => 'cooking',
              0x6 => 'advertizement/shopping',
              0x7 => 'gardening',
            },
     0xB => {
              0x0 => 'Original Language',
              0x1 => 'black & white',
              0x2 => 'unpublished',
              0x3 => 'live broadcast',
            },
);

=item ($sec,$min,$hour,$mday,$mon,$year) = Linux::DVB::Decode::time $mjd, $time

Break down a "DVB time" (modified julian date + bcd encoded seconds) into
it's components in UTC (i.e. use Time::Local::timegm to convert to UNIX
time).

=cut

sub time($$) {
   my ($mjd, $time) = @_;

   # Date is given in Modified Julian Date
   # Decoding routines taken from ANNEX C, ETSI EN 300 468 (DVB SI)
   my $y_ = int ($mjd - 15078.2) / 365.25;
   my $m_ = int (($mjd - 14956.1 - int ($y_ * 365.25)) / 30.6001);
   my $day = $mjd - 14956 - int ($y_ * 365.25) - int ($m_ * 30.6001);
   my $k = $m_ == 14 or $m_ == 15 ? 1 : 0;
   my $year = $y_ + $k + 1900;
   my $month = $m_ - 1 - $k * 12;

   # Time is in UTC, 24 bit, every nibble one digit in BCD from right to left
   my $hour   = sprintf "%02x", ($time >> 16) & 0xFF;
   my $minute = sprintf "%02x", ($time >>  8) & 0xFF;
   my $second = sprintf "%02x", ($time      ) & 0xFF;

   return ($second, $minute, $hour, $day, $month, $year);
}

=back

=head1 AUTHORS

 Marc Lehmann <schmorp@schmorp.de>, http://home.schmorp.de/
 Magnus Schmidt, eMail at http://www.27b-6.de/email.php

=cut

1
Revision:	1.7
Committed:	Mon Apr 11 21:14:12 2005 UTC (21 years, 5 months ago) by root
Branch:	MAIN
CVS Tags:	rel-0_3
Changes since 1.6:	+1 -1 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.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	root	1.5	http://www.linuxtv.org/docs/dvbapi/dvbapi.html
16	root	1.1
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 way to set the
25			frequency or diseqc. No interface to the video, audio and net devices.
26			If you need this functionality bug the author.
27
28			=cut
29
30			package Linux::DVB;
31
32			use Fcntl ();
33
34			BEGIN {
35	root	1.7	$VERSION = '0.3';
36	root	1.1	@ISA = qw(Exporter);
37
38			require XSLoader;
39			XSLoader::load __PACKAGE__, $VERSION;
40
41			require Exporter;
42
43			my %consts = &_consts;
44			my $consts;
45			while (my ($k, $v) = each %consts) {
46			push @EXPORT, $k;
47			$consts .= "sub $k(){$v}\n";
48			}
49			eval $consts;
50			}
51
52			sub new {
53			my ($class, $path, $mode) = @_;
54
55			my $self = bless { path => $path, mode => $mode }, $class;
56			sysopen $self->{fh}, $path, $mode \| &Fcntl::O_NONBLOCK
57			or die "$path: $!";
58			$self->{fd} = fileno $self->{fh};
59
60			$self;
61			}
62
63			sub fh { $_[0]{fh} }
64			sub fd { $_[0]{fd} }
65
66			sub blocking {
67			fcntl $_[0]{fh}, &Fcntl::F_SETFL, $_[1] ? 0 : &Fcntl::O_NONBLOCK;
68			}
69
70			package Linux::DVB::Frontend;
71
72			@ISA = qw(Linux::DVB);
73
74			=head1 Linux::DVB::Frontend CLASS
75
76			=head2 SYNOPSIS
77
78			my $fe = new Linux::DVB::Frontend $path, $writable;
79
80			my $fe = new Linux::DVB::Frontend
81			"/dev/dvb/adapter0/frontend0", 1;
82
83			$fe->fh; # filehandle
84			$fe->fd; # fileno
85			$fe->blocking (0); # or 1
86
87			$fe->{name}
88			$fe->{type}
89			$fe->frontend_info->{name}
90
91			$fe->status & FE_HAS_LOCK
92			print $fe->ber, $fe->snr, $fe->signal_strength, $fe->uncorrected;
93
94			my $tune = $fe->parameters;
95			$tune->{frequency};
96			$tune->{symbol_rate};
97
98	root	1.6	=over 4
99
100	root	1.1	=cut
101
102			sub new {
103			my ($class, $path, $mode) = @_;
104			my $self = $class->SUPER::new ($path, $mode ? &Fcntl::O_RDWR : &Fcntl::O_RDONLY);
105
106			%$self = ( %$self, %{ $self->frontend_info } );
107
108			$self;
109			}
110
111			sub frontend_info { _frontend_info ($_[0]{fd}) }
112			sub status { _read_status ($_[0]{fd}) }
113			sub ber { _read_ber ($_[0]{fd}) }
114			sub snr { _snr ($_[0]{fd}) }
115			sub signal_strength { _signal_strength ($_[0]{fd}) }
116			sub uncorrected { _uncorrected ($_[0]{fd}) }
117
118	root	1.5	=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
176	root	1.1	sub parameters { _get ($_[0]{fd}, $_[0]{type}) }
177	root	1.5	sub get { _get ($_[0]{fd}, $_[0]{type}) } # unannounced alias
178	root	1.1	sub event { _event ($_[0]{fd}, $_[0]{type}) }
179
180			package Linux::DVB::Demux;
181
182			@ISA = qw(Linux::DVB);
183
184	root	1.6	=back
185
186	root	1.1	=head1 Linux::DVB::Demux CLASS
187
188			=head2 SYNOPSIS
189
190			my $dmx = new Linux::DVB::Demux
191			"/dev/dvb/adapter0/demux0";
192
193			$fe->fh; # filehandle
194			$fe->fd; # fileno
195			$fe->blocking (1); # non-blocking is default
196
197			$dmx->buffer (16384);
198			$dmx->sct_filter ($pid, "filter", "mask", $timeout=0, $flags=DMX_CHECK_CRC);
199			$dmx->pes_filter ($pid, $input, $output, $type, $flags=0);
200			$dmx->start;
201			$dmx->stop;
202
203	root	1.6	=over 4
204
205	root	1.1	=cut
206
207			sub new {
208			my ($class, $path) = @_;
209			my $self = $class->SUPER::new ($path, &Fcntl::O_RDWR);
210
211			$self;
212			}
213
214			sub start { _start ($_[0]{fd}) }
215			sub stop { _stop ($_[0]{fd}) }
216
217			sub sct_filter { _filter ($_[0]{fd}, @_[1, 2, 3, 4, 5]) }
218			sub pes_filter { _pes_filter ($_[0]{fd}, @_[1, 2, 3, 4, 5]) }
219			sub buffer { _buffer ($_[0]{fd}, $_[1]) }
220
221	root	1.2	package Linux::DVB::Decode;
222
223	root	1.6	=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
323	root	1.2
324			sub text($) {
325	root	1.6	use Encode;
326
327	root	1.2	for ($_[0]) {
328			s/^([\x01-\x0b])// and $_ = decode sprintf ("iso-8859-%d", 4 + ord $1), $_;
329			# 10 - pardon you???
330			s/^\x11// and $_ = decode "utf16-be", $_;
331			# 12 ksc5601, DB
332			# 13 db2312, DB
333			# 14 big5(?), DB
334			s/\x8a/\n/g;
335			#s/([\x00-\x09\x0b-\x1f\x80-\x9f])/sprintf "{%02x}", ord $1/ge;
336			s/([\x00-\x09\x0b-\x1f\x80-\x9f])//ge;
337			}
338			}
339
340	root	1.6	=item %Linux::DVB::Decode::nibble_to_genre
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',
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',
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',
370			0x1 => 'game show/quiz/contest',
371			0x2 => 'variety show',
372			0x3 => 'talk show',
373			},
374			0x4 => {
375			0x0 => 'Sports',
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',
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',
398			0x1 => 'rock/pop',
399			0x2 => 'serious music/classical music',
400			0x3 => 'folk/traditional music',
401			0x4 => 'jazz',
402			0x5 => 'musical/opera',
403			0x6 => 'ballet',
404			},
405			0x7 => {
406			0x0 => 'Arts / Culture',
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',
421			0x1 => 'magazines/reports/documentary',
422			0x2 => 'economics/social advisory',
423			0x3 => 'remarkable people',
424			},
425			0x9 => {
426			0x0 => 'Education / Science / Factual',
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',
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,$mday,$mon,$year) = Linux::DVB::Decode::time $mjd, $time
454
455			Break down a "DVB time" (modified julian date + bcd encoded seconds) into
456			it's components in UTC (i.e. use Time::Local::timegm to convert to UNIX
457			time).
458
459			=cut
460
461			sub time($$) {
462			my ($mjd, $time) = @_;
463
464			# Date is given in Modified Julian Date
465			# Decoding routines taken from ANNEX C, ETSI EN 300 468 (DVB SI)
466			my $y_ = int ($mjd - 15078.2) / 365.25;
467			my $m_ = int (($mjd - 14956.1 - int ($y_ * 365.25)) / 30.6001);
468			my $day = $mjd - 14956 - int ($y_ * 365.25) - int ($m_ * 30.6001);
469			my $k = $m_ == 14 or $m_ == 15 ? 1 : 0;
470			my $year = $y_ + $k + 1900;
471			my $month = $m_ - 1 - $k * 12;
472
473			# Time is in UTC, 24 bit, every nibble one digit in BCD from right to left
474			my $hour = sprintf "%02x", ($time >> 16) & 0xFF;
475			my $minute = sprintf "%02x", ($time >> 8) & 0xFF;
476			my $second = sprintf "%02x", ($time ) & 0xFF;
477
478			return ($second, $minute, $hour, $day, $month, $year);
479			}
480
481			=back
482	root	1.1
483	root	1.6	=head1 AUTHORS
484	root	1.1
485	root	1.6	Marc Lehmann <schmorp@schmorp.de>, http://home.schmorp.de/
486			Magnus Schmidt, eMail at http://www.27b-6.de/email.php
487	root	1.1
488			=cut
489
490	root	1.6	1