view release on metacpan or  search on metacpan

lib/Linux/DVB/DVBT/Advert/Config.pm  view on Meta::CPAN

	print "METHOD: method=$val\n" if $DEBUG >= 10 ;
		}
	}
print "METHOD: val=$val\n" if $DEBUG >= 10 ;
	
	return $val ;
}


#----------------------------------------------------------------------
sub parse_value
{
	my ($var, $val) = @_ ;
	
	if ($var eq $METHOD_VAR)
	{
		$val = parse_method($var, $val) ;
	}
	else
	{
		my $ival = parse_val($val) ;
		if (defined($ival))
		{
			$val = $ival ;
		}
	}
	return $val ;
}

#----------------------------------------------------------------------
sub parse_assignment
{
	my ($line, $href) = @_ ;

	if ($line =~ /(\S+)\s*=\s*(\S+.*)/)
	{
		my ($var, $val) = ($1, $2) ;
		$val =~ s/\s+$// ;
		if ($var =~ /([\w\d]+)\.([\w\d]+)/)
		{
			# of the form:
			#   logo.logo_threshold
			#
			# so save as:
			#   {logo}{logo_threshold}
			# 
			$href->{$1} ||= {} ;
			$href->{$1}{$2} = parse_value($var, $val) ;
		}
		else
		{
			$href->{$var} = parse_value($var, $val) ;
		}
	}
}

#----------------------------------------------------------------------
# Need to copy globals down to key (if not already set), then use defaults
# if neither set
#
sub cascade_settings
{
	my ($settings_href, $key, $defaults_href) = @_ ;
	
	$settings_href ||= {} ;
	$defaults_href ||= {} ;
	
	my $cascaded_href = {} ;

print Data::Dumper->Dump(["cascade_settings($key) IN:", $settings_href, "DEFAULTS:", $defaults_href]) if $DEBUG >= 10 ;
	
	## start with defaults as a baseline
	if ($key && exists($defaults_href->{$key}))
	{
		_hash_copy_shallow($defaults_href->{$key}, $cascaded_href) ;
	}
	else
	{
		_hash_copy_shallow($defaults_href, $cascaded_href) ;
	}
	
	## copy over any settings defined in the global namespace
	_hash_copy_shallow($settings_href, $cascaded_href) ;

	## copy over any settings defined in the key's namespace
	if ($key && exists($settings_href->{$key}))
	{
		_hash_copy_shallow($settings_href->{$key}, $cascaded_href) ;
	}
	else
	{
		_hash_copy_shallow($settings_href, $cascaded_href) ;
	}
print Data::Dumper->Dump(["cascade_settings($key) OUT:", $cascaded_href]) if $DEBUG >= 10 ;
	
	return $cascaded_href ;
}

#----------------------------------------------------------------------
# Do a deep copy of one HASH heirarchy of settings onto another
# List of settings starting with lowest priority
#
sub merge_settings
{
	my (@settings_list) = @_ ;

print Data::Dumper->Dump(["merge_settings() IN:", \@settings_list]) if $DEBUG >= 10 ;
	
	my $merged_href = {} ;
	foreach my $href (@settings_list)
	{
		_hash_copy_deep($href, $merged_href);
	}

print Data::Dumper->Dump(["merge_settings() OUT:", $merged_href]) if $DEBUG >= 10 ;
	
	return $merged_href ;
}



#----------------------------------------------------------------------
# Do a deep copy of the HASH and sub-hashes, propagating global settings down onto
# any unset channel settings
#
sub channel_settings
{
	my ($advert_settings_href, $channel) = @_ ;
	
	$channel ||= "" ;
	$channel =~ s/^['"](.*)['"]$/$1/ ;
	
print Data::Dumper->Dump(["channel_settings($channel) IN:", $advert_settings_href]) if $DEBUG >= 10 ;
	
	my $cascaded_href = {} ;
	
	## Get copy of globals
	_hash_copy_deep($advert_settings_href->{$ADVERT_GLOBAL_SECTION}, $cascaded_href);
	
	## If channel specified, overwrite globals with channel-specific
	if ($channel && exists($advert_settings_href->{$channel}))
	{
		_hash_copy_deep($advert_settings_href->{$channel}, $cascaded_href);
		
		## Insert channel name into settings
		$cascaded_href->{'channel'} = $channel ;
	}
	
print Data::Dumper->Dump(["channel_settings($channel) OUT:", $cascaded_href]) if $DEBUG >= 10 ;
	return $cascaded_href ;
}



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


#---------------------------------------------------------------------------------
# Copy key values from one hash into another. Follow a single depth of hierarchy for any
# HASH entries
sub _hash_copy_deep
{
	my ($base_href, $new_href) = @_ ;
	
	$base_href ||= {} ;
	croak "Error: cannot copy HASH because destination is not a HASH ref" if ref($new_href) ne 'HASH' ;
	
	foreach my $key (keys %$base_href)
	{
		my $val = $base_href->{$key} ;
		if (ref($val) eq 'HASH')
		{
			# copy HASH entries
			$new_href->{$key} ||= {} ;
			$new_href->{$key} = {
				%{$new_href->{$key}},
				%$val
			};
		}
		else
		{
			# scalar
			$new_href->{$key} = $val ;
		}
	}
}

#---------------------------------------------------------------------------------
# Copy key values from one hash into another. Skips any HASH entries
sub _hash_copy_shallow
{
	my ($base_href, $new_href) = @_ ;
	
	$base_href ||= {} ;
	
	croak "Error: cannot copy HASH because destination is not a HASH ref" if ref($new_href) ne 'HASH' ;

	foreach my $key (keys %$base_href)
	{
		my $val = $base_href->{$key} ;
		if (!ref($val))
		{
			# scalar
			$new_href->{$key} = $val ;
		}
	}
}

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