[ViewVC] Diff of: cvs/Linux-DVB/DVB.pm

Comparing Linux-DVB/DVB.pm (file contents):
Revision 1.1 by root, Mon Sep 6 06:25:12 2004 UTC vs.
Revision 1.6 by root, Tue Apr 5 03:42:21 2005 UTC

…		…
10		10
11	This module provides an interface to the Linux DVB API. It is a straightforward	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	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:	13	any sense of this module. It can be found here:
14		14
15	http://www.linuxtv.org/developer/dvbapi.xml	15	http://www.linuxtv.org/docs/dvbapi/dvbapi.html
16		16
17	All constants from F<frontend.h> and F<demux.h> are exported by their C	17	All constants from F<frontend.h> and F<demux.h> are exported by their C
18	name and by default.	18	name and by default.
19		19
20	Noteworthy differences to the C API: unions and sub-structs are usually	20	Noteworthy differences to the C API: unions and sub-structs are usually
…		…
30	package Linux::DVB;	30	package Linux::DVB;
31		31
32	use Fcntl ();	32	use Fcntl ();
33		33
34	BEGIN {	34	BEGIN {
35	$VERSION = '0.1';	35	$VERSION = '0.2';
36	@ISA = qw(Exporter);	36	@ISA = qw(Exporter);
37		37
38	require XSLoader;	38	require XSLoader;
39	XSLoader::load __PACKAGE__, $VERSION;	39	XSLoader::load __PACKAGE__, $VERSION;
40		40
…		…
93		93
94	my $tune = $fe->parameters;	94	my $tune = $fe->parameters;
95	$tune->{frequency};	95	$tune->{frequency};
96	$tune->{symbol_rate};	96	$tune->{symbol_rate};
97		97
		98	=over 4
		99
98	=cut	100	=cut
99		101
100	sub new {	102	sub new {
101	my ($class, $path, $mode) = @_;	103	my ($class, $path, $mode) = @_;
102	my $self = $class->SUPER::new ($path, $mode ? &Fcntl::O_RDWR : &Fcntl::O_RDONLY);	104	my $self = $class->SUPER::new ($path, $mode ? &Fcntl::O_RDWR : &Fcntl::O_RDONLY);
…		…
111	sub ber { _read_ber ($_[0]{fd}) }	113	sub ber { _read_ber ($_[0]{fd}) }
112	sub snr { _snr ($_[0]{fd}) }	114	sub snr { _snr ($_[0]{fd}) }
113	sub signal_strength { _signal_strength ($_[0]{fd}) }	115	sub signal_strength { _signal_strength ($_[0]{fd}) }
114	sub uncorrected { _uncorrected ($_[0]{fd}) }	116	sub uncorrected { _uncorrected ($_[0]{fd}) }
115		117
116	#sub set { _set ($_[0]{fd}, $_[0]{type}) }	118	=item $fe->set (parameter => value, ...)
		119
		120	Sets frontend parameters. All values are stuffed into the
		121	C<dvb_frontend_parameters> structure without conversion and passed to
		122	FE_SET_FRONTEND.
		123
		124	Returns true on success.
		125
		126	All modes:
		127
		128	frequency =>
		129	inversion =>
		130
		131	QPSK frontends:
		132
		133	symbol_rate =>
		134	fec_inner =>
		135
		136	QAM frontends:
		137
		138	symbol_rate =>
		139	fec_inner =>
		140	modulation =>
		141
		142	QFDM frontends:
		143
		144	bandwidth =>
		145	code_rate_HP =>
		146	code_rate_LP =>
		147	constellation =>
		148	transmission_mode =>
		149
		150	=cut
		151
		152	sub set {
		153	my ($self) = shift;
		154	_set $self->{fd}, { @_ }, $self->{type}
		155	}
		156
		157	=item $fe->parameters
		158
		159	Calls FE_GET_FRONTEND and returns a hash reference that contains the same keys
		160	as given to the C<set> method.
		161
		162	Example:
		163
		164	Data::Dumper::Dumper $fe->get
		165
		166	{
		167	frequency => 426000000, # 426 Mhz
		168	inversion => 0, # INVERSION_OFF
		169	symbol_rate => 6900000, # 6.9 MB/s
		170	fec_inner => 0, # FEC_NONE
		171	modulation => 3, # QAM_64
		172	}
		173
		174	=cut
		175
117	sub parameters { _get ($_[0]{fd}, $_[0]{type}) }	176	sub parameters { _get ($_[0]{fd}, $_[0]{type}) }
		177	sub get { _get ($_[0]{fd}, $_[0]{type}) } # unannounced alias
118	sub event { _event ($_[0]{fd}, $_[0]{type}) }	178	sub event { _event ($_[0]{fd}, $_[0]{type}) }
119		179
120	package Linux::DVB::Demux;	180	package Linux::DVB::Demux;
121		181
122	@ISA = qw(Linux::DVB);	182	@ISA = qw(Linux::DVB);
		183
		184	=back
123		185
124	=head1 Linux::DVB::Demux CLASS	186	=head1 Linux::DVB::Demux CLASS
125		187
126	=head2 SYNOPSIS	188	=head2 SYNOPSIS
127		189
…		…
136	$dmx->sct_filter ($pid, "filter", "mask", $timeout=0, $flags=DMX_CHECK_CRC);	198	$dmx->sct_filter ($pid, "filter", "mask", $timeout=0, $flags=DMX_CHECK_CRC);
137	$dmx->pes_filter ($pid, $input, $output, $type, $flags=0);	199	$dmx->pes_filter ($pid, $input, $output, $type, $flags=0);
138	$dmx->start;	200	$dmx->start;
139	$dmx->stop;	201	$dmx->stop;
140		202
		203	=over 4
		204
141	=cut	205	=cut
142		206
143	sub new {	207	sub new {
144	my ($class, $path) = @_;	208	my ($class, $path) = @_;
145	my $self = $class->SUPER::new ($path, &Fcntl::O_RDWR);	209	my $self = $class->SUPER::new ($path, &Fcntl::O_RDWR);
…		…
152		216
153	sub sct_filter { _filter ($_[0]{fd}, @_[1, 2, 3, 4, 5]) }	217	sub sct_filter { _filter ($_[0]{fd}, @_[1, 2, 3, 4, 5]) }
154	sub pes_filter { _pes_filter ($_[0]{fd}, @_[1, 2, 3, 4, 5]) }	218	sub pes_filter { _pes_filter ($_[0]{fd}, @_[1, 2, 3, 4, 5]) }
155	sub buffer { _buffer ($_[0]{fd}, $_[1]) }	219	sub buffer { _buffer ($_[0]{fd}, $_[1]) }
156		220
157	1;	221	package Linux::DVB::Decode;
158		222
		223	=back
		224
		225	=head1 Linux::DVB::Decode CLASS
		226
		227	=head2 SYNOPSIS
		228
		229	$si_decoded_hashref = Linux::DVB::Decode::si $section_data;
		230
		231	=over 4
		232
		233	=cut
		234
		235	=item $hashref = Linux::DVB::Decode::si $section_data
		236
		237	Tries to parse the string inside C<$section_data> as an SI table and
		238	return it as a hash reference. Only the first SI table will be returned
		239	as hash reference, and the C<$section_data> will be modified in-place by
		240	removing the table data.
		241
		242	The way to use this function is to append new data to your
		243	C<$section_data> and then call C<Linux::DVB::Decode::si> in a loop until
		244	it returns C<undef>. Please ntoe, however, that the Linux DVB API will
		245	return only one table at a time from sysread, so you can safely assume
		246	that every sysread will return exactly one (or zero in case of errors) SI
		247	table.
		248
		249	Here is an example of what to expect:
		250
		251	{
		252	'segment_last_section_number' => 112,
		253	'table_id' => 81,
		254	'service_id' => 28129,
		255	'original_network_id' => 1,
		256	'section_syntax_indicator' => 1,
		257	'current_next_indicator' => 1,
		258	'events' => [
		259	{
		260	'running_status' => 0,
		261	'start_time_hms' => 2097152,
		262	'event_id' => 39505,
		263	'free_CA_mode' => 0,
		264	'start_time_mjd' => 53470,
		265	'descriptors' => [
		266	{
		267	'event_name' => 'Nachrichten',
		268	'text' => '',
		269	'ISO_639_language_code' => 'deu',
		270	'type' => 77
		271	},
		272	{
		273	'programme_identification_label' => 337280,
		274	'type' => 105
		275	},
		276	{
		277	'raw_data' => '22:0010.04#00',
		278	'type' => 130
		279	}
		280	],
		281	'duration' => 1280
		282	},
		283	{
		284	'running_status' => 0,
		285	'start_time_hms' => 2098432,
		286	'event_id' => 39506,
		287	'free_CA_mode' => 0,
		288	'start_time_mjd' => 53470,
		289	'descriptors' => [
		290	{
		291	'event_name' => 'SR 1 - Nachtwerk',
		292	'text' => '',
		293	'ISO_639_language_code' => 'deu',
		294	'type' => 77
		295	},
		296	{
		297	'programme_identification_label' => 337285,
		298	'type' => 105
		299	},
		300	{
		301	'raw_data' => '22:0510.04#00',
		302	'type' => 130
		303	}
		304	],
		305	'duration' => 87296
		306	}
		307	],
		308	'last_table_id' => 81,
		309	'section_number' => 112,
		310	'last_section_number' => 176,
		311	'version_number' => 31,
		312	'transport_stream_id' => 1101
		313	}
		314
		315
		316	=item $text = Linux::DVB::Decode::text $data
		317
		318	Converts text found in DVB si tables into perl text. Only iso-8859-1..-11
		319	and UTF-16 is supported, other encodings (big5 etc. is not. Bug me if you
		320	need this).
		321
		322	=cut
		323
		324	sub text($) {
		325	use Encode;
		326
		327	for ($_[0]) {
		328	s/^([\x01-\x0b])// and $_ = decode sprintf ("iso-8859-%d", 4 + ord $1), $_;
		329	# 10 - pardon you???
		330	s/^\x11// and $_ = decode "utf16-be", $_;
		331	# 12 ksc5601, DB
		332	# 13 db2312, DB
		333	# 14 big5(?), DB
		334	s/\x8a/\n/g;
		335	#s/([\x00-\x09\x0b-\x1f\x80-\x9f])/sprintf "{%02x}", ord $1/ge;
		336	s/([\x00-\x09\x0b-\x1f\x80-\x9f])//ge;
		337	}
		338	}
		339
		340	=item %Linux::DVB::Decode::nibble_to_genre
		341
		342	A two-level hash mapping genre nibbles to genres, e.g.
		343
		344	$Linux::DVB::Decode::nibble_to_genre{7}{6}
		345	=> 'film/cinema'
		346
		347	=cut
		348
		349	our %nibble_to_genre = (
		350	0x1 => {
		351	0x0 => 'Movie / Drama',
		352	0x1 => 'Movie - detective/thriller',
		353	0x2 => 'Movie - adventure/western/war',
		354	0x3 => 'Movie - science fiction/fantasy/horror',
		355	0x4 => 'Movie - comedy',
		356	0x5 => 'Movie - soap/melodrama/folkloric',
		357	0x6 => 'Movie - romance',
		358	0x7 => 'Movie - serious/classical/religious/historical movie/drama',
		359	0x8 => 'Movie - adult movie/drama',
		360	},
		361	0x2 => {
		362	0x0 => 'News / Current Affairs',
		363	0x1 => 'news/weather report',
		364	0x2 => 'news magazine',
		365	0x3 => 'documentary',
		366	0x4 => 'discussion/interview/debate',
		367	},
		368	0x3 => {
		369	0x0 => 'Show / Game Show',
		370	0x1 => 'game show/quiz/contest',
		371	0x2 => 'variety show',
		372	0x3 => 'talk show',
		373	},
		374	0x4 => {
		375	0x0 => 'Sports',
		376	0x1 => 'special events (Olympic Games, World Cup etc.)',
		377	0x2 => 'sports magazines',
		378	0x3 => 'football/soccer',
		379	0x4 => 'tennis/squash',
		380	0x5 => 'team sports (excluding football)',
		381	0x6 => 'athletics',
		382	0x7 => 'motor sport',
		383	0x8 => 'water sport',
		384	0x9 => 'winter sports',
		385	0xA => 'equestrian',
		386	0xB => 'martial sports',
		387	},
		388	0x5 => {
		389	0x0 => 'Childrens / Youth',
		390	0x1 => "pre-school children's programmes",
		391	0x2 => 'entertainment programmes for 6 to 14',
		392	0x3 => 'entertainment programmes for 10 to 16',
		393	0x4 => 'informational/educational/school programmes',
		394	0x5 => 'cartoons/puppets',
		395	},
		396	0x6 => {
		397	0x0 => 'Music / Ballet / Dance',
		398	0x1 => 'rock/pop',
		399	0x2 => 'serious music/classical music',
		400	0x3 => 'folk/traditional music',
		401	0x4 => 'jazz',
		402	0x5 => 'musical/opera',
		403	0x6 => 'ballet',
		404	},
		405	0x7 => {
		406	0x0 => 'Arts / Culture',
		407	0x1 => 'performing arts',
		408	0x2 => 'fine arts',
		409	0x3 => 'religion',
		410	0x4 => 'popular culture/traditional arts',
		411	0x5 => 'literature',
		412	0x6 => 'film/cinema',
		413	0x7 => 'experimental film/video',
		414	0x8 => 'broadcasting/press',
		415	0x9 => 'new media',
		416	0xA => 'arts/culture magazines',
		417	0xB => 'fashion',
		418	},
		419	0x8 => {
		420	0x0 => 'Social / Policical / Economics',
		421	0x1 => 'magazines/reports/documentary',
		422	0x2 => 'economics/social advisory',
		423	0x3 => 'remarkable people',
		424	},
		425	0x9 => {
		426	0x0 => 'Education / Science / Factual',
		427	0x1 => 'nature/animals/environment',
		428	0x2 => 'technology/natural sciences',
		429	0x3 => 'medicine/physiology/psychology',
		430	0x4 => 'foreign countries/expeditions',
		431	0x5 => 'social/spiritual sciences',
		432	0x6 => 'further education',
		433	0x7 => 'languages',
		434	},
		435	0xA => {
		436	0x0 => 'Leisure / Hobbies',
		437	0x1 => 'tourism/travel',
		438	0x2 => 'handicraft',
		439	0x3 => 'motoring',
		440	0x4 => 'fitness & health',
		441	0x5 => 'cooking',
		442	0x6 => 'advertizement/shopping',
		443	0x7 => 'gardening',
		444	},
		445	0xB => {
		446	0x0 => 'Original Language',
		447	0x1 => 'black & white',
		448	0x2 => 'unpublished',
		449	0x3 => 'live broadcast',
		450	},
		451	);
		452
		453	=item ($sec,$min,$hour,$mday,$mon,$year) = Linux::DVB::Decode::time $mjd, $time
		454
		455	Break down a "DVB time" (modified julian date + bcd encoded seconds) into
		456	it's components in UTC (i.e. use Time::Local::timegm to convert to UNIX
		457	time).
		458
		459	=cut
		460
		461	sub time($$) {
		462	my ($mjd, $time) = @_;
		463
		464	# Date is given in Modified Julian Date
		465	# Decoding routines taken from ANNEX C, ETSI EN 300 468 (DVB SI)
		466	my $y_ = int ($mjd - 15078.2) / 365.25;
		467	my $m_ = int (($mjd - 14956.1 - int ($y_ * 365.25)) / 30.6001);
		468	my $day = $mjd - 14956 - int ($y_ * 365.25) - int ($m_ * 30.6001);
		469	my $k = $m_ == 14 or $m_ == 15 ? 1 : 0;
		470	my $year = $y_ + $k + 1900;
		471	my $month = $m_ - 1 - $k * 12;
		472
		473	# Time is in UTC, 24 bit, every nibble one digit in BCD from right to left
		474	my $hour = sprintf "%02x", ($time >> 16) & 0xFF;
		475	my $minute = sprintf "%02x", ($time >> 8) & 0xFF;
		476	my $second = sprintf "%02x", ($time ) & 0xFF;
		477
		478	return ($second, $minute, $hour, $day, $month, $year);
		479	}
		480
		481	=back
		482
159	=head1 AUTHOR	483	=head1 AUTHORS
160		484
161	Marc Lehmann <pcg@goof.com>	485	Marc Lehmann <schmorp@schmorp.de>, http://home.schmorp.de/
162	http://www.goof.com/pcg/marc/	486	Magnus Schmidt, eMail at http://www.27b-6.de/email.php
163		487
164	=cut	488	=cut
165		489
		490	1

Diff Legend

-–
+Removed lines
-+
+Added lines
-<
+Changed lines
->
+Changed lines

Comparing Linux-DVB/DVB.pm (file contents): Revision 1.1 by root, Mon Sep 6 06:25:12 2004 UTC vs. Revision 1.6 by root, Tue Apr 5 03:42:21 2005 UTC

Diff Legend

Comparing Linux-DVB/DVB.pm (file contents):
Revision 1.1 by root, Mon Sep 6 06:25:12 2004 UTC vs.
Revision 1.6 by root, Tue Apr 5 03:42:21 2005 UTC