File Coverage

blib/lib/Linux/DVB/DVBT/Advert.pm

Criterion	Covered	Total	%
statement	78	1000	7.8
branch	9	508	1.7
condition	4	140	2.8
subroutine	17	59	28.8
pod	12	46	26.0
total	120	1753	6.8

package Linux::DVB::DVBT::Advert ;

=head1 NAME

Linux::DVB::DVBT::Advert - Advert (commercials) detection and removal

=head1 SYNOPSIS

	use Linux::DVB::DVBT::Advert ;

	# Read advert config info
	my $ad_config_href = ad_config() ;

	# skip advert detection
	if (!ok_to_detect($results_settings_href))
	{
		print "Skipping advert detection...\n" ;
		exit 0 ;
	}

	# detect
	my $settings_href = {
		'debug' => $DEBUG,
		'progress_callback' => \&progress,
	} ;
	$results_href = detect($file, $settings_href, $channel, $ad_config_href, $det) ;

	# .. or re-use saved deetction
	$results_href = detect_from_file($detect_file) ;

	# analyse
	my @cut_list = analyse($file, $results_href, $ad_config_href, $channel, $csv, $expected_aref, $settings_href) ;

	# remove adverts
	ad_cut($file, $cutfile, \@cut_list) ;

	# ..or split file at advert boundaries
	ad_split($file, $cutfile, \@cut_list) ;



=head1 DESCRIPTION

Module provides the interface into the advert (commercials) detection and removal utilities.
As well as an underlying transport stream parsing framework, this module also incorporates
MPEG2 video decoding and AAC audio decoding (see L module for full details).

=head2 Basic Operation

Advert removal is split into 2 phases: detection and analysis. The detection phase processes the
video and audio data, producing raw statistics for each video frame (I effectively sunchronise the
audio frames and group their results into video frames). These raw statistics are then post-processed
in the analysis phase to determine the (hopefully!) actual location of the commercial breaks.

The detection phase is completely run in C code under XS; the analysis phase is completely run in Perl.


=head2 Settings

Settings are passed into the routines via a HASH ref. Settings also come from the default set, and
from any config file parameters. Please see L for full details.

In general, you will probably only be interested in changing the analysis settings to tweak the results for
a particular channel (or to completely disable advert detection for a channel). The detection parameters
seem to be pretty good for all channels.

=head2 Results Files

The output from each phase can be stored into files for later re-use or analysis. The detection phase
output file can be reloaded and passed to the analyse phase multiple times to try out different analysis
settings. The analyse phase output can be plotted to show the effectiveness of the algorithms used.


=cut

#============================================================================================
# USES
#============================================================================================
use strict ;
use Env ;
use Carp ;
use File::Basename ;
use File::Path ;

use Linux::DVB::DVBT::Advert::Config ;
use Linux::DVB::DVBT::Advert::Constants ;

use Linux::DVB::DVBT::Advert::Mem ;

use Data::Dumper ;

#============================================================================================
# EXPORTER
#============================================================================================
require Exporter;
our @ISA = qw(Exporter);

our @EXPORT = qw/
	ad_config
	ad_debug
	detect
	detect_from_file
	analyse
	ad_cut
	ad_split
	ok_to_detect
/ ;

our @CHECK_OK = qw/
	read_adv
	adv_to_cutlist
/ ;

our @OK = qw/
	ad_config_search
	channel_settings
	read_expected
	write_default_config
/ ;

our @EXPORT_OK = (@OK, @CHECK_OK) ;

our %EXPORT_TAGS = (
	'all'		=> [ @EXPORT, @EXPORT_OK ],
	'check'		=> [ @EXPORT, @CHECK_OK  ],
) ;

#============================================================================================
# GLOBALS
#============================================================================================
our $VERSION = '0.04' ;
our $DEBUG = 0 ;

our $USE_XS_MEM = 3 ;


#our $CONFIG_DIR = $Linux::DVB::DVBT::Advert::Config::DEFAULT_CONFIG_PATH ;
our $CONFIG_DIR ;

#============================================================================================
# XS
#============================================================================================
require XSLoader;

if (!$ENV{'ADVERT_NO_XS'})
{
	XSLoader::load('Linux::DVB::DVBT::Advert', $VERSION);
}
else
{
	print STDERR "WARNING: Running Linux::DVB::DVBT::Advert without XS\n" ;
}

#============================================================================================
BEGIN {

	$CONFIG_DIR = $Linux::DVB::DVBT::Advert::Config::DEFAULT_CONFIG_PATH ;

}

#============================================================================================
my $FPS = $Linux::DVB::DVBT::Advert::Constants::CONSTANTS{'FRAMES_PER_SEC'} ;
my $FRAME_FIELD	= 'frame' ;
my $FRAME_END_FIELD	= 'frame_end' ;
my $PROG_FIELD	= 'program' ;
my $PACKET_FIELD	= 'start_pkt' ;
my $PACKET_END_FIELD	= 'end_pkt' ;
my $PACKET_GOP_FIELD	= 'gop_pkt' ;
my $EXPECTED_FIELD	= 'expected' ;
my $LOGO_PROCESSED_FIELD = 'logo_proc' ;
my $LOGO_COALESCED_FIELD = 'logo_coal' ;
my $REDUCED_LOGO_COALESCED_FIELD = 'reduced_logo_coal' ;
my $BLACK_COALESCED_FIELD = 'black_coal' ;
my $SILENT_COALESCED_FIELD = 'silent_coal' ;
my $SILENT_BLACK_FIELD = 'silent_black' ;
my $REDUCED_SILENT_BLACK_FIELD = 'reduced_silent_black' ;

my $_FRAMENUMS_KEY = '_framenums' ;

#============================================================================================

=head2 Functions

=over 4

=cut


#----------------------------------------------------------------------

=item B

Get advert configuration information from a config file. Optionally sets the
search path - which is an ARRAY ref containing the list of directories to search.

Returns the HASH ref of advert settings.

=cut

sub ad_config
{
	my ($search) = @_ ;

	$search ||= $CONFIG_DIR ;
	$CONFIG_DIR = $search ;

	my $ad_config_href = Linux::DVB::DVBT::Advert::Config::read_dvb_adv($CONFIG_DIR) ;
	return $ad_config_href ;
}


#----------------------------------------------------------------------

=item B

Set debug level.

=cut

sub ad_debug
{
	my ($level) = @_ ;
	$DEBUG = $level if defined($level) ;
}


#----------------------------------------------------------------------

=item B

Get/set search path for advert config file.

Returns the current setting.

=cut

sub ad_config_search
{
	my ($new_path) = @_ ;

	if ($new_path)
	{
		$CONFIG_DIR = $new_path ;
	}
	return $CONFIG_DIR ;
}


#----------------------------------------------------------------------
#
#=item B<_advert_settings($ad_config_href [, $channel])>
#
#Using the reference to the tuning info HASH (normally read in by B),
#returns a HASH containing just the advert settings information.
#
#If no channel name is specified then this just returns the global settings.
#If a channel name is specified (and that channel can be found in the settings HASH),
#then merges any global settings with the channel-sepcific settings.
#
#If I<$ad_config_href> is undef, then this function first reads the config files (NOTE: this will
#only use the default search path).
#
#Returns the HASH ref of settings.
#
#=cut

sub _advert_settings
{
	my ($ad_config_href, $channel) = @_ ;

print "_advert_settings($ad_config_href, $channel)\n"  if $DEBUG>=10 ;

	if (!$ad_config_href)
	{
		$ad_config_href = ad_config() ;
	}

print Data::Dumper->Dump(["_advert_settings($channel) advert settings:", $ad_config_href]) if $DEBUG>=10 ;

	my $settings_href = Linux::DVB::DVBT::Advert::Config::channel_settings($ad_config_href, $channel) ;

print Data::Dumper->Dump(["_advert_settings($channel) OUT:", $settings_href]) if $DEBUG>=10 ;

	return $settings_href ;
}


#-----------------------------------------------------------------------------

=item B

Returns a HASH ref containing advert settings from the config file
(if available).

The B<$settings_href> settings HASH ref contains any new settings that the user wishes to
use, overriding global values or config file values.

The B<$ad_config_href> parameter is expected to be the tuning info HASH ref read in using
L. It is used to set any settings read in
from the default config file.

=cut

sub channel_settings
{
	my ($settings_href, $channel, $ad_config_href) = @_ ;

	$channel ||= "" ;

	## if channel specified, get channel-specific config
	my $config_settings_href = _advert_settings($ad_config_href, $channel) ;

	## Get defaults
	my $default_settings_href = Linux::DVB::DVBT::Advert::dvb_advert_def_settings() ;

	if ($DEBUG)
	{
		print Data::Dumper->Dump(["config settings:", $config_settings_href]) ;
		print Data::Dumper->Dump(["default settings:", $default_settings_href]) ;
	}

	## Merge them all together
	my $chan_settings_href = Linux::DVB::DVBT::Advert::Config::merge_settings(
								$default_settings_href,
								$config_settings_href,
								$settings_href,
							) ;

	return $chan_settings_href ;
}


#-----------------------------------------------------------------------------

=item B

Read the source TS file I<$src> and return a HASH containing the detection statistics
for each frame.

The B<$ad_config_href> parameter is expected to be the tuning info HASH ref read in using
L. It is used to set any settings read in
from the default config file. If it is undef then a default search path is used.

The B<$settings_href> settings HASH ref contains any new settings that the user wishes to
use, overriding global values or config file values.

The optional I<$channel> parameter is used to specify the TV channel that the video was recorded
from. This then allows the config fiel to contain channel-specific settings which are used in the
detection. If no channel is specified (or the channel name is not found in the config file) then just
default settings are used.

If the optional I<$detect> parameter is specified then the results are saved into the text file
named by the parameter

=cut

sub detect
{
	my ($src, $settings_href, $channel, $ad_config_href, $detect) = @_ ;

	if ($DEBUG)
	{
		print Data::Dumper->Dump(["===detect====", "settings:", $settings_href, "AD ($channel) config", $ad_config_href]) ;
	}

	$channel ||= "" ;
	my $results_href = {} ;

	## Get combined settings for this channel
	$settings_href = channel_settings($settings_href, $channel, $ad_config_href) ;

	if ($DEBUG)
	{
		print Data::Dumper->Dump(["channel settings:", $settings_href]) ;
	}

	## Skip if disabled
	if (ok_to_detect($settings_href))
	{
		my $adata_ref ;

$settings_href->{'debug'} =0;

		## Do detection
		my $det_aref = Linux::DVB::DVBT::Advert::dvb_advert_detect($src, $settings_href) ;

		($results_href, $adata_ref) = @$det_aref ;

	if ($DEBUG)
	{
		print Data::Dumper->Dump(["after detect - results settings:", $results_href->{'settings'}]) ;
	}

		# tie an array to the internal data - this is *much* more effecient than letting Perl gobble up
		# 10x the memory
		my @frames ;
		tie @frames, 'Linux::DVB::DVBT::Advert', 'ADATA', [$$adata_ref] ;
		$results_href->{'frames'} = \@frames ;

		if ($DEBUG)
		{
			print "Read $results_href->{settings}{num_frames} frames\n" ;
			print Data::Dumper->Dump(["Results", $results_href]) ;
		}
	}

	## Optionally save results
	if ($detect)
	{
		open my $fh, ">$detect" or die "Error: unable to write to detect file $detect : $!" ;

		## Save settings
		my $save_settings_href = $results_href->{'settings'} ;
		foreach my $var (sort keys %$save_settings_href)
		{
			if (ref($save_settings_href->{$var}) eq 'HASH')
			{
				foreach my $subvar (sort keys %{$save_settings_href->{$var}})
				{
					print $fh "# $var.$subvar = $save_settings_href->{$var}{$subvar}\n" ;
				}
			}
			else
			{
				print $fh "# $var = $save_settings_href->{$var}\n" ;
			}
		}

		## Save frames
		my $frame_href = $results_href->{'frames'}[0] ;
		my $line = $FRAME_FIELD ;
		foreach my $field (sort keys %$frame_href)
		{
			next unless !ref($frame_href->{$field}) ;
			next if $field eq $FRAME_FIELD ;
			$line .= ",$field" ;
		}
		print $fh "$line\n" ;
		for (my $idx=0; $idx < $results_href->{'settings'}{'num_frames'}; ++$idx)
		{
			$frame_href = $results_href->{'frames'}[$idx] ;
			next unless scalar(keys %$frame_href) ;
			my $frame = $frame_href->{$FRAME_FIELD} ;
			$line = "$frame" ;
			foreach my $field (sort keys %$frame_href)
			{
				next unless !ref($frame_href->{$field}) ;
				next if $field eq $FRAME_FIELD ;
				$line .= ",$frame_href->{$field}" ;
			}
			print $fh "$line\n" ;
		}

		close $fh ;
	}

	return $results_href ;
}


