view release on metacpan or  search on metacpan

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

my $OPT_CFGPATH_AREF = 
	["$OPT_CFGPATH=s",		'Config file path', 		'Comma/semicolon separated list of search paths for the config file', ] ;
my $OPT_CFGWRPATH_AREF = 
	["$OPT_CFGWRPATH=s",	'Config file write path', 	'Comma/semicolon separated list of paths for writing the config file', ] ;
my $OPT_CFG_AREF = 
	["$OPT_CFG=s",			'Config file name', 		'Config filename'] ;
my $OPT_CFGWR_AREF = 
	["$OPT_CFGWR",			'Write config file', 		'When specified, writes the configuration file using the write path'] ;

# Set of default options
my @EXTRA_OPTIONS = (
	$OPT_CFGPATH_AREF,
	$OPT_CFGWRPATH_AREF,
	$OPT_CFG_AREF,
	$OPT_CFGWR_AREF,
) ;

my @CONFIG_OPTIONS = (
	$OPT_CFGPATH,
	$OPT_CFGWRPATH,
	$OPT_CFG,
	$OPT_CFGWR,
) ;

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

=head2 CONSTRUCTOR

=over 4

=cut

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


=item B< new([%args]) >

Create a new Config object.

The %args are specified as they would be in the B<set> method, for example:

	'mmap_handler' => $mmap_handler

The full list of possible arguments are :

	'fields'	=> Either ARRAY list of valid field names, or HASH of field names with default values 

=cut

sub new
{
	my ($obj, %args) = @_ ;
	
	my $class = ref($obj) || $obj ;

	# create search path object
	my $search_obj = App::Framework::Base::SearchPath->new(%args) ;
	
	# Create object
	my $this = $class->SUPER::new(%args,
		'priority'		=> $App::Framework::Base::PRIORITY_SYSTEM + 15,		# needs to be after options, but before data
		'registered'	=> [qw/go_entry getopts_entry application_entry/],
		'_search_path'	=> $search_obj,
	) ;
	
	## Map the search path object's methods into this object
	foreach my $method (qw/path write_path read_filepath write_filepath/)
	{
		no warnings 'redefine';
		no strict 'refs';
		
		*{ __PACKAGE__."::${method}"} = sub {  
			my $this = shift ;
			$this->_dbg_prt( ["Config: calling searchpath->$method() ", \@_] ) ;			
			return $search_obj->$method(@_) ;
		};
	}
	
	## If associated with an app, then add the app's variables to the search path
	my $app = $this->app ;
	if ($app)
	{
		## only interested in scalar values
		my %vars = $app->vars() ;
		my %app_vars ;
		foreach my $var (keys %vars)
		{
			$app_vars{$var} = $vars{$var} if !ref($vars{$var}) || ref($vars{$var}) eq 'SCALAR' ;
		}
		$search_obj->env(\%app_vars) ;
	}

	return($this) ;
}



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

=back

=head2 CLASS METHODS

=over 4

=cut

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

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

=item B< init_class([%args]) >

Initialises the Config object class variables.

=cut

sub init_class
{
	my $class = shift ;
	my (%args) = @_ ;

	# Add extra fields
	$class->add_fields(\%FIELDS, \%args) ;

	# init class
	$class->SUPER::init_class(%args) ;

}

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

=back

=head2 OBJECT DATA METHODS

=over 4

=cut

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

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

=item B<set(%args)>

Overrides the parent 'set()' method to send the parameters off to the L<App::Framework::Base::SearchPath> object
as well as itself.

=cut

sub set
{
	my $this = shift ;
	my (%args) = @_ ;

	if (keys %args)
	{

$this->_dbg_prt( ["settings args = ", \%args] ) ;

		# send to search path obj (if created yet)
		my $search_obj = $this->_search_path ;
$this->_dbg_prt( ["settings args on search_obj\n"] ) if $search_obj ;
		$search_obj->set(%args) if $search_obj ;
				
		# handle the args
		$this->SUPER::set(%args) ;
	}

}

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

=back

=head2 OBJECT METHODS

=over 4

=cut

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


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

=item B< go_entry() >

Application hook: When application calls go() set up config options.

=cut

sub go_entry
{
	my $this = shift ;

$this->_dbg_prt( ["Config: go_entry()\n"] ) ;

	## must be under application to get here...
	my $app = $this->app ;

	my $home = $ENV{'HOME'} || $ENV{'USERPROFILE'} || "$ENV{'HOMEDRIVE'}$ENV{'HOMEPATH'}" ;
	my $app_name = $app->name ;
	my $app_path = $app->progpath ;
	
	my $app_dir = ".$app_name" ;
	my $sys = "/etc" ;
	if ($^O =~ /MSWin/)
	{
		$app_dir = "$app_name" ;
		$sys = "c:/" ;
	}
	
	## Set up write path, if not already set
	my $write_path = $this->write_path() ;
$this->_dbg_prt( ["current write path=$write_path\n"] ) ;
	unless ($write_path)
	{
$this->_dbg_prt( ["set default write path\n"] ) ;
		$this->write_path("$home/$app_dir;$sys/$app_name") ;
	}
	
	## Set up search path, if not already set
	my $path = $this->path() ;
$this->_dbg_prt( ["current path=$path\n"] ) ;
	unless ($path)
	{