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.4';
   @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       =>
  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
    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 (general)',
              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 (general)',
              0x1 => 'news/weather report',
              0x2 => 'news magazine',
              0x3 => 'documentary',
              0x4 => 'discussion/interview/debate',
            },
     0x3 => {
              0x0 => 'Show/Game Show (general)',
              0x1 => 'game show/quiz/contest',
              0x2 => 'variety show',
              0x3 => 'talk show',
            },
     0x4 => {
              0x0 => 'Sports (general)',
              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 (general)',
              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 (general)',
              0x1 => 'rock/pop',
              0x2 => 'serious music or classical music',
              0x3 => 'folk/traditional music',
              0x4 => 'jazz',
              0x5 => 'musical/opera',
              0x6 => 'ballet',
            },
     0x7 => {
              0x0 => 'Arts/Culture (without music, general)',
              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 (general)',
              0x1 => 'magazines/reports/documentary',
              0x2 => 'economics/social advisory',
              0x3 => 'remarkable people',
            },
     0x9 => {
              0x0 => 'Education/Science/Factual (general)',
              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 (general)',
              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) = Linux::DVB::Decode::time $hms

=item ($mday,$mon,$year) = Linux::DVB::Decode::date $mjd

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

=item $sec = Linux::DVB::Decode::time_linear $hms

=item $sec = Linux::DVB::Decode::datetime_linear $mjd, $hms

Break down a "DVB time" (modified julian date + bcd encoded seconds) into
it's components (non-C<_linear>) or into a seconds count (C<_linear>
variants) since the epoch (C<datetime_linear>) or the start of the day
(C<time_linear>).

The format of the returns value of the date and datetime functions is
I<not> compatible with C<Time::Local>. Use the C<_linear> functions
instead.

Example:

   my $time = Linux::DVB::Decode::datetime_linear $mjd, $hms
   printf "Starts at %s\n",
      POSIX::strftime "%Y-%m-%d %H:%M:%S",
         localtime $time;

=cut

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

   # 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;

   ($second, $minute, $hour)
}

sub date($) {
   my ($mjd) = @_;

   # 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;

   ($day, $month, $year)
}

sub datetime($$) {
   (Linux::DVB::Decode::time $_[1], date $_[0])
}

sub time_linear($) {
   my ($s, $m, $h) = Linux::DVB::Decode::time $_[0];

   (($h * 60) + $m * 60) + $s
}