#-----------------------------------------------------------------------------

=item B

Read the text file named by the I<$detect> parameter and return a HASH containing the detection statistics
for each frame. All settings are read in from the detection file (but any settings may be overridden in the
L function).

=cut

sub detect_from_file
{
	my ($detect, $settings_href) = @_ ;

	$settings_href ||= {} ;

	# check file
	open my $fh, "<$detect" or die "Error: unable to read to detect file $detect : $!" ;
	close $fh ;

	## Do detection
	my $det_aref = Linux::DVB::DVBT::Advert::dvb_advert_detect_from_file($detect, $settings_href) ;

	my ($results_href, $adata_ref) = @$det_aref ;

	# tie an array to the internal data - this is *much* more effecient than letting Perl gobble up
	# 10x the memory
	my @frames ;
	tie @frames, 'Linux::DVB::DVBT::Advert', 'ADATA', [$$adata_ref] ;
	$results_href->{'frames'} = \@frames ;
#	$results_href->{'__adata'} = $adata_ref ;

	if ($DEBUG >= 10)
	{
		print "Read $results_href->{settings}{num_frames} frames\n" ;
		print Data::Dumper->Dump(["Results", $results_href]) ;
	}

	return $results_href ;
}



#-----------------------------------------------------------------------------

=item B

Read in expected results file. Used more for debug / display purposes.

=cut

sub read_expected
{
	my ($expected_file) = @_ ;

	## check for expected results
	my @expected ;
#print "expected results: $expected_file\n" ;
	if (open my $fh, "<$expected_file")
	{
		my $line ;
		while (defined($line=<$fh>))
		{
			chomp $line ;

			# expected:
			#	 0)      1	  1387	0:00:55.43
			#	 1)  22208	 25186	0:01:59.12
			#	 2)  40451	 42151	0:01:08.00
			#	 3)  46763	 48741	0:01:19.12
			#
			if ($line =~ /^\s*(\d+)\)\s+(\d+)\s+(\d+)\s+(\d+):(\d+):(\d+)\.(\d+)/)
			{
				my ($idx, $start, $end, $hh, $mm, $ss, $ms) = ($1, $2, $3, $4, $5, $6, $7) ;
				push @expected, {
					'start'		=> $start,
					'end'		=> $end,
				} ;
				#print "$idx) $start .. $end\n" ;
			}
		}
		close $fh ;
	}

	return @expected ;
}


#-----------------------------------------------------------------------------

=item B

Process the results to create a cut list for the video using the results gathered by
L or L.
Results from detection are stored in the B<$results_href> HASH ref.

The B<$ad_config_href> parameter is expected to be the tuning info HASH ref read in using
L. It is used to set any settings read in
from the default config file. If it is undef then a default search path is used.

The optional I<$channel> parameter is used to specify the TV channel that the video was recorded
from. This then allows the config fiel to contain channel-specific settings which are used in the
detection. If no channel is specified (or the channel name is not found in the config file) then just
default settings are used.

Optionally specify a filename using B<$csv> to save the analysis results in a comma-separated
output file (from use in GUI viewing tool).

Optionally specify an ARRAY ref of expected results (read in using L) to
allow the GUI viewing tool to mark the positions of the expected program breaks.

Optionally specify extra settings in order to override the defaults and those used during detection.


=cut


sub analyse
{
	my ($src, $results_href, $ad_config_href, $channel, $csv, $expected_aref, $extra_settings_href) = @_ ;

	my @cut_list = () ;

	Linux::DVB::DVBT::Advert::Mem::print_used("Start of analyse") ;

	## Frame results
	my $frames_adata_aref = $results_href->{'frames'} ;

	## Should contain all the settings used during detection
	my $results_settings_href = $results_href->{'settings'} || {} ;

	# if no channel specified try using value stored in results
	$channel ||= $results_settings_href->{'channel'} ;

	if ($DEBUG)
	{
		print Data::Dumper->Dump(["===analyse====", "det file settings:", $results_settings_href]) ;
	}

	# get defaults used by C routines
	my $default_settings_href = Linux::DVB::DVBT::Advert::dvb_advert_def_settings() ;
	if ($DEBUG)
	{
		print Data::Dumper->Dump(["defaults:", $default_settings_href]) ;
	}

	# merge together all defaults with the settings used during detection to create a complete set of settings
	$results_settings_href = Linux::DVB::DVBT::Advert::Config::merge_settings(
									$default_settings_href,
									$results_settings_href,
								) ;

	## if channel specified, get channel-specific config
	my $config_settings_href = _advert_settings($ad_config_href, $channel) ;

	if ($DEBUG)
	{
		print Data::Dumper->Dump(["config file settings [chan=$channel]:", $config_settings_href]) ;
	}

	## Merge together the default
	$extra_settings_href = Linux::DVB::DVBT::Advert::Config::merge_settings(
									$config_settings_href,
									$extra_settings_href,
								) ;

	## Add expected results
	# actually a list of adverts (i.e. and advert is between start & end)
	if ($expected_aref && (ref($expected_aref) eq 'ARRAY') )
	{
		my $expect_href = shift @$expected_aref ;
		foreach my $frame_href (@$frames_adata_aref)
		{
			my $framenum = $frame_href->{'frame'} ;
			$frame_href->{$EXPECTED_FIELD} = 1 ;
			if ($expect_href)
			{
				if ( ($framenum >= $expect_href->{'start'}) && ($framenum <= $expect_href->{'end'}) )
				{
					$frame_href->{$EXPECTED_FIELD} = 0 ;
				}
				elsif ($framenum > $expect_href->{'end'})
				{
					$expect_href = shift @$expected_aref ;
				}
			}
		}
	}

prt_frames($frames_adata_aref) if $DEBUG >= 3 ;

	# total number of frames
	my $last_frame = -1 ;
	if (scalar(@$frames_adata_aref))
	{
		$last_frame = $frames_adata_aref->[-1]{'frame'} ;
	}
	my $total_frames = $last_frame + 1 ;
	$results_settings_href->{'num_frames'} = $total_frames ;

	return @cut_list unless $total_frames ;


	# total packets
	my $total_pkts = $frames_adata_aref->[$last_frame]{'end_pkt'} ;

print "== analyse() == : total frames:$total_frames, pkts:$total_pkts\n" if $DEBUG ;

	## Split frame results out into arrays (containing the HASH refs stored in results) where the specified
	## field flag is true
	my $black_frames_ada_ref = frames_list($results_href, 'black_frame') ;
#	my $scene_frames_ada_aref = frames_list($results_href, 'scene_frame') ;
#	my $size_frames_ada_aref = frames_list($results_href, 'size_change') ;
	my $logo_frames_ada_aref = frames_list($results_href, 'logo_frame') ;
	my $silent_frames_ada_aref = frames_list($results_href, 'silent_frame') ;
#	my $all_frames_ada_aref = frames_list($results_href, '') ;

	my $csv_frames_aref = new_csv_frames($results_href) ;

	Linux::DVB::DVBT::Advert::Mem::print_used(" + created ADA arrays") ;


#	if ($DEBUG)
#	{
##		dump_frames(\@size_frames, "All SIZE frames") if (@size_frames) ;
#		dump_frames(\@scene_frames, "All SCENE frames") if (@scene_frames) ;
#		dump_frames(\@black_frames, "All BLACK frames") if (@black_frames) ;
#		dump_frames(\@logo_frames, "All LOGO frames") if (@logo_frames) ;
#		dump_frames(\@silent_frames, "All SILENT frames") if (@silent_frames) ;
#		#dump_frames(\@banner_frames, "All BANNER frames") if (@banner_frames) ;
#		#dump_frames(\@audio_frames, "All AUDIO frames") if (@audio_frames) ;
#	}

	## Analysis results
	my @black_cut_list ;
	my @silent_cut_list ;
	my @logo_cut_list ;

	## Settings
	my $global_settings_href = Linux::DVB::DVBT::Advert::Config::cascade_settings($extra_settings_href, '', $results_settings_href) ;
	my $black_settings_href = Linux::DVB::DVBT::Advert::Config::cascade_settings($extra_settings_href, 'frame', $results_settings_href) ;
	my $logo_settings_href = Linux::DVB::DVBT::Advert::Config::cascade_settings($extra_settings_href, 'logo', $results_settings_href) ;
	my $silent_settings_href = Linux::DVB::DVBT::Advert::Config::cascade_settings($extra_settings_href, 'audio', $results_settings_href) ;

	# return cascaded settings
	$results_href->{'settings'} = {
		$global_settings_href,
		'frame' => $black_settings_href,
		'logo' => $logo_settings_href,
		'audio' => $silent_settings_href,
	} ;

	my $rise_thresh = $logo_settings_href->{'logo_rise_threshold'} || 1 ;
	my $fall_thresh = $logo_settings_href->{'logo_fall_threshold'} || 1 ;

	Linux::DVB::DVBT::Advert::Mem::print_used(" + got settings") ;


	## Skip if disabled
	if (!ok_to_detect($global_settings_href))
	{
		return @cut_list ;
	}


	## Saved CSV file for post-detection analysis
	my @csv_settings ;
	csv_add_setting(\@csv_settings, "frame", "0::") ;
	csv_add_setting(\@csv_settings, $PACKET_FIELD, "0::") ;
	csv_add_setting(\@csv_settings, $PACKET_END_FIELD, "0::") ;
	csv_add_setting(\@csv_settings, $PACKET_GOP_FIELD, "0::") ;
	csv_add_setting(\@csv_settings, "black_frame", "0:1:1") ;
	csv_add_setting(\@csv_settings, "scene_frame", "0:1:1") ;
	csv_add_setting(\@csv_settings, "size_change", "0:1:1") ;
	csv_add_setting(\@csv_settings, "match_percent", "0:$rise_thresh:100") ;
	csv_add_setting(\@csv_settings, "ave_percent", "0:$rise_thresh/$fall_thresh:100") ;
	csv_add_setting(\@csv_settings, "volume_dB", "-96:-60:0") ;
	csv_add_setting(\@csv_settings, "silent_frame", "0:1:1") ;
	csv_add_setting(\@csv_settings, $PROG_FIELD, "0:1:100") ;

	if ($expected_aref)
	{
		csv_add_setting(\@csv_settings, $EXPECTED_FIELD, "0:1:1") ;
	}

	## Check that this channel doesn't splat logos across the adverts too!
	my $logo_frames_percent = (100.0 * $results_settings_href->{'total_logo_frames'}) / (1.0 * $results_settings_href->{'num_frames'}) ;
print "CUTS: Logo % = $logo_frames_percent\n" if $DEBUG ;

	if ($logo_frames_percent > 90.0)
	{
print "CUTS: Skipping ALL-LOGOS frames...\n" if $DEBUG ;
##TODO: fix....
		@$logo_frames_ada_aref = () ;
	}

	##--[ Black detect ]----------------------------------------------------
	Linux::DVB::DVBT::Advert::Mem::print_used("Black detect") ;
	my $new_black_frames_aref = [] ;
	if (@$black_frames_ada_ref)
	{
#print STDERR "black detect\n" ;
		## process
		@black_cut_list = process_black_frames($black_frames_ada_ref, $new_black_frames_aref,
								$total_pkts, $total_frames, $black_settings_href,
								$frames_adata_aref, $csv_frames_aref, \@csv_settings) ;

		$black_frames_ada_ref = undef ;

		## validate cuts
		validate_cutlist(\@black_cut_list, $black_settings_href) ;

		# default to using the black cut list
		@cut_list = @black_cut_list ;

print "BLACK CUTS: " . scalar(@black_cut_list) . "\n" if $DEBUG ;

#print STDERR "black detect - done\n" ;
	}

	##--[ Logo detect ]----------------------------------------------------
	if (@$logo_frames_ada_aref)
	{
#print STDERR "logo detect\n" ;
		Linux::DVB::DVBT::Advert::Mem::print_used("Logo detect") ;

		my $scene_frames_ada_aref = frames_list($results_href, 'scene_frame') ;
		my $all_frames_ada_aref = frames_list($results_href, '') ;

		## process
		@logo_cut_list = process_logo_frames($all_frames_ada_aref, $new_black_frames_aref, $scene_frames_ada_aref,
								$total_pkts, $total_frames, $logo_settings_href,
								$frames_adata_aref, $csv_frames_aref, \@csv_settings) ;

		$scene_frames_ada_aref = undef ;
		$all_frames_ada_aref = undef ;
		$logo_frames_ada_aref = undef ;

		## validate cuts
		validate_cutlist(\@logo_cut_list, $logo_settings_href) ;

print "LOGO CUTS: " . scalar(@logo_cut_list) . "\n" if $DEBUG ;

		# use this logo list
		if (@logo_cut_list >= @cut_list)
		{
			@cut_list = @logo_cut_list ;
		}
		else
		{
			@logo_cut_list = () ;
print " + Cleared LOGO CUTS\n" if $DEBUG ;
		}
#print STDERR "logo detect - done\n" ;
	}


	##--[ Silence detect ]----------------------------------------------------
	if (!@logo_cut_list && @$new_black_frames_aref && $silent_frames_ada_aref)
	{
#print STDERR "silence detect\n" ;
		Linux::DVB::DVBT::Advert::Mem::print_used("Silence detect") ;

		## process
		@silent_cut_list = process_silent_frames($new_black_frames_aref, $silent_frames_ada_aref,
								$total_pkts, $total_frames, $silent_settings_href,
								$frames_adata_aref, $csv_frames_aref, \@csv_settings) ;

		$silent_frames_ada_aref = undef ;

		## validate cuts
		validate_cutlist(\@silent_cut_list, $silent_settings_href) ;

print "SILENT CUTS: " . scalar(@silent_cut_list) . "\n" if $DEBUG ;

		# default to using the black cut list
		if (@silent_cut_list)
		{
			@cut_list = @silent_cut_list ;
		}
#print STDERR "silence detect - done\n" ;
	}

#print STDERR "Detect - end\n" ;

	##--[ Final ]----------------------------------------------------
	Linux::DVB::DVBT::Advert::Mem::print_used("Detect end") ;

	if ($DEBUG)
	{
#print STDERR "printing cut lists...\n" ;
		if (@black_cut_list)
		{
			dump_cutlist("BLACK CUT LIST", \@black_cut_list, "#") ;
		}
		if (@logo_cut_list)
		{
			dump_cutlist("LOGO CUT LIST", \@logo_cut_list, "#") ;
		}
		if (@silent_cut_list)
		{
			dump_cutlist("SILENT CUT LIST", \@silent_cut_list, "#") ;
		}

		dump_cutlist("FINAL CUT LIST", \@cut_list, "") ;
#print STDERR "done printing cut lists...\n" ;
	}

	## Save CSV info
	if ($csv)
	{
#print STDERR "write csv\n" ;
		Linux::DVB::DVBT::Advert::Mem::print_used("Writing CSV") ;

		## Add cut list as program boundaries
		csv_add_prog($results_href, $csv_frames_aref, $PROG_FIELD, \@cut_list) ;

		## write out csv
		write_csv($csv, $results_href, $csv_frames_aref, @csv_settings) ;

#print STDERR "write csv - done\n" ;
	}

	## Tidy up
	$results_href = undef ;

	Linux::DVB::DVBT::Advert::Mem::print_used("End of analyse") ;

#print STDERR "Analyse - done\n" ;

	## return results
	return @cut_list ;
}


