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 interface to the video,
audio and net devices. If you need this functionality bug the author.

=cut

package Linux::DVB;

use Fcntl ();

BEGIN {
   $VERSION = '1.0';
   @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;
}

=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}) }

=item $ok = $fe->diseqc_reset_overload

If the bus has been automatically powered off due to power overload, this
call restores the power to the bus. The call requires read/write access
to the device. This call has no effect if the device is manually powered
off. Not all DVB adapters support this call.

=item $ok = $fe->diseqc_voltage (13|18)

Set the DiSEqC voltage to either 13 or 18 volts.

=item $ok = $fe->diseqc_tone (1|0)

Enables (1) or disables (0) the DiSEqC continuous 22khz tone generation.

=item $ok = $fe->diseqc_send_burst (0|1)

Sends a 22KHz tone burst of type SEC_MINI_A (0) or SEC_MINI_B (1).

=item $ok = $fe->diseqc_cmd ($command)

Sends a DiSEqC command.

=item $reply = $fe->diseqc_reply ($timeout)

Receives a reply to a DiSEqC 2.0 command (or undef).

=cut

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.13
Committed:	Wed May 24 21:03:08 2006 UTC (17 years, 11 months ago) by root
Branch:	MAIN
Changes since 1.12:	+2 -3 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	root	1.13	Noteworthy limitations of this module include: No interface to the video,
25			audio and net devices. If you need this functionality bug the author.
26	root	1.1
27			=cut
28
29			package Linux::DVB;
30
31			use Fcntl ();
32
33			BEGIN {
34	root	1.12	$VERSION = '1.0';
35	root	1.1	@ISA = qw(Exporter);
36
37			require XSLoader;
38			XSLoader::load __PACKAGE__, $VERSION;
39
40			require Exporter;
41
42			my %consts = &_consts;
43			my $consts;
44			while (my ($k, $v) = each %consts) {
45			push @EXPORT, $k;
46			$consts .= "sub $k(){$v}\n";
47			}
48			eval $consts;
49			}
50
51			sub new {
52			my ($class, $path, $mode) = @_;
53
54			my $self = bless { path => $path, mode => $mode }, $class;
55			sysopen $self->{fh}, $path, $mode \| &Fcntl::O_NONBLOCK
56			or die "$path: $!";
57			$self->{fd} = fileno $self->{fh};
58
59			$self;
60			}
61
62			sub fh { $_[0]{fh} }
63			sub fd { $_[0]{fd} }
64
65			sub blocking {
66			fcntl $_[0]{fh}, &Fcntl::F_SETFL, $_[1] ? 0 : &Fcntl::O_NONBLOCK;
67			}
68
69			package Linux::DVB::Frontend;
70
71			@ISA = qw(Linux::DVB);
72
73			=head1 Linux::DVB::Frontend CLASS
74
75			=head2 SYNOPSIS
76
77			my $fe = new Linux::DVB::Frontend $path, $writable;
78
79			my $fe = new Linux::DVB::Frontend
80			"/dev/dvb/adapter0/frontend0", 1;
81
82			$fe->fh; # filehandle
83			$fe->fd; # fileno
84			$fe->blocking (0); # or 1
85
86			$fe->{name}
87			$fe->{type}
88			$fe->frontend_info->{name}
89
90			$fe->status & FE_HAS_LOCK
91			print $fe->ber, $fe->snr, $fe->signal_strength, $fe->uncorrected;
92
93			my $tune = $fe->parameters;
94			$tune->{frequency};
95			$tune->{symbol_rate};
96
97	root	1.6	=over 4
98
99	root	1.1	=cut
100
101			sub new {
102			my ($class, $path, $mode) = @_;
103			my $self = $class->SUPER::new ($path, $mode ? &Fcntl::O_RDWR : &Fcntl::O_RDONLY);
104
105			%$self = ( %$self, %{ $self->frontend_info } );
106
107			$self;
108			}
109
110	root	1.5	=item $fe->set (parameter => value, ...)
111
112			Sets frontend parameters. All values are stuffed into the
113			C<dvb_frontend_parameters> structure without conversion and passed to
114			FE_SET_FRONTEND.
115
116			Returns true on success.
117
118			All modes:
119
120			frequency =>
121			inversion =>
122
123			QPSK frontends:
124
125			symbol_rate =>
126			fec_inner =>
127
128			QAM frontends:
129
130			symbol_rate =>
131			modulation =>
132
133			QFDM frontends:
134
135			bandwidth =>
136			code_rate_HP =>
137			code_rate_LP =>
138			constellation =>
139			transmission_mode =>
140
141			=cut
142
143			sub set {
144			my ($self) = shift;
145			_set $self->{fd}, { @_ }, $self->{type}
146			}
147
148			=item $fe->parameters
149
150			Calls FE_GET_FRONTEND and returns a hash reference that contains the same keys
151			as given to the C<set> method.
152
153			Example:
154
155			Data::Dumper::Dumper $fe->get
156
157			{
158			frequency => 426000000, # 426 Mhz
159			inversion => 0, # INVERSION_OFF
160			symbol_rate => 6900000, # 6.9 MB/s
161			modulation => 3, # QAM_64
162			}
163
164			=cut
165
166	root	1.1	sub parameters { _get ($_[0]{fd}, $_[0]{type}) }
167	root	1.5	sub get { _get ($_[0]{fd}, $_[0]{type}) } # unannounced alias
168	root	1.1	sub event { _event ($_[0]{fd}, $_[0]{type}) }
169
170	root	1.12	=item $ok = $fe->diseqc_reset_overload
171
172			If the bus has been automatically powered off due to power overload, this
173			call restores the power to the bus. The call requires read/write access
174			to the device. This call has no effect if the device is manually powered
175			off. Not all DVB adapters support this call.
176
177			=item $ok = $fe->diseqc_voltage (13\|18)
178
179			Set the DiSEqC voltage to either 13 or 18 volts.
180
181			=item $ok = $fe->diseqc_tone (1\|0)
182
183			Enables (1) or disables (0) the DiSEqC continuous 22khz tone generation.
184
185			=item $ok = $fe->diseqc_send_burst (0\|1)
186
187			Sends a 22KHz tone burst of type SEC_MINI_A (0) or SEC_MINI_B (1).
188
189			=item $ok = $fe->diseqc_cmd ($command)
190
191			Sends a DiSEqC command.
192
193			=item $reply = $fe->diseqc_reply ($timeout)
194
195			Receives a reply to a DiSEqC 2.0 command (or undef).
196
197			=cut
198
199	root	1.1	package Linux::DVB::Demux;
200
201			@ISA = qw(Linux::DVB);
202
203	root	1.6	=back
204
205	root	1.1	=head1 Linux::DVB::Demux CLASS
206
207			=head2 SYNOPSIS
208
209			my $dmx = new Linux::DVB::Demux
210			"/dev/dvb/adapter0/demux0";
211
212			$fe->fh; # filehandle
213			$fe->fd; # fileno
214			$fe->blocking (1); # non-blocking is default
215
216			$dmx->buffer (16384);
217			$dmx->sct_filter ($pid, "filter", "mask", $timeout=0, $flags=DMX_CHECK_CRC);
218			$dmx->pes_filter ($pid, $input, $output, $type, $flags=0);
219			$dmx->start;
220			$dmx->stop;
221
222	root	1.6	=over 4
223
224	root	1.1	=cut
225
226			sub new {
227			my ($class, $path) = @_;
228			my $self = $class->SUPER::new ($path, &Fcntl::O_RDWR);
229
230			$self;
231			}
232
233			sub start { _start ($_[0]{fd}) }
234			sub stop { _stop ($_[0]{fd}) }
235
236			sub sct_filter { _filter ($_[0]{fd}, @_[1, 2, 3, 4, 5]) }
237			sub pes_filter { _pes_filter ($_[0]{fd}, @_[1, 2, 3, 4, 5]) }
238			sub buffer { _buffer ($_[0]{fd}, $_[1]) }
239
240	root	1.2	package Linux::DVB::Decode;
241
242	root	1.6	=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
256			Tries to parse the string inside C<$section_data> as an SI table and
257			return it as a hash reference. Only the first SI table will be returned
258			as hash reference, and the C<$section_data> will be modified in-place by
259			removing the table data.
260
261			The way to use this function is to append new data to your
262			C<$section_data> and then call C<Linux::DVB::Decode::si> in a loop until
263			it returns C<undef>. Please ntoe, however, that the Linux DVB API will
264			return only one table at a time from sysread, so you can safely assume
265			that every sysread will return exactly one (or zero in case of errors) SI
266			table.
267
268			Here 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
337			Converts text found in DVB si tables into perl text. Only iso-8859-1..-11
338			and UTF-16 is supported, other encodings (big5 etc. is not. Bug me if you
339			need this).
340
341			=cut
342	root	1.2
343			sub text($) {
344	root	1.6	use Encode;
345
346	root	1.2	for ($_[0]) {
347			s/^([\x01-\x0b])// and $_ = decode sprintf ("iso-8859-%d", 4 + ord $1), $_;
348			# 10 - pardon you???
349			s/^\x11// and $_ = decode "utf16-be", $_;
350			# 12 ksc5601, DB
351			# 13 db2312, DB
352			# 14 big5(?), DB
353			s/\x8a/\n/g;
354			#s/([\x00-\x09\x0b-\x1f\x80-\x9f])/sprintf "{%02x}", ord $1/ge;
355			s/([\x00-\x09\x0b-\x1f\x80-\x9f])//ge;
356			}
357			}
358
359	root	1.6	=item %Linux::DVB::Decode::nibble_to_genre
360
361			A 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
368			our %nibble_to_genre = (
369			0x1 => {
370	root	1.10	0x0 => 'Movie/Drama (general)',
371	root	1.6	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	root	1.10	0x0 => 'News/Current Affairs (general)',
382	root	1.6	0x1 => 'news/weather report',
383			0x2 => 'news magazine',
384			0x3 => 'documentary',
385			0x4 => 'discussion/interview/debate',
386			},
387			0x3 => {
388	root	1.10	0x0 => 'Show/Game Show (general)',
389	root	1.6	0x1 => 'game show/quiz/contest',
390			0x2 => 'variety show',
391			0x3 => 'talk show',
392			},
393			0x4 => {
394	root	1.10	0x0 => 'Sports (general)',
395	root	1.6	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	root	1.10	0x0 => 'Childrens/Youth (general)',
409	root	1.6	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	root	1.10	0x0 => 'Music/Ballet/Dance (general)',
417	root	1.6	0x1 => 'rock/pop',
418	root	1.10	0x2 => 'serious music or classical music',
419	root	1.6	0x3 => 'folk/traditional music',
420			0x4 => 'jazz',
421			0x5 => 'musical/opera',
422			0x6 => 'ballet',
423			},
424			0x7 => {
425	root	1.10	0x0 => 'Arts/Culture (without music, general)',
426	root	1.6	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	root	1.10	0x0 => 'Social/Policical/Economics (general)',
440	root	1.6	0x1 => 'magazines/reports/documentary',
441			0x2 => 'economics/social advisory',
442			0x3 => 'remarkable people',
443			},
444			0x9 => {
445	root	1.10	0x0 => 'Education/Science/Factual (general)',
446	root	1.6	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	root	1.10	0x0 => 'Leisure/Hobbies (general)',
456	root	1.6	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	root	1.10	0x0 => '(original language)',
466			0x1 => '(black & white)',
467			0x2 => '(unpublished)',
468			0x3 => '(live broadcast)',
469	root	1.6	},
470			);
471
472	root	1.8	=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	root	1.6
482			Break down a "DVB time" (modified julian date + bcd encoded seconds) into
483	root	1.8	it's components (non-C<_linear>) or into a seconds count (C<_linear>
484			variants) since the epoch (C<datetime_linear>) or the start of the day
485			(C<time_linear>).
486
487	root	1.9	The format of the returns value of the date and datetime functions is
488			I<not> compatible with C<Time::Local>. Use the C<_linear> functions
489			instead.
490
491	root	1.8	Example:
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	root	1.6
498			=cut
499
500	root	1.8	sub 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
511			sub date($) {
512			my ($mjd) = @_;
513	root	1.6
514			# Date is given in Modified Julian Date
515			# Decoding routines taken from ANNEX C, ETSI EN 300 468 (DVB SI)
516	root	1.9	my $y_ = int (($mjd - 15078.2) / 365.25);
517	root	1.6	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	root	1.8	($day, $month, $year)
524			}
525
526			sub datetime($$) {
527			(Linux::DVB::Decode::time $_[1], date $_[0])
528			}
529
530			sub time_linear($) {
531			my ($s, $m, $h) = Linux::DVB::Decode::time $_[0];
532
533			(($h * 60) + $m * 60) + $s
534			}
535	root	1.6
536	root	1.8	sub datetime_linear($$) {
537	root	1.9	my ($sec, $min, $hour, $mday, $mon, $year) =
538			Linux::DVB::Decode::datetime $_[0], $_[1];
539
540	root	1.8	require Time::Local;
541	root	1.9	Time::Local::timegm ($sec, $min, $hour, $mday, $mon - 1, $year)
542	root	1.6	}
543
544			=back
545	root	1.1
546	root	1.6	=head1 AUTHORS
547	root	1.1
548	root	1.6	Marc Lehmann <schmorp@schmorp.de>, http://home.schmorp.de/
549			Magnus Schmidt, eMail at http://www.27b-6.de/email.php
550	root	1.1
551			=cut
552
553	root	1.6	1