The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl
use strict ;
use Pod::Usage ;
use Getopt::Long qw/:config no_ignore_case/ ;

++$! ;

use Linux::DVB::DVBT ;

our $VERSION = "1.001" ;


	my ($channel, $date, $start, $end, $title, $text) ;
	
	format STDOUT =
@<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< @|||||||||||||||||||||||||| ( @<<<< - @<<<< )
$channel,		                 $date,                        $start, $end

@<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$title

@*
$text


.


	my ($help, $man, $DEBUG, $VERBOSE, $config, $adap, $section) ;
	GetOptions('v|verbose=s' => \$VERBOSE,
			   'debug=s' => \$DEBUG,
			   'h|help' => \$help,
			   'man' => \$man,
			   'cfg=s' => \$config,
			   'section=s' => \$section,
			   'a|adap|dvb=i' => \$adap,
			   ) or pod2usage(2) ;


    pod2usage(1) if $help;
    pod2usage(-verbose => 2) if $man;

	Linux::DVB::DVBT->debug($DEBUG) ;
	Linux::DVB::DVBT->verbose($VERBOSE) ;
	

	## Create dvb. 
	## NOTE: With default object settings, the application will
	## die on *any* error, so there is no error checking in this script
	##
	my $dvb = Linux::DVB::DVBT->new(
		'adapter_num' 	=> $adap,
	) ;

	$dvb->config_path($config) if $config ;
	
	if ($section)
	{
		if ($section =~ /^0x([\da-f]+)/i)
		{
			$section = hex($1) ;
		}
	}
	
	## Get EPG info - automatically tunes the frontend
	my ($epg_href, $dates_href) = $dvb->epg($section) ;

	# Sort channel names
	foreach $channel (sort keys %$epg_href)
	{
		next unless $channel ;

		# do each program
		foreach my $pid (keys %{$epg_href->{$channel}})
		{
			next unless $pid ;

			($date, $start, $end, $title, $text) = @{$epg_href->{$channel}{$pid}}{qw/date start end title text/} ;
			$title ||= "(no program)" ;
			$text .= $epg_href->{$channel}{$pid}{'etext'} ;
			$text ||= "" ;
	
			write ;			
		}
	}



#=================================================================================
# END
#=================================================================================
__END__

=head1 NAME

dvbt-epg - Get EPG

=head1 SYNOPSIS

dvbt-epg [options] 

Options:

       -debug level         set debug level
       -verbose level       set verbosity level
       -help                brief help message
       -man                 full documentation
       -a <num>             Use adapter <num>
       
=head1 OPTIONS

=over 8

=item B<-help>

Print a brief help message and exits.

=item B<-man>

Prints the manual page and exits.

=item B<-verbose>

Set verbosity level. Higher values show more information.

=item B<-debug>

Set debug level. Higher levels show more debugging information (only really of any interest to developers!)

=item B<-a>

Specify which adapter number to use

=back

=head1 DESCRIPTION

Script that uses the perl Linux::DVB::DVBT package to provide DVB-T adapter functions.

Gathers the electronic program guide information being broadcast and prints the information.

For full details of the DVBT functions, please see:

   perldoc Linux::DVB::DVBT

NOTE: This script will take approx. 30 minutes to gather the full program guide, please be patient!

=cut