view release on metacpan or  search on metacpan

lib/App/Framework/Feature/Config.pm  view on Meta::CPAN

		}
	}
		
	return %config ;
}




#============================================================================================
# PRIVATE METHODS 
#============================================================================================

#	#  TAG: authenticate_cache_garbage_interval
#	#       The time period between garbage collection across the username cache.
#	#       This is a tradeoff between memory utilization (long intervals - say
#	#       2 days) and CPU (short intervals - say 1 minute). Only change if you
#	#       have good reason to.
#	#
#	#Default:
#	# authenticate_cache_garbage_interval 1 hour
#	authenticate_cache_garbage_interval 1 hour

#	## Path:        Network/WWW/Apache2
#	## Description: Configuration for Apache 2
#	## Type:        string
#	## Default:     ""
#	## ServiceRestart: apache2
#	#
#	# Here you can name files, separated by spaces, that should be Include'd from 
#	# httpd.conf. 
#	#
#	# This allows you to add e.g. VirtualHost statements without touching 
#	# /etc/apache2/httpd.conf itself, which makes upgrading easier. 
#	#
#	APACHE_CONF_INCLUDE_FILES=""



#----------------------------------------------------------------------------
#
#=item B< _process($filename) >
#
#Read in the config file (located somewhere in the searchable path). 
#
#Returns a HASH of the config.
#
#=cut
#
sub _process
{
	my $this = shift ;
	my ($filename) = @_ ;
	my %config ;
	my %sections ;
	my @sections ;
	my $order=1 ;
		
$this->_dbg_prt( ["Config: _process($filename)\n"] ) ;

	open my $fh, "<$filename" or $this->throw_fatal("Feature:Config : unable to read file $filename : $!") ;
	my $line ;
	my %params ;
	my $href = \%config ;
	while (defined($line = <$fh>))
	{
		chomp $line ;

$this->_dbg_prt( [" + <$line>\n"] ) ;
$this->_dbg_prt( ["Params:", \%params] ) ;						

		$line =~ s/^\s+// ;
		$line =~ s/\s+$// ;
		unless ($line)
		{
			## Empty line, see if we were creating a new entry - if so, save it
			if ($params{name})
			{
				$href->{$params{name}} = $this->_new_cfg(
					$params{name},
					undef,
					$params{summary},
					$params{description},
					$params{type},
					$params{default},
					$order++,
				) ;

			}

			# clear params ready for new entry
			foreach my $param (qw/summary description type name default/)
			{
				$params{$param} = undef ;
			}
			
			next ;
		}

		## Parameter setting
		#
		# e.g. 
		#    ## Description: Configuration for Apache 2
		#
		if ($line =~ /^##\s*([^\s:]+)(?:\s*:){0,1}(.*)/)
		{
			my ($var, $val) = ($1, $2) ;
$this->_dbg_prt( [" + Param: <$var> = <$val>\n"] ) ;

			$val =~ s/^\s+// ;
			$val =~ s/\s+$// ;
			$params{lc $var} = $val ;
		}
		
		## Description
		elsif ($line =~ /^#\s*(\S+.*)/)
		{
			$params{'description'} .= "$1\n" ;

$this->_dbg_prt( [" + Description: $params{'description'}\n"] ) ;
		}

lib/App/Framework/Feature/Config.pm  view on Meta::CPAN

{
	my $this = shift ;
	my ($var, $value, $summary, $description, $type, $default, $order) = @_ ;

{
my ($dvar, $dvalue, $dsummary, $ddescription, $dtype, $ddefault, $dorder) = ($var||'', $value||'', $summary||'', $description||'', $type||'', $default||'', $order||'') ;
$this->_dbg_prt( ["_new_cfg($dvar) val=<$dvalue> summary=<$dsummary> desc=<$ddescription> type=<$dtype> index=<$dorder>\n"] ) ;	
}
	
	## set defaults
	
	# default to string type
	$type = 's' unless (defined($type)) ;
	
	# if either summary or description is not set, then use the other for both
	$summary ||= '' ;
	$description ||= '' ;
	if ("$description$summary")
	{
		if (!$description)
		{
			$description = $summary ;
		}
		elsif (!$summary)
		{
			$summary = $description ;
			$summary =~ s/\s+$// ;
		}
	}
	
	
$this->_dbg_prt( [" + type=<$type>\n"] ) ;	

	my $cfg_href = {
		'summary'		=> $summary,
		'default'		=> $default,
		'description'	=> $description,
		'type'			=> $type || '',
		'value'			=> $value,
		'index'			=> $order || 32767,
	} ;
	
	return $cfg_href ;
}

#----------------------------------------------------------------------------
#
#=item B< _write($write_file) >
#
#Write the config file (located somewhere in the searchable path). 
#
#=cut
#
sub _write
{
	my $this = shift ;
	my ($write_file) = @_ ;
	
$this->_dbg_prt( ["Config: _write($write_file)\n"] ) ;

	open my $fh, ">$write_file" or $this->throw_fatal("Feature:Config : unable to write file $write_file : $!") ;

	## Global options
	my %config = $this->get_raw_hash() ;
	
	# skip config options
	my $skip=0;
	foreach my $opt (@CONFIG_OPTIONS)
	{
		delete $config{$opt} ;
	}

	## write global settings
	$this->_write_vars($fh, \%config) ;
	
	## Sections
	my $sections_aref = $this->sections ;
$this->_dbg_prt( ["Section", $sections_aref] );
	foreach my $section (@$sections_aref)
	{
		my @section_vars = $this->get_raw_array($section) ;
$this->_dbg_prt( ["Section vars", \@section_vars] );

		foreach my $href (@section_vars)
		{
			print $fh "\n[$section]\n" ;
			$this->_write_vars($fh, $href) ;
		}
	}
	close $fh ;
}

#----------------------------------------------------------------------------
#
#=item B< _write_vars($fh, $href) >
#
#Write the config file variables - skipping arrays. 
#
#=cut
#
sub _write_vars
{
	my $this = shift ;
	my ($fh, $href) = @_ ;
	
$this->_dbg_prt( ["_write_vars()", $href] );


	foreach my $var (sort {$href->{$a}{'index'} <=> $href->{$b}{'index'}} keys %$href)
	{
		my $description = $href->{$var}{description} || '' ;
		my $summary = $href->{$var}{summary} || '' ;
		
		# see if we use the short form
		if ((!"$description$summary") && ($href->{$var}{type} eq 's'))
		{
			## shortest form
			print $fh "$var=$href->{$var}{value}\n" ;
		}
		elsif (($description =~ /^$summary/) && ($href->{$var}{type} eq 's'))
		{