view release on metacpan or  search on metacpan

lib/App/Framework/Core.pm  view on Meta::CPAN

	'feature_list'		=> [],	# all registered feature names, sorted by priority
	'_feature_list'		=> {},	# all registered features
	'_feature_methods'	=> {},	# HASH or ARRAYs of any methods registered to a feature
	
	'_required_features'	=> [qw/Data Options Args Pod/],

	'personality'		=> undef,
	'extensions'		=> [],
) ;

# Set of default options
my @BASE_OPTIONS = (
	['debug=i',			'Set debug level', 	'Set the debug level value', ],
) ;

our %LOADED_MODULES ;

our $class_debug = 0 ;


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

=back

=head2 CONSTRUCTOR METHODS

=over 4

=cut

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

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

Create a new App::Framework::Core.

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 ;

	## stop 'app' entry from being displayed in Features 
	App::Framework::Base::Object::DumpObj::exclude('app') ;
	
print "App::Framework::Core->new() class=$class\n" if $class_debug ;
	
	my $caller_info_aref = delete $args{'_caller_info'} || croak "$class must be called via App::Framework" ;

	# Create object
	my $this = $class->SUPER::new(%args) ;
	
	# Set up error handler
	$this->set('catch_fn' => sub {$this->catch_error(@_);} ) ;

	## Get caller information
	my ($package, $filename, $line, $subr, $has_args, $wantarray) = @$caller_info_aref ;
	$this->set(
		'package'	=> $package,
		'filename'	=> $filename,
	) ;

	## now import packages into the caller's namespace
	$this->_import() ;


	## Set program info
	$this->set_paths($filename) ;
	
	## set up functions
#	foreach my $fn (qw/app_start app app_end usage/)
	foreach my $fn_aref (
		# prefered
		['app_start',	'app_start'],
		['app',			'app'],
		['app_end',		'app_end'],
		['usage',		'usage'],

		# alternates
		['app_begin',	'app_start'],
		['app_enter',	'app_start'],
		['app_init',	'app_start'],
		['app_finish',	'app_end'],
		['app_exit',	'app_end'],
		['app_term',	'app_end'],
	)
	{
		my ($fn, $alias) = @$fn_aref ;
		
		# Only add function if it's not already been specified
		$this->_register_fn($fn, $alias) ;
	}

	## Get version
	$this->_register_scalar('VERSION', 'version') ;

	## Ensure name set
	if (!$this->name())
	{
		$this->name($this->progname() ) ;		
	}


	## Set up default timezone
	if (exists($LOADED_MODULES{'Date::Manip'}))
	{
		my $tz = $App::Frameowrk::Settings::DATE_TZ || 'GMT' ;
		my $fmt = $App::Frameowrk::Settings::DATE_FORMAT || 'non-US' ;
		eval {
			my $date = new Date::Manip::Date;
			$date->config("setdate", "zone,$tz") ;
			
			#&Date_Init("TZ=$tz", "DateFormat=$fmt") ;
		} ;
	}

	## Install required features
	$this->install_features($this->_required_features) ;
	
	## Need to do some init of required features
	$this->feature('Options')->append_options(\@BASE_OPTIONS) ;

print "App::Framework::Core->new() - END\n" if $class_debug ;

	return($this) ;
}



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

=back

=head2 CLASS METHODS

=over 4

=cut

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

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

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

Initialises the App::Framework::Core 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) ;

}

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

=item B<allowed_class_instance()>

Class instance object is not allowed
 
=cut

sub allowed_class_instance
{
	return 0 ;
}

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

=item B<dynamic_load($module [, $pkg])>

Attempt to load the module into the specified package I<$pkg> (or load it into a temporary space).

Then checks that the load was ok by checking the module's version number.

Returns 1 on success; 0 on failure.
 
=cut

sub dynamic_load
{
	my $class = shift ;
	my ($module, $pkg) = @_ ;

	my $loaded = 0 ;
	
	# for windoze....
	if ($^O =~ /MSWin32/i)
	{
		return 0 unless $class->find_lib($module) ;
	}
	
	$pkg ||= 'temp_app_pkg' ;
	
print "dynamic_load($module) into $pkg\n" if $class_debug ;	

	my $version ;
	eval "
		package $pkg; 
		use $module; 
		\$version = \$${module}::VERSION ;
	" ;
#print "Version = $version\n" ;	
	if ($@)
	{
print "dynamic_load($module, $pkg) : error : $@\nAborting dynamic_load.\n" if $class_debug ;
	}
	elsif (defined($version))
	{
		$loaded = 1 ;
	}