sub datetime_linear($$) {
   my ($sec, $min, $hour, $mday, $mon, $year) =
      Linux::DVB::Decode::datetime $_[0], $_[1];

   require Time::Local;
   Time::Local::timegm ($sec, $min, $hour, $mday, $mon - 1, $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.11
Committed:	Wed May 17 15:46:26 2006 UTC (18 years ago) by root
Branch:	MAIN
Changes since 1.10:	+0 -2 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.9	$VERSION = '0.4';
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			modulation =>
140
141			QFDM frontends:
142
143			bandwidth =>
144			code_rate_HP =>
145			code_rate_LP =>
146			constellation =>
147			transmission_mode =>
148
149			=cut
150
151			sub set {
152			my ($self) = shift;
153			_set $self->{fd}, { @_ }, $self->{type}
154			}
155
156			=item $fe->parameters
157
158			Calls FE_GET_FRONTEND and returns a hash reference that contains the same keys
159			as given to the C<set> method.
160
161			Example:
162
163			Data::Dumper::Dumper $fe->get
164
165			{
166			frequency => 426000000, # 426 Mhz
167			inversion => 0, # INVERSION_OFF
168			symbol_rate => 6900000, # 6.9 MB/s
169			modulation => 3, # QAM_64
170			}
171
172			=cut
173
174	root	1.1	sub parameters { _get ($_[0]{fd}, $_[0]{type}) }
175	root	1.5	sub get { _get ($_[0]{fd}, $_[0]{type}) } # unannounced alias
176	root	1.1	sub event { _event ($_[0]{fd}, $_[0]{type}) }
177
178			package Linux::DVB::Demux;
179
180			@ISA = qw(Linux::DVB);
181
182	root	1.6	=back
183
184	root	1.1	=head1 Linux::DVB::Demux CLASS
185
186			=head2 SYNOPSIS
187
188			my $dmx = new Linux::DVB::Demux
189			"/dev/dvb/adapter0/demux0";
190
191			$fe->fh; # filehandle
192			$fe->fd; # fileno
193			$fe->blocking (1); # non-blocking is default
194
195			$dmx->buffer (16384);
196			$dmx->sct_filter ($pid, "filter", "mask", $timeout=0, $flags=DMX_CHECK_CRC);
197			$dmx->pes_filter ($pid, $input, $output, $type, $flags=0);
198			$dmx->start;
199			$dmx->stop;
200
201	root	1.6	=over 4
202
203	root	1.1	=cut
204
205			sub new {
206			my ($class, $path) = @_;
207			my $self = $class->SUPER::new ($path, &Fcntl::O_RDWR);
208
209			$self;
210			}
211
212			sub start { _start ($_[0]{fd}) }
213			sub stop { _stop ($_[0]{fd}) }
214
215			sub sct_filter { _filter ($_[0]{fd}, @_[1, 2, 3, 4, 5]) }
216			sub pes_filter { _pes_filter ($_[0]{fd}, @_[1, 2, 3, 4, 5]) }
217			sub buffer { _buffer ($_[0]{fd}, $_[1]) }
218
219	root	1.2	package Linux::DVB::Decode;
220
221	root	1.6	=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
321	root	1.2
322			sub text($) {
323	root	1.6	use Encode;
324
325	root	1.2	for ($_[0]) {
326			s/^([\x01-\x0b])// and $_ = decode sprintf ("iso-8859-%d", 4 + ord $1), $_;
327			# 10 - pardon you???
328			s/^\x11// and $_ = decode "utf16-be", $_;
329			# 12 ksc5601, DB
330			# 13 db2312, DB
331			# 14 big5(?), DB
332			s/\x8a/\n/g;
333			#s/([\x00-\x09\x0b-\x1f\x80-\x9f])/sprintf "{%02x}", ord $1/ge;
334			s/([\x00-\x09\x0b-\x1f\x80-\x9f])//ge;
335			}
336			}
337
338	root	1.6	=item %Linux::DVB::Decode::nibble_to_genre
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	root	1.10	0x0 => 'Movie/Drama (general)',
350	root	1.6	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	root	1.10	0x0 => 'News/Current Affairs (general)',
361	root	1.6	0x1 => 'news/weather report',
362			0x2 => 'news magazine',
363			0x3 => 'documentary',
364			0x4 => 'discussion/interview/debate',
365			},
366			0x3 => {
367	root	1.10	0x0 => 'Show/Game Show (general)',
368	root	1.6	0x1 => 'game show/quiz/contest',
369			0x2 => 'variety show',
370			0x3 => 'talk show',
371			},
372			0x4 => {
373	root	1.10	0x0 => 'Sports (general)',
374	root	1.6	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	root	1.10	0x0 => 'Childrens/Youth (general)',
388	root	1.6	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	root	1.10	0x0 => 'Music/Ballet/Dance (general)',
396	root	1.6	0x1 => 'rock/pop',
397	root	1.10	0x2 => 'serious music or classical music',
398	root	1.6	0x3 => 'folk/traditional music',
399			0x4 => 'jazz',
400			0x5 => 'musical/opera',
401			0x6 => 'ballet',
402			},
403			0x7 => {
404	root	1.10	0x0 => 'Arts/Culture (without music, general)',
405	root	1.6	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	root	1.10	0x0 => 'Social/Policical/Economics (general)',
419	root	1.6	0x1 => 'magazines/reports/documentary',
420			0x2 => 'economics/social advisory',
421			0x3 => 'remarkable people',
422			},
423			0x9 => {
424	root	1.10	0x0 => 'Education/Science/Factual (general)',
425	root	1.6	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	root	1.10	0x0 => 'Leisure/Hobbies (general)',
435	root	1.6	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	root	1.10	0x0 => '(original language)',
445			0x1 => '(black & white)',
446			0x2 => '(unpublished)',
447			0x3 => '(live broadcast)',
448	root	1.6	},
449			);
450
451	root	1.8	=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	root	1.6
461			Break down a "DVB time" (modified julian date + bcd encoded seconds) into
462	root	1.8	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	root	1.9	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	root	1.8	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	root	1.6
477			=cut
478
479	root	1.8	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	root	1.6
493			# Date is given in Modified Julian Date
494			# Decoding routines taken from ANNEX C, ETSI EN 300 468 (DVB SI)
495	root	1.9	my $y_ = int (($mjd - 15078.2) / 365.25);
496	root	1.6	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	root	1.8	($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	root	1.6
515	root	1.8	sub datetime_linear($$) {
516	root	1.9	my ($sec, $min, $hour, $mday, $mon, $year) =
517			Linux::DVB::Decode::datetime $_[0], $_[1];
518
519	root	1.8	require Time::Local;
520	root	1.9	Time::Local::timegm ($sec, $min, $hour, $mday, $mon - 1, $year)
521	root	1.6	}
522
523			=back
524	root	1.1
525	root	1.6	=head1 AUTHORS
526	root	1.1
527	root	1.6	Marc Lehmann <schmorp@schmorp.de>, http://home.schmorp.de/
528			Magnus Schmidt, eMail at http://www.27b-6.de/email.php
529	root	1.1
530			=cut
531
532	root	1.6	1