#-----------------------------------------------------------------------------

=item B

Cut the $src_file at the points specified in the ARRAY ref $cut_list_aref, writing the output
to $cut_file

=cut

sub ad_cut
{
	my ($src_file, $cut_file, $cut_list_aref) = @_ ;

	croak "Unable to read \"$src_file\"" unless -f $src_file ;
	croak "Zero-length file \"$src_file\"" unless -s $src_file ;
	croak "Must specify a destination filename" unless $cut_file ;

	# ensure dest directory exists
	my $dir = dirname($cut_file) ;
	if (! -d $dir)
	{
		# create dir
		mkpath([$dir], $DEBUG, 0755) or return "Unable to create directory $dir : $!" ;
	}

	# run cut
	my $rc = dvb_ad_cut($src_file, $cut_file, $cut_list_aref) ;

	return $rc ;
}

#-----------------------------------------------------------------------------

=item B

Split the $src_file at the points specified in the ARRAY ref $cut_list_aref, writing the output files
to $cut_file with suffix XXXX where XXXX is in incrementing count starting at 0001

=cut

sub ad_split
{
	my ($src_file, $cut_file, $cut_list_aref) = @_ ;

	croak "Unable to read \"$src_file\"" unless -f $src_file ;
	croak "Zero-length file \"$src_file\"" unless -s $src_file ;
	croak "Must specify a destination filename" unless $cut_file ;

	# ensure dest directory exists
	my $dir = dirname($cut_file) ;
	if (! -d $dir)
	{
		# create dir
		mkpath([$dir], $DEBUG, 0755) or return "Unable to create directory $dir : $!" ;
	}

	# run cut
	my $rc = dvb_ad_split($src_file, $cut_file, $cut_list_aref) ;

	return $rc ;
}


#-----------------------------------------------------------------------------

=item B

Looks at the settings and returns TRUE if the settings are such that advert detection
will be preformed (i.e. detection_method is not 'disabled' or 0)

=cut

sub ok_to_detect
{
	my ($settings_href) = @_ ;

	my $ok = 0 ;
	if (exists($settings_href->{'detection_method'}) && $settings_href->{'detection_method'})
	{
		$ok = 1 ;
	}

	return $ok ;
}


#-----------------------------------------------------------------------------

=item B

Writes a default Advert config file. If the optional B<$force> parameter is set, then
writes a new file even if one already exists. Uses the optional search path to find
a writeable directory (other than the default search path).

=cut

sub write_default_config
{
	my ($force, $search_path) = @_ ;

	$search_path ||= $CONFIG_DIR ;
	$CONFIG_DIR = $search_path ;

	my $fname = Linux::DVB::DVBT::Advert::Config::write_filename($search_path) ;
	if ($fname)
	{
		## only write if it doesn't exist OR we're forced to overwrite
		if ($force || (!$force && ! -f $fname))
		{
			# get defaults used by C routines
			my $default_settings_href = Linux::DVB::DVBT::Advert::dvb_advert_def_settings() ;
			my %settings = (
				$Linux::DVB::DVBT::Advert::Config::ADVERT_GLOBAL_SECTION => $default_settings_href,
			) ;

			# write config
			Linux::DVB::DVBT::Advert::Config::write_default_dvb_adv(\%settings, $search_path) ;
		}
	}
}


#============================================================================================
# PRIVATE
#============================================================================================

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# FRAMES LISTS
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

#-----------------------------------------------------------------------------
# Split frame results out into arrays (containing the HASH refs stored in results) where the specified
# field flag is true. If flag_field is empty then return the list of all frames
#
# XS
#
sub frames_list
{
	my ($results_href, $flag_field) = @_ ;

	my @list_ada ;

	my $thing = tied @{$results_href->{'frames'}} ;

	tie @list_ada, 'Linux::DVB::DVBT::Advert', 'FILTER',
		[$thing, $flag_field, 1] ;

	my $ada = tied @list_ada ;
	$ada->update_gaps() ;

	return \@list_ada ;
}

#-----------------------------------------------------------------------------
# Pull out any entries where the specified field >= threshold
#
sub frames_matching
{
	my ($frames_adata_aref, $flag_field, $threshold) = @_ ;

	my @list ;

	my $thing = tied @$frames_adata_aref ;

	my @list_ada ;
	tie @list_ada, 'Linux::DVB::DVBT::Advert', 'FILTER',
		[$thing, $flag_field, $threshold] ;

#dump_frames(\@list_ada, "frames_matching() - raw") ;

	my $ada = tied @list_ada ;
	$ada->update_gaps() ;

#dump_frames(\@list_ada, "frames_matching() - updated gap") ;

	# turn into a list of frame HASH entries
	@list = frames_array_to_hashlist(\@list_ada) ;

#dump_frames(\@list, "frames_matching() - frames_array_to_hashlist") ;

	return \@list ;
}




#---------------------------------------------------------------------------------
# Convert a list of all frames into a list of frame HASH entries
sub frames_array_to_hashlist
{
    my ($frames_aref) = @_ ;

    ## coalesce (also updates the gap settings)
    my @frames = coalesce_frames($frames_aref,
    	{
    		'frame_window'	=> 1,
    		'min_frames'	=> 1,
    	}
    ) ;

    return @frames ;
}



#---------------------------------------------------------------------------------
sub frames_subtract
{
	my ($src_frames_aref, $sub_frames_aref, $fuzziness) = @_ ;

	## add
	my @frames = frames_subtract_array($src_frames_aref, $sub_frames_aref, $fuzziness) ;

	## convert to list of frame hashs
	@frames = frames_array_to_hashlist(\@frames) ;

	return @frames
}

#---------------------------------------------------------------------------------
# Add frames list - return the array of all frames
sub frames_add_array
{
	my ($src_frames_aref, $add_frames_aref, $fuzziness) = @_ ;

	## get first entry from source to use to replicate into newly added entries
	my $new_href = $add_frames_aref->[0] ;

	## pre-process subtracting array
	my $first_frame = $add_frames_aref->[0]{'frame'} - $fuzziness ;
	my $last_frame = $add_frames_aref->[-1]{'frame_end'} + $fuzziness ;
	foreach my $href (@$add_frames_aref)
	{
		my $frame_start = $href->{'frame'} - $fuzziness ;
		my $frame_end = $href->{'frame_end'} + $fuzziness ;
	}

	## pre-process source array
	my @frames ;
	$first_frame = $add_frames_aref->[0]{'frame'} if $first_frame > $add_frames_aref->[0]{'frame'} ;
	$last_frame = $add_frames_aref->[-1]{'frame_end'} if $last_frame < $add_frames_aref->[-1]{'frame_end'} ;
	my %add_frames ;
	foreach my $href (@$add_frames_aref)
	{
		my $frame_start = $href->{'frame'} ;
		my $frame_end = $href->{'frame_end'} ;
		foreach my $fnum ($frame_start..$frame_end)
		{
			$add_frames{$fnum} = $href ;
		}
	}

	## Merge the two arrays
	foreach my $fnum ($first_frame..$last_frame)
	{
		if (exists($add_frames{$fnum}))
		{
			push @frames, $add_frames{$fnum} ;
		}
		elsif (exists($add_frames{$fnum}))
		{
			push @frames, {
				%$new_href,
				%{$add_frames{$fnum}},
			} ;
		}
	}
	update_gap(\@frames) ;

	return @frames
}



