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 ($command is 3 to 6 bytes of binary data).

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

Receives a reply to a DiSEqC 2.0 command and returns it as a binary octet
string 0..4 bytes in length (or C<undef> in the error case).

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