view release on metacpan or  search on metacpan

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

=head2 FIELDS

The following fields should be defined either in the call to 'new()', as part of a 'set()' call, or called by their accessor method
(which is the same name as the field):


=over 4

=item B<requires> - list of required modules

ARRAY ref of a list of module names that are required to be loaded by this object.

=item B<loaded> - list of which modules have been loaded

HASH containing the modules loaded (used as key), with the value set to 1 if the module loaded ok; 0 otherwise

=item B<requires_ok> - all required modules are ok

Flag that is set if all required modules loaded correctly

=back

=cut

my %FIELDS = (
	'priority'		=> $PRIORITY_DEFAULT,
	'requires'		=> [],
	
	'loaded'		=> {},		# list of which modules have been loaded
	'requires_ok'	=> 0,		# all required modules are ok
);

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

=head2 CONSTRUCTOR

=over 4

=cut

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

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

Create a new feature.

The %args are specified as they would be in the B<set> method.

=cut

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

	my $class = ref($obj) || $obj ;

print "App::Framework::Base->new() class=$class\n" if $class_debug ;

	# Create object
	my $this = $class->SUPER::new(%args) ;

	## Check for any required modules
	my $ok = 1 ;
	my %loaded ;
	foreach my $module (@{$this->requires})
	{
		eval "package $class; use $module;" ;
		if ($@)
		{
			$loaded{$module} = 0 ;
			$ok = 0 ;
		}
		else
		{
			$loaded{$module} = 1 ;
		}
	}
	$this->requires_ok($ok) ;
	$this->loaded(\%loaded) ;

	## First check that all required modules loaded correcly
	if (!$this->requires_ok)
	{
		my $loaded_href = $class->loaded ;
		my $failed_modules = join ', ', grep {$loaded_href->{$_}} keys %$loaded_href ;
		$this->throw_fatal("Failed to load: $failed_modules") ;	
	}

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

	return($this) ;
}



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

=back

=head2 CLASS METHODS

=over 4

=cut

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

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

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

Initialises the 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<expand_keys($hash_ref, $vars_aref)>

Processes all of the HASH values, replacing any variables with their contents. The variable
values are taken from the ARRAY ref I<$vars_aref>, which is an array of hashes. Each hash
containing variable name / variable value pairs.

The HASH values being expanded can be either scalar, or an ARRAY ref. In the case of the ARRAY ref each
ARRAY entry must be a scalar (e.g. an array of file lines).

=cut

sub expand_keys
{
	my $class = shift ;
	my ($hash_ref, $vars_aref, $_state_href, $_to_expand) = @_ ;

print "expand_keys($hash_ref, $vars_aref)\n" if $class_debug;
$class->prt_data("vars=", $vars_aref, "hash=", $hash_ref) if $class_debug ;

	my %to_expand = $_to_expand ? (%$_to_expand) : (%$hash_ref) ;
	if (!$_state_href)
	{
		## Top-level
		my %data_ref ;
		
		# create state HASH
		$_state_href = {} ;
		
		# scan through hash looking for variables
		%to_expand = () ;
		foreach my $key (keys %$hash_ref)
		{
			my @vals ;
			if (ref($hash_ref->{$key}) eq 'ARRAY')
			{
				@vals = @{$hash_ref->{$key}} ;
			}
			elsif (!ref($hash_ref->{$key}))
			{
				push @vals, $hash_ref->{$key} ;
			}
			
			## Set up state - provide a level of indirection so that we can handle the case where multiple keys point to the same data
			my $ref = $hash_ref->{$key} || '' ;
			if ($ref && exists($data_ref{"$ref"}))
			{
print " + already seen data for key=$key\n" if $class_debug>=2;
				# already got created a state for this data, point to it 
				$_state_href->{$key} = $data_ref{"$ref"} ;
			}
			else
			{
print " + new state key=$key\n" if $class_debug>=2;
				my $state = 'expanded' ;
				$_state_href->{$key} = \$state ;