#!/usr/bin/perl
use strict ;
use Pod::Usage ;
use Getopt::Long qw/:config no_ignore_case/ ;
use File::Basename ;

++$! ;

use Linux::DVB::DVBT ;

our $VERSION = '2.001' ;

    my $progname = basename $0 ;

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


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

    my $dvb_name = sprintf "DVB%d", $adapter ;

	info("===============================================================") if $VERBOSE ;
	info("$progname v$VERSION") if $VERBOSE ;
	info("Linux::DVB::DVBT v$Linux::DVB::DVBT::VERSION") if $VERBOSE ;

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

	## Create dvb (use first found adapter). 
	## 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' => $adapter) ;
	
	# use other config?
	$dvb->config_path($config) if $config ;

	info("== Locked $dvb_name ==") if $VERBOSE ;
	
	## get strength info
	my %info = $dvb->tsid_signal_quality() ;

	## Release DVB (for next recording)
	info("== Released $dvb_name ==") if $VERBOSE ;
	$dvb->dvb_close() ;
	
	## output
	my $fh ;
	if ($munin)
	{
		open $fh, ">>$munin" or die "Error: unable to write to munin log file $munin : $!" ;
		my $timestamp = timestamp() ;
		printf $fh "[$timestamp DVB%d] ", $adapter ;
	}
	else
	{
		printf "%5s  : %8s %%\n", "TSID", "Strength" ;
	}
	foreach my $tsid (sort {$a <=> $b} keys %info)
	{
		my $percent = ($info{$tsid}{'strength'} * 100.0) / 65535.0 ;
		if (!$munin)
		{
			printf "%5d  : %8.2f %%\n", $tsid, $percent ;
		}
		else
		{
			printf $fh "%d=%.2f ", $tsid, $percent ;
		}
		Linux::DVB::DVBT::prt_data("TSID $tsid = ", $info{$tsid}) if $DEBUG ;
	}

	if ($munin)
	{
		print $fh "\n" ;
		close $fh if $fh ;
	}

	## End
	info("COMPLETE") if $VERBOSE ;
	
#=================================================================================
# SUBROUTINES
#=================================================================================


#-----------------------------------------------------------------------------
# Format a timestamp for the reply
sub timestamp
{
    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
    return sprintf "%02d:%02d:%02d %02d/%02d/%04d", $hour,$min,$sec, $mday,$mon+1,$year+1900;
}

#---------------------------------------------------------------------------------
sub prompt
{
   my $timestamp = timestamp() ;
   my $prompt = "[$progname ($$) $timestamp $dvb_name]" ;

   return $prompt ;
}

#---------------------------------------------------------------------------------
sub info
{
   my ($msg) = @_ ;

   my $prompt = prompt() ;
   $msg =~ s/\n/\n$prompt /g ;
   print "$prompt $msg\n" ;
}



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

=head1 NAME

dvbt-strength - Show DVBT signal strengths

=head1 SYNOPSIS

dvbt-strength [options]

Options:

       -debug level         set debug level
       -verbose level       set verbosity level
       -help                brief help message
       -man                 full documentation
       
=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!)


=back

=head1 DESCRIPTION

Script that uses the perl Linux::DVB::DVBT package to provide DVB-T adapter functions.
 
Shows the transmitter signal strengths for all transmitters currently configured (by a previous scan).

=head1 FURTHER DETAILS

For full details of the DVBT functions, please see L<Linux::DVB::DVBT>:

   perldoc Linux::DVB::DVBT
 
=cut

	
