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

Comparing Linux-DVB/DVB.pm (file contents):
Revision 1.4 by root, Thu Mar 3 20:11:32 2005 UTC vs.
Revision 1.15 by root, Mon May 24 01:52:59 2010 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
21	translated into flat perl hashes, i.e C<struct.u.qam.symbol_rate>	21	translated into flat perl hashes, i.e C<struct.u.qam.symbol_rate>
22	becomes C<< $struct->{symbol_rate} >>.	22	becomes C<< $struct->{symbol_rate} >>.
23		23
24	Noteworthy limitations of this module include: no way to set the	24	Noteworthy limitations of this module include: No interface to the video,
25	frequency or diseqc. No interface to the video, audio and net devices.
26	If you need this functionality bug the author.	25	audio and net devices. If you need this functionality bug the author.
27		26
28	=cut	27	=cut
29		28
30	package Linux::DVB;	29	package Linux::DVB;
31		30
32	use Fcntl ();	31	use Fcntl ();
33		32
34	BEGIN {	33	BEGIN {
35	$VERSION = '0.2';	34	$VERSION = '1.01';
36	@ISA = qw(Exporter);	35	@ISA = qw(Exporter);
37		36
38	require XSLoader;	37	require XSLoader;
39	XSLoader::load __PACKAGE__, $VERSION;	38	XSLoader::load __PACKAGE__, $VERSION;
40		39
…		…
93		92
94	my $tune = $fe->parameters;	93	my $tune = $fe->parameters;
95	$tune->{frequency};	94	$tune->{frequency};
96	$tune->{symbol_rate};	95	$tune->{symbol_rate};
97		96
		97	=over 4
		98
98	=cut	99	=cut
99		100
100	sub new {	101	sub new {
101	my ($class, $path, $mode) = @_;	102	my ($class, $path, $mode) = @_;
102	my $self = $class->SUPER::new ($path, $mode ? &Fcntl::O_RDWR : &Fcntl::O_RDONLY);	103	my $self = $class->SUPER::new ($path, $mode ? &Fcntl::O_RDWR : &Fcntl::O_RDONLY);
…		…
104	%$self = ( %$self, %{ $self->frontend_info } );	105	%$self = ( %$self, %{ $self->frontend_info } );
105		106
106	$self;	107	$self;
107	}	108	}
108		109
109	sub frontend_info { _frontend_info ($_[0]{fd}) }	110	=item $fe->set (parameter => value, ...)
110	sub status { _read_status ($_[0]{fd}) }
111	sub ber { _read_ber ($_[0]{fd}) }
112	sub snr { _snr ($_[0]{fd}) }
113	sub signal_strength { _signal_strength ($_[0]{fd}) }
114	sub uncorrected { _uncorrected ($_[0]{fd}) }
115		111
116	#sub set { _set ($_[0]{fd}, $_[0]{type}) }	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
117	sub parameters { _get ($_[0]{fd}, $_[0]{type}) }	166	sub parameters { _get ($_[0]{fd}, $_[0]{type}) }
		167	sub get { _get ($_[0]{fd}, $_[0]{type}) } # unannounced alias
118	sub event { _event ($_[0]{fd}, $_[0]{type}) }	168	sub event { _event ($_[0]{fd}, $_[0]{type}) }
119		169
		170	=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 ($command is 3 to 6 bytes of binary data).
		192
		193	=item $reply = $fe->diseqc_reply ($timeout)
		194
		195	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
		198	=cut
		199
120	package Linux::DVB::Demux;	200	package Linux::DVB::Demux;
121		201
122	@ISA = qw(Linux::DVB);	202	@ISA = qw(Linux::DVB);
		203
		204	=back
123		205
124	=head1 Linux::DVB::Demux CLASS	206	=head1 Linux::DVB::Demux CLASS
125		207
126	=head2 SYNOPSIS	208	=head2 SYNOPSIS
127		209
…		…
136	$dmx->sct_filter ($pid, "filter", "mask", $timeout=0, $flags=DMX_CHECK_CRC);	218	$dmx->sct_filter ($pid, "filter", "mask", $timeout=0, $flags=DMX_CHECK_CRC);
137	$dmx->pes_filter ($pid, $input, $output, $type, $flags=0);	219	$dmx->pes_filter ($pid, $input, $output, $type, $flags=0);
138	$dmx->start;	220	$dmx->start;
139	$dmx->stop;	221	$dmx->stop;
140		222
		223	=over 4
		224
141	=cut	225	=cut
142		226
143	sub new {	227	sub new {
144	my ($class, $path) = @_;	228	my ($class, $path) = @_;
145	my $self = $class->SUPER::new ($path, &Fcntl::O_RDWR);	229	my $self = $class->SUPER::new ($path, &Fcntl::O_RDWR);
…		…
154	sub pes_filter { _pes_filter ($_[0]{fd}, @_[1, 2, 3, 4, 5]) }	238	sub pes_filter { _pes_filter ($_[0]{fd}, @_[1, 2, 3, 4, 5]) }
155	sub buffer { _buffer ($_[0]{fd}, $_[1]) }	239	sub buffer { _buffer ($_[0]{fd}, $_[1]) }
156		240
157	package Linux::DVB::Decode;	241	package Linux::DVB::Decode;
158		242
159	use Encode;	243	=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
160		343
161	sub text($) {	344	sub text($) {
		345	use Encode;
		346
162	for ($_[0]) {	347	for ($_[0]) {
163	s/^([\x01-\x0b])// and $_ = decode sprintf ("iso-8859-%d", 4 + ord $1), $_;	348	s/^([\x01-\x0b])// and $_ = decode sprintf ("iso-8859-%d", 4 + ord $1), $_;
164	# 10 - pardon you???	349	# 10 - pardon you???
165	s/^\x11// and $_ = decode "utf16-be", $_;	350	s/^\x11// and $_ = decode "utf16-be", $_;
166	# 12 ksc5601, DB	351	# 12 ksc5601, DB
…		…
170	#s/([\x00-\x09\x0b-\x1f\x80-\x9f])/sprintf "{%02x}", ord $1/ge;	355	#s/([\x00-\x09\x0b-\x1f\x80-\x9f])/sprintf "{%02x}", ord $1/ge;
171	s/([\x00-\x09\x0b-\x1f\x80-\x9f])//ge;	356	s/([\x00-\x09\x0b-\x1f\x80-\x9f])//ge;
172	}	357	}
173	}	358	}
174		359
175	1;	360	=item %Linux::DVB::Decode::nibble_to_genre
176		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	0x0 => 'Movie/Drama (general)',
		372	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	0x0 => 'News/Current Affairs (general)',
		383	0x1 => 'news/weather report',
		384	0x2 => 'news magazine',
		385	0x3 => 'documentary',
		386	0x4 => 'discussion/interview/debate',
		387	},
		388	0x3 => {
		389	0x0 => 'Show/Game Show (general)',
		390	0x1 => 'game show/quiz/contest',
		391	0x2 => 'variety show',
		392	0x3 => 'talk show',
		393	},
		394	0x4 => {
		395	0x0 => 'Sports (general)',
		396	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	0x0 => 'Childrens/Youth (general)',
		410	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	0x0 => 'Music/Ballet/Dance (general)',
		418	0x1 => 'rock/pop',
		419	0x2 => 'serious music or classical music',
		420	0x3 => 'folk/traditional music',
		421	0x4 => 'jazz',
		422	0x5 => 'musical/opera',
		423	0x6 => 'ballet',
		424	},
		425	0x7 => {
		426	0x0 => 'Arts/Culture (without music, general)',
		427	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	0x0 => 'Social/Policical/Economics (general)',
		441	0x1 => 'magazines/reports/documentary',
		442	0x2 => 'economics/social advisory',
		443	0x3 => 'remarkable people',
		444	},
		445	0x9 => {
		446	0x0 => 'Education/Science/Factual (general)',
		447	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	0x0 => 'Leisure/Hobbies (general)',
		457	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	0x0 => '(original language)',
		467	0x1 => '(black & white)',
		468	0x2 => '(unpublished)',
		469	0x3 => '(live broadcast)',
		470	},
		471	);
		472
		473	=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
		483	Break down a "DVB time" (modified julian date + bcd encoded seconds) into
		484	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	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	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
		499	=cut
		500
		501	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
		515	# Date is given in Modified Julian Date
		516	# Decoding routines taken from ANNEX C, ETSI EN 300 468 (DVB SI)
		517	my $y_ = int (($mjd - 15078.2) / 365.25);
		518	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	($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
		537	sub datetime_linear($$) {
		538	my ($sec, $min, $hour, $mday, $mon, $year) =
		539	Linux::DVB::Decode::datetime $_[0], $_[1];
		540
		541	require Time::Local;
		542	Time::Local::timegm ($sec, $min, $hour, $mday, $mon - 1, $year)
		543	}
		544
		545	=back
		546
177	=head1 AUTHOR	547	=head1 AUTHORS
178		548
179	Marc Lehmann <schmorp@schmorp.de>	549	Marc Lehmann <schmorp@schmorp.de>, http://home.schmorp.de/
180	http://home.schmorp.de/	550	Magnus Schmidt, eMail at http://www.27b-6.de/email.php
181		551
182	=cut	552	=cut
183		553
		554	1

Diff Legend

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

Comparing Linux-DVB/DVB.pm (file contents): Revision 1.4 by root, Thu Mar 3 20:11:32 2005 UTC vs. Revision 1.15 by root, Mon May 24 01:52:59 2010 UTC

Diff Legend

Comparing Linux-DVB/DVB.pm (file contents):
Revision 1.4 by root, Thu Mar 3 20:11:32 2005 UTC vs.
Revision 1.15 by root, Mon May 24 01:52:59 2010 UTC