#---------------------------------------------------------------------------------
# Subtract frames list - return the array of all frames
sub frames_subtract_array
{
	my ($src_frames_aref, $sub_frames_aref, $fuzziness) = @_ ;

	## Make subtracting frames "fuzzy"
	my %fuzzy_frames ;
	foreach my $href (@$sub_frames_aref)
	{
		my $frame_start = $href->{'frame'} - $fuzziness ;
		my $frame_end = $href->{'frame_end'} + $fuzziness ;
		$frame_start=0 if ($frame_start<0) ;
		foreach my $fnum ($frame_start..$frame_end)
		{
			$fuzzy_frames{$fnum} = $href ;
		}
	}

	## Remove source frames that do not coincide with subtracted
	my @frames ;
	foreach my $href (@$src_frames_aref)
	{
		my $framenum = $href->{'frame'} ;
		my $framenum_end = $href->{'frame_end'} ;

		my $ok = 0 ;
		foreach my $fnum ($href->{'frame'}..$href->{'frame_end'})
		{
			if (exists($fuzzy_frames{$fnum}))
			{
				$ok=1 ;
			}
		}
		if ($ok)
		{
			push @frames, $href ;
		}
	}

	update_gap(\@frames) ;

	return @frames
}

#---------------------------------------------------------------------------------
# Add frames list - return a list of frame HASH refs
sub frames_add
{
	my ($src_frames_aref, $add_frames_aref, $fuzziness) = @_ ;

	## add
	my @frames = frames_add_array($src_frames_aref, $add_frames_aref, $fuzziness) ;

	## convert to list of frame hashs
	@frames = frames_array_to_hashlist(\@frames) ;

	return @frames
}

#---------------------------------------------------------------------------------
# Reduce the program length of the specified frame HASH entry to the nearest gap start
# in the given list
#
# HASH entry:
#
#                                                  numframes=n
#              |----------------------------------------------->|
#              |
#               _...............................................
#              | |                                              :
#   ___________| |______________________________________________:____
#              ^                                                ^
#              frame=f                                          frame_end
#                         |<----------window--------------------:
#
# Closest entry in list:
#
#                            |<---min_gap--------->|
#
#                            |                     |
#                            |<--------------------|
#                                          gap      _...........
#                            :                     | |          :
#   _________________________:_____________________| |__________:____
#                                                  ^            ^
#                                                  frame=f      frame_end
#
#
# HASH entry after reduction:
#
#                  numframes
#              |------------>|
#              |
#               _............
#              | |           :
#   ___________| |___________:_______________________________________
#              ^             ^
#              frame=f       frame_end
#
#
sub frames_reduce_end
{
	my ($frame_href, $frames_aref, $window, $min_gap) = @_ ;

	my $gap_href ;

if ($DEBUG) {print "frames_reduce_end(win=$window, gap=$min_gap) -START : "; dump_frame($frame_href) ;}

	## Find any gaps that are within the specified window AND gap >= min_gap
	## (If window=0, allow any gaps)
	## $gap_href will be set to the PREVIOUS entry so that the 'frame_end' and 'end_pkt'
	## values can be used
	##
	my $min_framenum = $frame_href->{'frame_end'} - $window ;
	my $max_framenum = $frame_href->{'frame_end'} ;
	$min_framenum = 0 if !$window ;
	my $prev_href = {'frame_end'=>0, 'end_pkt'=>0} ;
	foreach my $this_href (@$frames_aref)
	{
if ($DEBUG) {print " + evaluating gap : "; dump_frame($this_href) ;}

		## Stop at first valid match
		if (($this_href->{'frame'} >= $min_framenum) && ($this_href->{'frame'} >= $min_framenum) && ($this_href->{'gap'} >= $min_gap))
		{
			$gap_href = $prev_href ;
if ($DEBUG) {print " + + found gap : using "; dump_frame($gap_href) ;}
			last ;
		}
		$prev_href = $this_href ;
	}


	## Reduce end point to beginning of gap
	if ($gap_href)
	{
		$frame_href->{'frame_end'} = $gap_href->{'frame_end'} ;
		$frame_href->{'end_pkt'} = $gap_href->{'end_pkt'} ;

if ($DEBUG) {print " ++ Reduced "; dump_frame($frame_href) ;}
	}

if ($DEBUG) {print "frames_reduce_end(win=$window, gap=$min_gap) -END : "; dump_frame($frame_href) ;}

	return $frame_href
}

#---------------------------------------------------------------------------------
# !!!TBD!!!
#
# TODO: Work out what to do here!
#
# Reduce the program length of the specified frame HASH entry to the nearest gap start
# in the given list
#
# HASH entry:
#
#                                                  numframes=n
#              |----------------------------------------------->|
#              |
#               _...............................................
#              | |                                              :
#   ___________| |______________________________________________:____
#              ^                                                ^
#              frame=f                                          frame_end
#                         |<----------window--------------------:
#
# Closest entry in list:
#
#                            |<---min_gap--------->|
#
#                            |                     |
#                            |<--------------------|
#                                          gap      _...........
#                            :                     | |          :
#   _________________________:_____________________| |__________:____
#                                                  ^            ^
#                                                  frame=f      frame_end
#
#
# HASH entry after reduction:
#
#                  numframes
#              |------------>|
#              |
#               _............
#              | |           :
#   ___________| |___________:_______________________________________
#              ^             ^
#              frame=f       frame_end
#
#
sub frames_increase_start
{
	my ($frame_href, $frames_aref, $window, $min_gap) = @_ ;

#	my $gap_href ;
#
#if ($DEBUG) {print "frames_reduce_end(win=$window, gap=$min_gap) -START : "; dump_frame($frame_href) ;}
#
#	## Find any gaps that are within the specified window AND gap >= min_gap
#	## (If window=0, allow any gaps)
#	## $gap_href will be set to the PREVIOUS entry so that the 'frame_end' and 'end_pkt'
#	## values can be used
#	##
#	my $min_framenum = $frame_href->{'frame_end'} - $window ;
#	my $max_framenum = $frame_href->{'frame_end'} ;
#	$min_framenum = 0 if !$window ;
#	my $prev_href = {'frame_end'=>0, 'end_pkt'=>0} ;
#	foreach my $this_href (@$frames_aref)
#	{
#if ($DEBUG) {print " + evaluating gap : "; dump_frame($this_href) ;}
#
#		## Stop at first valid match
#		if (($this_href->{'frame'} >= $min_framenum) && ($this_href->{'frame'} >= $min_framenum) && ($this_href->{'gap'} >= $min_gap))
#		{
#			$gap_href = $prev_href ;
#if ($DEBUG) {print " + + found gap : using "; dump_frame($gap_href) ;}
#			last ;
#		}
#		$prev_href = $this_href ;
#	}
#
#
#	## Reduce end point to beginning of gap
#	if ($gap_href)
#	{
#		$frame_href->{'frame_end'} = $gap_href->{'frame_end'} ;
#		$frame_href->{'end_pkt'} = $gap_href->{'end_pkt'} ;
#
#if ($DEBUG) {print " ++ Reduced "; dump_frame($frame_href) ;}
#	}
#
#if ($DEBUG) {print "frames_reduce_end(win=$window, gap=$min_gap) -END : "; dump_frame($frame_href) ;}

	return $frame_href
}



# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# CSV
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

#-----------------------------------------------------------------------------
#
sub new_csv_frames
{
	my ($results_href) = @_ ;

#print STDERR "new_csv_frames()\n";

	# Create
	my @list ;

	my $thing = tied @{$results_href->{'frames'}} ;

	tie @list, 'Linux::DVB::DVBT::Advert', 'ADV', [$thing] ;

	return \@list ;
}


#---------------------------------------------------------------------------------
sub csv_add_setting
{
	my ($settings_aref, $key, $threshold) = @_ ;

	push @{$settings_aref->[0]}, $key ;
	push @{$settings_aref->[1]}, $threshold ;
}

#---------------------------------------------------------------------------------
sub csv_add_prog
{
	my ($results_href, $csv_frames_aref, $prog_field, $cutlist_aref) = @_ ;

print "csv_add_prog()\n" if $DEBUG;

	my @cuts = @$cutlist_aref ;
	my $cut_href = shift @cuts ;

	my $adv = tied @$csv_frames_aref ;
	$adv->add_key($prog_field) ;

	for(my $i=0; $i < scalar(@$csv_frames_aref); ++$i)
	{
		#my $href = $csv_frames_aref->[$i] ;
		my $href = {} ;
		my $framenum = $csv_frames_aref->[$i]->{'frame'} ;

print " + frame $framenum : cut_href s=$cut_href->{'frame'} .. e=$cut_href->{'frame_end'}\n" if $DEBUG;

		$href->{$prog_field} = 100 ;
		my $done = 0 ;
		while ($cut_href && !$done)
		{
			if ($framenum < $cut_href->{'frame'})
			{
				$href->{$prog_field} = 100 ;
				++$done ;
			}
			elsif ( ($framenum >= $cut_href->{'frame'}) && ($framenum <= $cut_href->{'frame_end'}))
			{
				$href->{$prog_field} = 0 ;
				++$done ;
			}
			elsif ( ($framenum > $cut_href->{'frame_end'}))
			{
				# get next in the list
				if (@cuts)
				{
					$cut_href = shift @cuts ;
				}
				else
				{
					$href->{$prog_field} = 100 ;
					++$done ;
				}
			}
		}

		$csv_frames_aref->[$i] = $href ;
	}

print "csv_add_prog() - END\n" if $DEBUG;

}

#-----------------------------------------------------------------------------
sub csv_add_frames
{
	my ($csv_settings_aref, $frames_adata_aref, $csv_frames_aref, $new_frames_aref, $field, $threshold, $new_field) = @_ ;

#print STDERR "csv_add_frames()\n";

	push @{$csv_settings_aref->[0]}, $field ;
	push @{$csv_settings_aref->[1]}, $threshold ;

	# start by clearing
	my $adv = tied @$csv_frames_aref ;
	$adv->add_key($field) ;

	# next add frames
	foreach my $buff_href (@$new_frames_aref)
	{
		my $fnum_start = $buff_href->{'frame'} ;
		my $fnum_end = $buff_href->{'frame_end'} || $fnum_start ;

		if ( defined($fnum_end) && ($fnum_end > $fnum_start))
		{
			foreach my $fnum ($fnum_start..$fnum_end)
			{
				$csv_frames_aref->[$fnum] = { $field => $buff_href->{$new_field} };
			}
		}
		else
		{
			$csv_frames_aref->[$fnum_start] = { $field => $buff_href->{$new_field} };
		}
	}

#print STDERR "csv_add_frames() - END\n";

}

#-----------------------------------------------------------------------------
# Write CSV
sub write_csv
{
    my ($fname, $results_href, $csv_frames_aref, $headings_aref, $levels_aref) = @_;

print "Writing CSV $fname ... \n" if $DEBUG ;

	open my $fh, ">$fname" or die "Unable to write CSV $fname : $!" ;
	print $fh "$headings_aref->[0]" ;
	for (my $i=1; $i < scalar(@$headings_aref); ++$i)
	{
		print $fh ",$headings_aref->[$i] [$levels_aref->[$i]]" ;
	}
	print $fh "\n" ;

	my $frames_adata_aref = $results_href->{'frames'} ;
	foreach my $frame_href (@$frames_adata_aref)
	{
		my $frame = $frame_href->{'frame'} ;
		my $href = $csv_frames_aref->[$frame] ;

		my $head = $headings_aref->[0] ;
		print $fh "$href->{$head}" ;
		for (my $i=1; $i < scalar(@$headings_aref); ++$i)
		{
			$head = $headings_aref->[$i] ;
			my $val = exists($href->{$head}) ? $href->{$head} : $frame_href->{$head} ;
			print $fh ",$val" ;
		}
		print $fh "\n" ;
	}

	close $fh ;
}


# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# FRAME HASH
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

# Each frame HASH entry, along with specific information, stores the relationship with it's
# previous entry
#
#                                                  numframes=n
#                            |                     |----------->|
#                            |<--------------------|
#               _............              gap      _...........
#              | |           :                     | |          :
#   ___________| |___________:_____________________| |__________:____
#                                                  ^            ^
#                                                  frame=f      frame_end
#
#




#-----------------------------------------------------------------------------
# Set the gap counts - the distance each frame is from it's previous frame
#
#              numframes=n'                        numframes=n
#              |------------>|                     |----------->|
#                            |<--------------------|
#               _............              gap      _...........
#              | |           :                     | |          :
#   ___________| |___________:_____________________| |__________:____
#              ^             ^                     ^
#            frame=f'     frame_end=e'             frame=f
#
#
#              | f' ..... e' | e'+1  ......... f-1 |
#              |------------>|
#                 n'=e'-f'+1 |
#                            |<--------------------|
#                                gap = (f-1) - (e'+1) + 1
#
#
#
# For frame f:
#
#    gap = f - e' - 1
#
sub calc_gap
{
	my ($frame, $prev_frame_end) = @_ ;

	return $frame - $prev_frame_end - 1 ;
}

#-----------------------------------------------------------------------------
#
sub update_gap
{
	my ($frames_aref) = @_ ;

	my $prev_frame_end = -1 ;
	foreach my $href (@$frames_aref)
	{
		my $frame = $href->{'frame'} ;
		$href->{'gap'} = calc_gap($frame, $prev_frame_end) ;

		$prev_frame_end = $href->{'frame_end'} ;
	}
}


#-----------------------------------------------------------------------------
# Return the number of frames for this frame entry
#
#              numframes=n'                        numframes=n
#              |------------>|                     |----------->|
#               _............                       _...........
#              | |           :                     | |          :
#   ___________| |___________:_____________________| |__________:____
#            frame=f'     frame_end=e'             frame=f     frame_end=e
#
# For frame f:
#
#    numframes: n = e - f + 1
#

sub numframes
{
	my ($frame_href) = @_ ;

	return $frame_href->{frame_end} - $frame_href->{frame} + 1 ;
}

#-----------------------------------------------------------------------------
# Set the type based on section length
sub _prog_type
{
    my ($duration, $settings_href) = @_;

    # could be either
    my $type = "advert/prog" ;
    if ($duration <= $settings_href->{'max_advert'})
    {
    	$type = "advert" ;
print "_prog_type=$type : $duration <= $settings_href->{'max_advert'}\n" if $DEBUG >= 2 ;
    }
    elsif ($duration >= $settings_href->{'min_program'})
    {
    	$type = "program" ;
print "_prog_type=$type : $duration >= $settings_href->{'min_program'}\n" if $DEBUG >= 2 ;
    }
	return $type ;
}

#---------------------------------------------------------------------------------
# Ensure each cut is of a valid length
sub validate_cutlist
{
    my ($cutlist_aref, $settings_href) = @_ ;

print "validate_cutlist:\n" if $DEBUG ;

	## Throw away rubbish (e.g. at start of video when there is actually nothing to cut)
	my $prev_end = 0 ;
	my @list ;
	my $num_entries = scalar(@$cutlist_aref) ;
	for (my $i=0; $i < $num_entries; ++$i)
	{
		my $cut_href = shift @$cutlist_aref ;
		my $period = ($cut_href->{'frame_end'}-$cut_href->{'frame'}+1) ;
		if ($period > 0)
		{

			# see if gap (i.e. program) long enough
			my $ok=1 ;
			my $prog_period =($cut_href->{'frame'}-$prev_end+1) ;
if ($DEBUG) { print " + checking (prog=$prog_period min=$settings_href->{'min_program'}) : "; dump_frame($cut_href) ; }
			if ($prog_period < $settings_href->{'min_program'})
			{
print " !! Program period too small (prog=$prog_period min=$settings_href->{'min_program'})" if $DEBUG ;
				if (scalar(@list))
				{
if ($DEBUG) { print " , appending new to end of previous" ; dump_frame($list[-1]) ; }
					$ok=0 ;
					$list[-1]{'frame_end'} = $cut_href->{'frame_end'} ;
					$list[-1]{'end_pkt'} = $cut_href->{'end_pkt'} ;
				}
				else
				{
print ", setting start to 0\n" if $DEBUG ;
					# start of list, amend first frame
					$cut_href = { %$cut_href } ;
					$cut_href->{'frame'} = 0 ;
					$cut_href->{'start_pkt'} = 0 ;
					$cut_href->{'gap'} = 0 ;
				}
			}

			if ($ok)
			{
if ($DEBUG) { print " + + saved : " ;	dump_frame($cut_href) ;	}
				push @list, $cut_href ;
				$prev_end = $cut_href->{'frame_end'} ;
			}
		}
	}

	## Build new list
	$prev_end = 0 ;
	$num_entries = scalar(@list) ;
	for (my $i=0; $i < $num_entries; ++$i)
	{
		my $cut_href = $list[$i] ;

		if (defined($prev_end))
		{
			my $prog_period = ($cut_href->{'frame'}-$prev_end+1) ;
printf("(PROG $prev_end .. $cut_href->{'frame'} period=$prog_period (min=$settings_href->{'min_program'})") if $DEBUG ;
			if ($prog_period >= $settings_href->{'min_program'})
			{
print " - OK" if $DEBUG ;
			}
print " )\n" if $DEBUG ;

		}

		# don't check start/end
		my $period = ($cut_href->{'frame_end'}-$cut_href->{'frame'}+1) ;

printf("%2d: $cut_href->{'frame'}..$cut_href->{'frame_end'} period=$period (min=$settings_href->{'min_advert'})", $i) if $DEBUG ;
		if ( ($i==0) || ($period >= $settings_href->{'min_advert'}) || ($i==$num_entries-1) )
		{
			push @$cutlist_aref, $cut_href ;
print " - OK" if $DEBUG ;
		}
print "\n" if $DEBUG ;

		$prev_end = $cut_href->{'frame_end'} ;
	}
}


# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# ANALYSIS UTILS
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

#---------------------------------------------------------------------------------
#
sub coalesce_frames
{
    my ($frames_aref, $settings_href, $start_framenum, $title) = @_ ;

    $title ||= "" ;
print "coalesce_frames($title)\n" if $DEBUG ;

	$start_framenum ||= 0 ;

    my @frames ;
	my $curr_href ;
	for (my $idx=0; $idx < scalar(@$frames_aref); $idx++)
	{
if ($DEBUG >= 2) { print " -> frame "; dump_frame($frames_aref->[$idx]) ; }

		# start of new "block"
		if ($frames_aref->[$idx]{'gap'} > $settings_href->{'frame_window'})
		{
if ($DEBUG) { print "new block : "; dump_frame($curr_href) ; }

			## check existing

			#              curr   idx
			#     ||||     |||    |
			#              curr
			#         <----gap    idx
			#                 <---gap
			#
			# Can now check to see if previous block (the "current" HASH) is a spurious block
			#
			if ($curr_href &&
			(numframes($curr_href) < $settings_href->{'min_frames'})
			)
			{
if ($DEBUG) { print " - (curr gap = $frames_aref->[$idx]{'gap'}, curr numframes = $curr_href->{'numframes'}) removed spurious : "; dump_frame($curr_href) ; }

				# remove spurious
				pop @frames ;
			}

			# start new
			$curr_href = {
				'frame_start'	=> $frames_aref->[$idx]{'frame'},
				'frame_end'		=> $frames_aref->[$idx]{'frame'},
				%{$frames_aref->[$idx]},
			} ;
			push @frames, $curr_href ;

			my $prev_frame_end = $start_framenum ;
			if (scalar(@frames) >= 2)
			{
				$prev_frame_end = $frames[-2]{'frame_end'} ;
if ($DEBUG) { print " - calc prev : "; dump_frame($frames[-2]) ; }
			}
			$curr_href->{'gap'} = calc_gap($curr_href->{'frame_start'}, $prev_frame_end ) ;
		}
		else
		{
			if (!$curr_href)
			{
				# start new
				$curr_href = {
					'frame_start'	=> $frames_aref->[$idx]{'frame'},
					'frame_end'		=> $frames_aref->[$idx]{'frame_end'},
					%{$frames_aref->[$idx]},
				} ;
				push @frames, $curr_href ;
			}
			else
			{
				# expand end time
				$curr_href->{'end_pkt'} = $frames_aref->[$idx]{'end_pkt'} ;
				$curr_href->{'frame_end'} = $frames_aref->[$idx]{'frame_end'} ;
			}
		}
	}

	if ($curr_href && (numframes($curr_href) < $settings_href->{'min_frames'}))
	{
if ($DEBUG) { print " - removed spurious : "; dump_frame($curr_href) ; }
		# remove spurious
		pop @frames ;
	}

print "coalesce_frames($title) - DONE\n" if $DEBUG ;

	update_gap(\@frames) ;

	return @frames ;
}

#============================================================================================
# DEBUG
#============================================================================================

#-----------------------------------------------------------------------------
# format fps into time
sub fps_time
{
    my ($fps_duration) = @_;
    my $str ;

	my $fsecs = $fps_duration * 1.0 / $FPS ;
	my $secs = int($fps_duration / $FPS) ;
	my ($mins, $hours) ;

	if ($secs > 60)
	{
		if ($secs > 60*60)
		{
			$hours = int($secs / (60*60)) ;
			$secs -= $hours * 60*60 ;
		}

		$mins = int($secs / (60)) ;
		$secs -= $mins * 60 ;
	}

	if ($hours)
	{
		$str .= sprintf "%d hours ", $hours ;
	}
	if ($mins)
	{
		$str .= sprintf "%d mins ", $mins ;
	}
	$str .= sprintf "%d secs", $secs ;

	return $str ;
}


#-----------------------------------------------------------------------------
# format fps into time
sub fps_timestamp
{
    my ($fps_duration) = @_;
    my $str ;

	my $fsecs = $fps_duration * 1.0 / $FPS ;
	my $secs = int($fps_duration / $FPS) ;
	my ($mins, $hours, $msec) = (0, 0, 0);

	$msec = int($fsecs*1000 - $secs*1000) ;

	if ($secs > 60)
	{
		if ($secs > 60*60)
		{
			$hours = int($secs / (60*60)) ;
			$secs -= $hours * 60*60 ;
		}

		$mins = int($secs / (60)) ;
		$secs -= $mins * 60 ;
	}

	$str = sprintf "%0d:%02d:%02d.%03d", $hours, $mins, $secs, $msec ;

	return $str ;
}

#---------------------------------------------------------------------------------
#
sub dump_cutlist
{
    my ($title, $cutlist_aref, $prefix) = @_ ;

	print "\n\n# $title\n" ;
	foreach my $cut_href (@$cutlist_aref)
	{
		printf "${prefix}# frame=%d:%d  %s\n", $cut_href->{'frame'}, $cut_href->{'frame_end'}, fps_time($cut_href->{'frame_end'}-$cut_href->{'frame'}+1) ;
	}
	foreach my $cut_href (@$cutlist_aref)
	{
		printf "${prefix}p=%d:%d\n", $cut_href->{'start_pkt'}, $cut_href->{'end_pkt'} ;
	}
}




#-----------------------------------------------------------------------------
# Display this black frame entry
sub dump_frame
{
    my ($frame_href) = @_;

	printf("frame=%d [%s] gap=%d (%s) numframes=%d : ",
		$frame_href->{'frame'},
		fps_timestamp($frame_href->{'frame'}),
		$frame_href->{'gap'},
		fps_time($frame_href->{'gap'}),
		numframes($frame_href),
		) ;
	if (exists($frame_href->{'match_percent'}))
	{
		printf "Qual=%d%% : ", $frame_href->{'match_percent'} ;
	}
	if (exists($frame_href->{'weight'}))
	{
		printf "Weight=%d%% : ", $frame_href->{'weight'} ;
	}
	if (exists($frame_href->{'ave_percent'}))
	{
		printf "Ave. Qual=%d%% : ", $frame_href->{'ave_percent'} ;
	}
	printf("%d .. %d",
		$frame_href->{'start_pkt'}, $frame_href->{'end_pkt'},
		) ;

	if (exists($frame_href->{'type'}))
	{
		print " : Type=$frame_href->{'type'}" ;
	}

	if (exists($frame_href->{'adverts'}))
	{
		print " : Ads=$frame_href->{'adverts'}" ;
	}
	if (exists($frame_href->{'frame_start'}))
	{
		print " : Frames $frame_href->{'frame_start'} .. $frame_href->{'frame_end'} duration (" .
			fps_time(numframes($frame_href))
			. ")" ;
	}
	print "\n" ;
}

#-----------------------------------------------------------------------------
# Show the current black frames list
sub dump_frames
{
    my ($frames_aref, $msg) = @_;

    my @edges ;
    my $edge_href ;

	print "\n----[ $msg (", scalar(@$frames_aref)," frames) ]------------------------------\n" ;
	foreach my $href (@$frames_aref)
	{
		while ( $edge_href && ($href->{'frame'} > $edge_href->{'frame'}) )
		{
			print "*** $edge_href->{'frame'} ** " . ($edge_href->{'type'} eq 'start_pkt' ? "vvvvvvvvvv" : "^^^^^^^^^^") . "******\n" ;
	    	$edge_href = shift @edges ;
		}

		print "---------\n" if ($href->{'gap'}>1);

		if ( $edge_href && ($href->{'frame'} == $edge_href->{'frame'}) && ($edge_href->{'type'} eq 'start_pkt'))
		{
			print "*** $edge_href->{'frame'} ** " . ($edge_href->{'type'} eq 'start_pkt' ? "vvvvvvvvvv" : "^^^^^^^^^^") . "******\n" ;
	    	$edge_href = shift @edges ;
		}
		print "???BAD??? " if ($href->{'gap'}<0);

		dump_frame($href) ;

		if ( $edge_href && ($href->{'frame'} == $edge_href->{'frame'}) && ($edge_href->{'type'} eq 'end_pkt'))
		{
			print "*** $edge_href->{'frame'} ** " . ($edge_href->{'type'} eq 'start_pkt' ? "vvvvvvvvvv" : "^^^^^^^^^^") . "******\n" ;
	    	$edge_href = shift @edges ;
		}
	}
	print "\n----------------------------------\n" ;
}

sub prt_frame
{
    my ($frames_aref, $framenum) = @_;

	print "$framenum : " ;
	foreach my $key (sort keys %{$frames_aref->[$framenum]})
	{
		print " $key=$frames_aref->[$framenum]{$key}" ;
	}
	print "\n" ;
}
sub prt_frames
{
    my ($frames_aref) = @_;

	foreach my $frame_href (@$frames_aref)
	{
		prt_frame($frames_aref, $frame_href->{'frame'}) ;
	}
}

#=================================================================================
# BLACK FRAMES
#=================================================================================

#---------------------------------------------------------------------------------
#
sub black_frame_cutlist
{
    my ($frames_aref, $total_pkts, $total_frames, $settings_href) = @_ ;
	my @cut_list  ;

print "--- black_frame_cutlist() ---\n" if $DEBUG ;

	#        : start :                        : end :
	#        : pad   :                        : pad :
	#   _________|||____________|||___________|||______
	#        :                                      :
	#

	#
	#   _____|||____________|||___________|||__________
	#        :                                      :
	#

	#
	#   __|||____________|||___________|||_____________
	#        :                                      :
	#

	my $curr_href=undef ;
	foreach my $href (@$frames_aref)
	{
		my $type = _prog_type($href->{'gap'}, $settings_href) ;

		if ($DEBUG)
		{
			print "Cutlist len = " . scalar(@cut_list)."\n" ;
			print "[$type] " ; dump_frame($href) ;
		}

		# start of new "block"
		if ($type eq 'program')
		{
print " + New prog\n" if $DEBUG ;

			# start new
			$curr_href = {
				'adverts'	=> 0,
				'type'		=> $type,
				%$href,
			} ;
			push @cut_list, $curr_href ;

print " + new prog added\n" if $DEBUG ;
		}
		else
		{
			if (!$curr_href)
			{
				# start new
				$curr_href = {
					'adverts'	=> 0,
					'type'		=> $type,
					%$href,
				} ;
				push @cut_list, $curr_href ;
print " + new advert\n" if $DEBUG ;
			}
			else
			{
				# inc advert count
				$curr_href->{'adverts'}++ ;

				# expand end time
				$curr_href->{'end_pkt'} = $href->{'end_pkt'} ;
				$curr_href->{'frame_end'} = $href->{'frame_end'} ;
print " + extend\n" if $DEBUG ;
			}
		}
	}

	## process start and end
	if (@cut_list)
	{
		## start
		my $start_href = $cut_list[0] ;
		if ($start_href->{'type'} ne 'program')
		{
			$start_href->{'start_pkt'} = 0 ;
			$start_href->{'frame_start'} = 0 ;	# for debug
		}

		## end
		my $end_href = $cut_list[-1] ;
		my $end_gap = $total_frames - $end_href->{'frame_end'} - 1 ;
		my $end_type = _prog_type($end_gap, $settings_href) ;
		if ($end_type ne 'program')
		{
			$end_href->{'end_pkt'} = $total_pkts-1 ;
			$end_href->{'frame_end'} = $total_frames-1 ;	# for debug
		}
	}


	return @cut_list ;
}

#---------------------------------------------------------------------------------
#
sub process_black_frames
{
    my ($black_frames_ada_ref, $new_black_frames_aref, $total_pkts, $total_frames, $settings_href, $frames_adata_aref, $csv_frames_aref, $csv_settings_aref) = @_ ;

if ($DEBUG)
{
print "\n=================================================\n" ;
print "process_black_frames()\n" ;
print Data::Dumper->Dump(["Settings:", $settings_href]) ;
}

	## strip out any spurious frames

	# start by coalescing the contiguous black frames
	my @frames = coalesce_frames($black_frames_ada_ref, $settings_href, 0) ;

dump_frames(\@frames, "BLACK coalesced") if $DEBUG >= 2 ;

	csv_add_frames($csv_settings_aref, $frames_adata_aref, $csv_frames_aref, \@frames,
		$BLACK_COALESCED_FIELD, "0:1:1", 'black_frame') ;

	## update input array with coalesced version
	my $num_black =  scalar(@$black_frames_ada_ref) ;
	foreach my $href (@frames)
	{
		push @$new_black_frames_aref, $href ;
	}

	## Create black frame cutlist
	my @cut_list = black_frame_cutlist(\@frames, $total_pkts, $total_frames, $settings_href) ;

dump_frames(\@cut_list, "Final BLACK Cut List") if $DEBUG >= 2 ;

	return @cut_list ;
}

#---------------------------------------------------------------------------------
#
sub process_silent_frames
{
    my ($black_frames_aref, $silent_frames_ada_aref, $total_pkts, $total_frames, $settings_href, $frames_adata_aref, $csv_frames_aref, $csv_settings_aref) = @_ ;

if ($DEBUG)
{
print "\n=================================================\n" ;
print "process_silent_frames()\n" ;
print Data::Dumper->Dump(["Settings:", $settings_href]) ;
}

	## strip out any spurious frames

	# start by coalescing the contiguous black frames
	my @silent_frames = coalesce_frames($silent_frames_ada_aref, $settings_href, 0) ;

	csv_add_frames($csv_settings_aref, $frames_adata_aref, $csv_frames_aref, \@silent_frames,
		$SILENT_COALESCED_FIELD, "0:1:1", 'silent_frame') ;

#my $SILENCE_WINDOW = 100 ;

	## Remove black frames that do not coincide with silence (with silence "fuzzy")
	my @frames = frames_subtract($black_frames_aref, \@silent_frames, $settings_href->{'silence_window'}) ;

if ($DEBUG >= 2)
{
dump_frames(\@silent_frames, "SILENT") ;
dump_frames(\@frames, "SILENT BLACK") ;
}

	# Now have blocks of silence (in @silence_frames) along with spikes of black frames that are "silent".
	# Overlay the silent blocks with the black blocks, coalesce (again!) and we should have the answer
	my @combined_frames ;
	my %silent_frames = map { $_->{'frame'} => $_ } @silent_frames ;
	my %silent_black_frames = map { $_->{'frame'} => $_ } @frames ;
	my $last_framenum = $silent_frames[-1]{'frame'} ;
	$last_framenum = $frames[-1]{'frame'} if $last_framenum < $frames[-1]{'frame'} ;
print "Process frames 0..$last_framenum\n" if $DEBUG ;
	for (my $framenum=0; $framenum <= $last_framenum; ++$framenum)
	{
		my $href ;
		if (exists($silent_frames{$framenum}))
		{
			$href = $silent_frames{$framenum} ;
if ($DEBUG) {print " + silent @ $framenum : " ; dump_frame($href) ;}
		}
		elsif (exists($silent_black_frames{$framenum}))
		{
			$href = $silent_black_frames{$framenum} ;
if ($DEBUG) {print " + silent_black @ $framenum : " ; dump_frame($href) ;}
		}

		if ($href)
		{
			push @combined_frames, { %$href, 'black_frame'=>1 } ;
			$framenum = $href->{'frame_end'} ;
		}
	}
	update_gap(\@combined_frames) ;

	@combined_frames = coalesce_frames(\@combined_frames, $settings_href, 0) ;
dump_frames(\@combined_frames, "COMBINED COAL") if $DEBUG >= 2 ;

	csv_add_frames($csv_settings_aref, $frames_adata_aref, $csv_frames_aref, \@combined_frames,
		$SILENT_BLACK_FIELD, "0:1:1", 'black_frame') ;

##NEW###################################################
#my $reduce_end = 15 * $FPS ;	# 15 sec window
#my $reduce_min_gap = 2 * $FPS ;	# need at least 2 sec gap

	if ($settings_href->{'reduce_end'})
	{
		## reduce the program end to the nearest silent region within
		## the window of the end
		foreach my $frame_href (@combined_frames)
		{
			frames_reduce_end($frame_href, \@silent_frames, $settings_href->{'reduce_end'}, $settings_href->{'reduce_min_gap'}) ;
		}

		csv_add_frames($csv_settings_aref, $frames_adata_aref, $csv_frames_aref, \@combined_frames,
			$REDUCED_SILENT_BLACK_FIELD, "0:1:1", 'black_frame') ;

	}


##NEW###################################################





	## Create black frame cutlist
	my @cut_list = black_frame_cutlist(\@combined_frames, $total_pkts, $total_frames, $settings_href) ;

dump_frames(\@cut_list, "Final SILENT Cut List") if $DEBUG >= 2 ;

	return @cut_list ;
}


#=================================================================================
# LOGO FRAMES
#=================================================================================

# TODO: Handle all start cases - record after start of prog (i.e. logo = 100%), record during adverts, record during end of previous
# TODO: Handle all end cases - record end before end of prog, record end during adverts, record end at start of next prog

#-----------------------------------------------------------------------------
# Given a frame number and a list of frames, find the frames from the list that
# are immediately adjacent to this one.
#
sub bounding_frames
{
	my ($framenum, $frames_aref) = @_ ;

	my ($before, $after) ;
	foreach my $href (@$frames_aref)
	{
		my $frame_end = $href->{'frame_end'} ;
		if ($frame_end <= $framenum)
		{
			$before = $href->{'frame_end'} ;
		}
		elsif ($href->{'frame'} > $framenum)
		{
			$after = $href->{'frame'} ;
			last ;
		}
	}
	return ($before, $after) ;
}


#---------------------------------------------------------------------------------
sub logo_add_frames
{
	my ($msg_str, $frames_adata_aref, $logo_frames_aref, $start_frame, $end_frame, $settings_href, $edge_ref) = @_ ;

#	my @add_frames ;
	foreach my $fnum ($start_frame..$end_frame)
	{
			# save first edge
			if ($edge_ref)
			{
				$$edge_ref = $fnum unless defined($$edge_ref) ;
			}

			# spoof an entry that looks like a valid logo detection
			my $buff_href = { %{$frames_adata_aref->[$fnum]} } ;
			$buff_href->{'match_percent'} = $settings_href->{'logo_rise_threshold'} ;
			$buff_href->{'ave_percent'} = $settings_href->{'logo_rise_threshold'} ;

if ($DEBUG) {print " + + $msg_str extended by : " ; dump_frame($buff_href) ;}

#			push @add_frames, $buff_href ;
			push @$logo_frames_aref, $buff_href ;
	}
#	push @$logo_frames_aref, @add_frames ;

}

#---------------------------------------------------------------------------------
#
sub process_logo_frames
{
    my ($logo_all_frames_ada_aref, $black_frames_aref, $scene_frames_ada_aref, $total_pkts, $total_frames, $settings_href,
    	$frames_adata_aref, $csv_frames_aref, $csv_settings_aref) = @_ ;

	my @cut_list ;

if ($DEBUG)
{
print "\n=================================================\n" ;
print "process_logo_frames()\n" ;
print Data::Dumper->Dump(["Settings:", $settings_href]) ;
}

	my $logo_frames_adl_aref ;
	$logo_frames_adl_aref = [] ;

	my @lf ;
	my $thing = tied @$frames_adata_aref ;

	tie @lf, 'Linux::DVB::DVBT::Advert', 'LOGO',
		[$thing] ;

	$logo_frames_adl_aref = \@lf ;

	my $adl = tied @$logo_frames_adl_aref ;


	## Threshold the frames based on average quality
	my $prev = 0 ;
	my $detect_mode = 'rise' ;
	foreach my $href (@$logo_all_frames_ada_aref)
	{
		my $framenum = $href->{'frame'} ;

if ($DEBUG)
{
		$adl->logo_frames_sanity($framenum) ;
}

		## threshold detection with hysteresis
		my $above = 0 ;
		if ($detect_mode eq 'rise')
		{
			# rising detect
			if ($href->{'ave_percent'} >= $settings_href->{'logo_rise_threshold'})
			{
				$above = 1 ;
				$detect_mode = 'fall' ;
			}
		}
		else
		{
			# falling detect
			$above = 1 ;
			if ($href->{'ave_percent'} < $settings_href->{'logo_fall_threshold'})
			{
				$above = 0 ;
				$detect_mode = 'rise' ;
			}
		}

		## use detected threshold
		if ($above)
		{
			if (!$prev)
			{
if ($DEBUG) {print " + rising edge : " ; dump_frame($href) ;}

				## rising edge - prefix by previous points to previous scene change


				# See if any scene changes are within (yet another) window of the new start edge
				#
				#   Scene Change:          |     |                     |              |
				#   Logo ave quality:                        ||||||||||||||||||||||||||||||
				#   Extended (scene):            ::::::::::::||||||||||||||||||||||||||||||...
				#
				my $start_framenum = $framenum ;

				## extend back while "raw" quality > threshold
				my $extend_start = $start_framenum - $settings_href->{'logo_ave_points'} ;
				$extend_start = 0 if ($extend_start < 0) ;
				for (my $fnum = $start_framenum-1; $fnum >= $extend_start; --$fnum)
				{
					if (($frames_adata_aref->[$fnum]{'match_percent'} >= $settings_href->{'logo_rise_threshold'}))
					{
						$start_framenum = $fnum ;
if ($DEBUG) {print " + + match extended by : " ; dump_frame($frames_adata_aref->[$fnum]) ;}
					}
					else
					{
						# stop
						last ;
					}
				}

				my $found_edge = 0 ;
				my $edge = undef ;

				# find any black frames around new start frame
print "rising black bounding..\n" if $DEBUG ;
				my ($black_before, $black_after) = bounding_frames($start_framenum, $black_frames_aref) ;

print " - black : rising frame $start_framenum, black before $black_before, black after $black_after\n" if $DEBUG ;

				# find any scene changes around new start frame
print "rising scene bounding..\n" if $DEBUG ;
				my ($scene_before, $scene_after) = bounding_frames($start_framenum, $scene_frames_ada_aref) ;

print " - scene : rising frame $start_framenum, scene before $scene_before, scene after $scene_after\n" if $DEBUG ;

				# if change occurs before the start frame AND it's not too far away, then extend to this point
				if (($black_before < $start_framenum) && ( ($start_framenum-$black_before) < $settings_href->{'logo_ave_points'}))
				{
					++$found_edge ;
					logo_add_frames("black", $frames_adata_aref, $logo_frames_adl_aref, $black_before, $framenum-1, $settings_href, \$edge) ;
				}


				# if scene change occurs before the start frame AND it's not too far away, then extend to this point
				if (!$found_edge && ($scene_before < $start_framenum) && ( ($start_framenum-$scene_before) < $settings_href->{'logo_ave_points'}))
				{
					++$found_edge ;
					logo_add_frames("scene", $frames_adata_aref, $logo_frames_adl_aref, $scene_before, $framenum-1, $settings_href, \$edge) ;
				}

print " - found? $found_edge : edge=$edge\n" if $DEBUG ;

				## if this is the start of the video, see if we can extend to the start (use the lower threshold)
				if ($found_edge && ($edge) && ($edge <= $settings_href->{'logo_ave_points'}) )
				{
print " + + start extending...\n" if $DEBUG ;
					my $fnum = $edge-1 ;
					my $window_count = 0 ;
					while ( ($fnum >= 0) && ($window_count < $settings_href->{'frame_window'}) )
					{
						if ($frames_adata_aref->[$fnum]{'match_percent'} >= $settings_href->{'logo_fall_threshold'})
						{
							$window_count = 0 ;
						}
						else
						{
							++$window_count ;
						}
						--$fnum ;
					}

					# if we're nearly at the start, then just start at 0
					++$fnum ;
					$fnum = 0 if ($fnum <= $settings_href->{frame_window}) ;

					# add frames (skip any < threshold)
					my @start_frames ;
					while ($fnum < $edge)
					{
						if ($frames_adata_aref->[$fnum]{'match_percent'} >= $settings_href->{'logo_rise_threshold'})
						{
if ($DEBUG) {print " + + start-extended by : " ; dump_frame($frames_adata_aref->[$fnum]) ;}
#							push @start_frames, $frames_adata_aref->[$fnum] ;
							unshift @$logo_frames_adl_aref, $frames_adata_aref->[$fnum] ;
						}
						++$fnum ;
					}

					# insert these at the start
#					unshift @$logo_frames_adl_aref, @start_frames ;
				}

				## fall back on extending as much as possible
				if (!$found_edge)
				{
					# failed to use scene change - fall back on using raw quality

					## rising edge - prefix by previous points > threshold

					# calc where to start from (allow a window where quality can be < threshold)
					# (need to use frame buffer)
					my $end_index = $framenum-1 ;
					my $start_index = $end_index ;
					my $window_count = 0 ;
					while ( ($start_index > 0) && ($end_index-$start_index < $settings_href->{'logo_ave_points'}) && ($window_count < $settings_href->{'frame_window'}) )
					{
						if ($frames_adata_aref->[$start_index]{'match_percent'} >= $settings_href->{'logo_rise_threshold'})
						{
							$window_count = 0 ;
						}
						else
						{
							++$window_count ;
						}
						--$start_index ;
					}

if ($DEBUG) {print " + start..end : $start_index .. $end_index\n" ; }

					# add frames (skip any < threshold)
					++$start_index ;
					foreach my $buff_href (@$frames_adata_aref[$start_index..$end_index])
					{
						if ($buff_href->{'match_percent'} > $settings_href->{'logo_rise_threshold'})
						{
if ($DEBUG) {print " + + extended by : " ; dump_frame($buff_href) ;}
							push @$logo_frames_adl_aref, $buff_href ;
						}
					}
				}

				$adl->update_gaps() ;

dump_frames($logo_frames_adl_aref, "LOGO after extending due to rising edge") if $DEBUG >= 2;

			}

			## add this frame
			push @$logo_frames_adl_aref, $href ;

			$prev = 1 ;
		}
		else
		{
			if ($prev)
			{
if ($DEBUG) {print " + falling edge : " ; dump_frame($href) ;}

				$adl->update_gaps() ;

dump_frames($logo_frames_adl_aref, "LOGO before reducing due to falling edge") if $DEBUG >= 2;

				## trailing edge - remove any raw points < threshold
				# use logo array we're building

				# remove ALL frames for the length of the buffer, then start adding them back iff > threshold AND not too far away
				my $end_index = scalar(@$logo_frames_adl_aref)-1 ;
				my $start_index = $end_index-$settings_href->{'logo_ave_points'} ;
				$start_index = 0 if $start_index < 0 ;
				my $num_end_frames = $end_index - $start_index + 1 ;
if ($DEBUG) {print " + + reduced by $num_end_frames frames (start idx=$start_index, end idx=$end_index) to : " ; dump_frame($logo_frames_adl_aref->[$start_index]) ;}

				splice @$logo_frames_adl_aref, $start_index ;

				## check we have some points left?
				if (scalar(@$logo_frames_adl_aref))
				{

					# create a list of these removed frames that are > threshold
					my @end_frames = () ;
	print STDERR "logo_frames_adl_aref size = ",scalar(@$logo_frames_adl_aref),"\n"	 if $DEBUG >= 2;
	print STDERR "About to read from logo_frames_adl_aref[-1] ...\n"  if $DEBUG >= 2;
					my $new_framenum = $logo_frames_adl_aref->[-1]{'frame'}+1 ;
					foreach (1..$num_end_frames)
					{
						if ($frames_adata_aref->[$new_framenum]{'match_percent'} >= $settings_href->{'logo_rise_threshold'})
						{
	if ($DEBUG) {print " >> end_frames + $new_framenum " ; dump_frame($frames_adata_aref->[$new_framenum]) ;}
							push @end_frames, $frames_adata_aref->[$new_framenum] ;
						}
						++$new_framenum ;
					}

					# coalesce valid frames together
					update_gap(\@end_frames) ;
					@end_frames = coalesce_frames(\@end_frames, $settings_href, $logo_frames_adl_aref->[-1]{'frame'}, "logo end frames") ;

	dump_frames(\@end_frames, "coalesced end logo frames") if $DEBUG >= 2;

					# Just use the first block - the end *should* be the real end of the program
					if (@end_frames)
					{
						my $f_href = $end_frames[0] ;
						foreach my $new_framenum ($f_href->{'frame'}..$f_href->{'frame_end'})
						{
							push @$logo_frames_adl_aref, $frames_adata_aref->[$new_framenum] ;
	if ($DEBUG) {print " + + re-extend by : " ; dump_frame($frames_adata_aref->[$new_framenum]) ;}
						}
					}

					@end_frames = () ;

					$adl->update_gaps() ;

	dump_frames($logo_frames_adl_aref, "LOGO after reducing") if $DEBUG >= 2 ;


					## see if we can expand out to a scene change
					my $end_framenum = $logo_frames_adl_aref->[-1]{'frame'} ;
	print " end frame=$end_framenum\n" if $DEBUG ;

					# find any black frames around new end frame
	print "falling black bounding..\n" if $DEBUG ;
					my ($black_before, $black_after) = bounding_frames($end_framenum, $black_frames_aref) ;

	print " - black : falling frame $end_framenum, black before $black_before, black after $black_after\n" if $DEBUG ;

					# find any scene changes around new end frame
	print "falling scene bounding..\n" if $DEBUG ;
					my ($scene_before, $scene_after) = bounding_frames($end_framenum, $scene_frames_ada_aref) ;

	print " - scene : falling frame $end_framenum, scene before $scene_before, scene after $scene_after\n" if $DEBUG ;

					my $found_edge = 0 ;

					# if black frame occurs after the end frame AND it's not too far away, then extend to this point
					if (($black_after > $end_framenum) && ( ($black_after-$end_framenum) < $settings_href->{'logo_ave_points'}))
					{
						++$found_edge ;
						logo_add_frames("black", $frames_adata_aref, $logo_frames_adl_aref, $end_framenum+1, $black_after, $settings_href) ;
					}

					# if scene change occurs after the end frame AND it's not too far away, then extend to this point
					if (!$found_edge && ($scene_after > $end_framenum) && ( ($scene_after-$end_framenum) < $settings_href->{'logo_ave_points'}))
					{
						++$found_edge ;
						logo_add_frames("scene", $frames_adata_aref, $logo_frames_adl_aref, $end_framenum+1, $scene_after, $settings_href) ;
					}

	if (!$found_edge && $DEBUG)
	{
		print "Bugger - failed to find edge!\n" ;
	}

					$adl->update_gaps() ;

	dump_frames($logo_frames_adl_aref, "LOGO after re-extending") if $DEBUG >= 2 ;

				} # if got some logo frames left after splice?
			}

			$prev = 0 ;
		}
	}


	## update gap's
	$adl->update_gaps() ;


	## Add processed information
	my $rise_thresh = $settings_href->{'logo_rise_threshold'} || 1 ;
	my $fall_thresh = $settings_href->{'logo_fall_threshold'} || 1 ;

dump_frames($logo_frames_adl_aref, "LOGO processed") if $DEBUG >= 2 ;

	csv_add_frames($csv_settings_aref, $frames_adata_aref, $csv_frames_aref, $logo_frames_adl_aref,
		$LOGO_PROCESSED_FIELD, "0:$rise_thresh/$fall_thresh:100", 'match_percent') ;

	## start by coalescing the contiguous frames
	my @frames = coalesce_frames($logo_frames_adl_aref, $settings_href, 0, "logo frames") ;

dump_frames(\@frames, "LOGO coalesced") if $DEBUG >= 2 ;

	csv_add_frames($csv_settings_aref, $frames_adata_aref, $csv_frames_aref, \@frames,
		$LOGO_COALESCED_FIELD, "0:$rise_thresh/$fall_thresh:100", 'match_percent') ;


##NEW###################################################
#my $reduce_end = 15 * $FPS ;	# 15 sec window
#my $reduce_min_gap = 2 * $FPS ;	# need at least 2 sec gap

	## calc logo match frames - used for frame end reduction
	my $logo_match_frames_aref = frames_matching($logo_all_frames_ada_aref, 'match_percent', $settings_href->{'logo_rise_threshold'});
	csv_add_frames($csv_settings_aref, $frames_adata_aref, $csv_frames_aref, $logo_match_frames_aref,
		'logo_match', "0:$rise_thresh/$rise_thresh:100", 'match_percent') ;


#dump_frames($logo_match_frames_aref, "LOGO match frames") ;

	## process end reduction
	if ($settings_href->{'reduce_end'})
	{
		## reduce the program end to the nearest silent region within
		## the window of the end
		foreach my $frame_href (@frames)
		{
			frames_reduce_end($frame_href, $logo_match_frames_aref, $settings_href->{'reduce_end'}, $settings_href->{'reduce_min_gap'}) ;
		}

		csv_add_frames($csv_settings_aref, $frames_adata_aref, $csv_frames_aref, \@frames,
			$REDUCED_LOGO_COALESCED_FIELD, "0:$rise_thresh/$fall_thresh:100", 'match_percent') ;

	}


##NEW###################################################



	## Now glue together blocks
	my @blocks ;
	my $curr_href=undef ;
	foreach my $href (@frames)
	{
		printf("frame=%d gap=%d (%8.3f) numframes=%d : %d .. %d\n",
			$href->{'frame'},
			$href->{'gap'},
			$href->{'gap'}*1.0 / $FPS,
			numframes($href),
			$href->{'start_pkt'}, $href->{'end_pkt'},
			) if $DEBUG ;

		# start of new "block"
		if ($href->{'gap'} >= $settings_href->{'max_gap'})
		{
print " + New\n" if $DEBUG ;
			# start new
			$curr_href = {
				%$href,
			} ;
			push @blocks, $curr_href ;
		}
		else
		{
print " - extend : new numframes=",numframes($href),", new gap=$href->{'gap'}\n" if $DEBUG ;
			if (!$curr_href)
			{
print " - + extend NEW\n" if $DEBUG ;
				# start new
				$curr_href = {
					%$href,
				} ;
				push @blocks, $curr_href ;
			}
			else
			{
print " - + extend curr numframes=",numframes($href),"\n" if $DEBUG ;
				# expand end time
				###$curr_href->{'numframes'} += $href->{'numframes'} ;
				$curr_href->{'end_pkt'} = $href->{'end_pkt'} ;
				$curr_href->{'frame_end'} = $href->{'frame_end'} ;
			}
		}
	}
dump_frames(\@blocks, "Logo Blocks") if $DEBUG ;


	## Create cut list
	if (@blocks)
	{
		my $cut_href = {'start_pkt'=>0, 'frame'=>0} ;
		push @cut_list, $cut_href ;
		foreach my $href (@blocks)
		{
			$cut_href->{'end_pkt'} = $href->{'start_pkt'}-1 ;
			$cut_href->{'frame_end'} = $href->{'frame'}-1 ;

			$cut_href = {
				'start_pkt'	=>	$href->{'end_pkt'}+1,
				'frame'	=>	$href->{'frame_end'}+1,
			} ;
			push @cut_list, $cut_href ;
		}
		$cut_href->{'end_pkt'} = $total_pkts-1 ;
		$cut_href->{'frame_end'} = $total_frames-1 ;

		# check last (first?) entry has a valid length
		if ($cut_href->{'frame'} >= $cut_href->{'frame_end'})
		{
			pop @cut_list ;
		}

	}

	return @cut_list ;
}


#-----------------------------------------------------------------------------
sub _no_once_warning
{
	return \%Linux::DVB::DVBT::Advert::Constants::CONSTANTS ;
}


#-----------------------------------------------------------------------------
sub read_adv
{
	my ($advfile) = @_ ;

	my %adv ;
	open my $fh, "<$advfile" or die "Error: unable to read to adv file $advfile : $!" ;
	my $line = "" ;
	my @head ;
	my $file_settings_href = {} ;

	while (defined($line=<$fh>))
	{
		chomp $line ;
		$line =~ s/#.*$// ;
		$line =~ s/\s+$// ;
		$line =~ s/^\s+// ;
		next unless $line ;

		my @fields = split(/,/, $line) ;

		## Save frames
		# first line is fields definition
		if (@head)
		{
			# got head, so save data
			my $href = {} ;
			my $framenum ;
			for(my $i=0; $i < scalar(@head); ++$i)
			{
				$href->{$head[$i]} = $fields[$i] ;

				$framenum = $fields[$i] if $head[$i] eq $FRAME_FIELD ;

			}
			$adv{$framenum} = $href if defined($framenum) ;
		}
		else
		{
			# get head
			@head = @fields ;

			foreach my $head (@head)
			{
				$head =~ s/\s*\[.*$// ;
			}
		}
	}
	close $fh ;

	return \%adv ;
}


#-----------------------------------------------------------------------------
sub adv_to_cutlist
{
	my ($adv_href) = @_ ;

	my @cutlist ;
	my $prog ;
	my $cut_href ;
	foreach my $framenum (sort {$a <=> $b} keys %$adv_href)
	{
		#			          ____________
		#	prog	_________|            |_______________
		#
		#	cut     s--------e            s---------------e
		#
		#			____________
		#	prog	            |_______________
		#
		#	cut                 s---------------e
		#
		my $prog_change = !defined($prog) || ($prog != $adv_href->{$framenum}{$PROG_FIELD}) ;
		$prog = $adv_href->{$framenum}{$PROG_FIELD} ;

		# look for start of advert
		if (!$prog && $prog_change )
		{
			$cut_href = {
				$FRAME_FIELD		=> $adv_href->{$framenum}{$FRAME_FIELD},
				$FRAME_END_FIELD	=> $adv_href->{$framenum}{$FRAME_FIELD},
				$PACKET_FIELD		=> $adv_href->{$framenum}{$PACKET_FIELD},
				$PACKET_END_FIELD	=> $adv_href->{$framenum}{$PACKET_END_FIELD},
			} ;
		}

		# keep track of end of advert
		if (!$prog)
		{
			$cut_href->{$FRAME_END_FIELD} = $adv_href->{$framenum}{$FRAME_FIELD} ;
			$cut_href->{$PACKET_END_FIELD} = $adv_href->{$framenum}{$PACKET_END_FIELD} ;
		}

		# look for end
		if ($prog && $prog_change )
		{
			if ($cut_href)
			{
				push @cutlist, $cut_href ;
				$cut_href = undef ;
			}
		}
	}

	# catch end of video
	if ($cut_href)
	{
		push @cutlist, $cut_href ;
	}

	return @cutlist ;
}

# ============================================================================================
# END OF PACKAGE

1;

#Start of analyse: Memory used 50.6484375 MB (since last call 50.6484375 MB)
# + created ADA arrays: Memory used 179.1953125 MB (since last call 128.546875 MB)
# + got settings: Memory used 179.19921875 MB (since last call 0.00390625 MB)
#Black detect: Memory used 179.19921875 MB (since last call 0 MB)
#Logo detect: Memory used 189.3984375 MB (since last call 10.19921875 MB)
#Detect end: Memory used 940.23046875 MB (since last call 750.83203125 MB)
#End of analyse: Memory used 1313.71484375 MB (since last call 373.484375 MB)

__END__