view release on metacpan or  search on metacpan

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

print " + check for expansion...\n" if $class_debug>=2;
			foreach my $val (@vals)
			{
				next unless $val ;

print " + + val=$val\n" if $class_debug>=2;

				if (index($val, '$') >= 0)
				{
print " + + + needs expanding\n" if $class_debug>=2;
					$to_expand{$key}++ ;
					${$_state_href->{$key}} = 'to_expand' ;
					last ;
				}
			}
		}
	}

$class->prt_data("to expand=", \%to_expand) if $class_debug;

$class->prt_data("Hash=", $hash_ref) if $class_debug;

	## Expand them
	foreach my $key (keys %to_expand)
	{
	print " # Key=$key State=${$_state_href->{$key}}\n" if $class_debug;
	
		# skip if not valid (if called recursively with a variable that is not in the hash)
		next unless exists($hash_ref->{$key}) ;

		# Do replacement iff required
		next if ${$_state_href->{$key}} eq 'expanded' ;

		my @vals ;
		if (ref($hash_ref->{$key}) eq 'ARRAY')
		{
			foreach my $val (@{$hash_ref->{$key}})
			{
				push @vals, \$val ;
			}
		}
		elsif (!ref($hash_ref->{$key}))
		{
			push @vals, \$hash_ref->{$key} ;
		}
		
		# mark as expanding
		${$_state_href->{$key}} = 'expanding' ;		

$class->prt_data("Vals to expand=", \@vals) if $class_debug;

#use re 'debugcolor' ;

		foreach my $val_ref (@vals)
		{

	print " # Expand \"$$val_ref\" ...\n" if $class_debug;

			$$val_ref =~ s{
							(?:
								[\\\$]\$					# escaped dollar
							     \{{0,1}					# optional brace
							    (\w+)                       # find a "word" and store it in $1
							     \}{0,1}					# optional brace
						    )
							|
							(?:
							     \$                         # find a literal dollar sign
							     \{{0,1}					# optional brace
							    (\w+)                       # find a "word" and store it in $1
							     \}{0,1}					# optional brace
						     )
						}{
							my $prefix = '' ;
							my ($escaped, $var) = ($1, $2) ;
	
							$escaped ||= '' ;
							$var ||= '' ;
							
	print " # esc=\"$escaped\", prefix=\"$prefix\", var=\"$var\"\n" if $class_debug;
							
							my $replace='' ;
							if ($escaped)
							{
								$prefix = '$' ;
								$replace = $escaped ;
	print " ## escaped prefix=$prefix replace=$replace\n" if $class_debug;
	print " ## DONE\n" if $class_debug;
							}
							else
							{		
								## use current HASH values before vars				
							    if (defined $hash_ref->{$var}) 
							    {
print " ## var=$var current state=${$_state_href->{$var}}\n" if $class_debug;
							    	if (${$_state_href->{$var}} eq 'to_expand')
							    	{
print " ## var=$var call expand..\n" if $class_debug;
							    		# go expand it first
							   			$class->expand_keys($hash_ref, $vars_aref, $_state_href, {$var => 1}) ; 		
							    	}
							    	if (${$_state_href->{$var}} eq 'expanded')
							    	{
print " ## var=$var already expanded\n" if $class_debug;
								        $replace = $hash_ref->{$var};            # expand variable
							    		$replace = join("\n", @{$hash_ref->{$var}}) if (ref($hash_ref->{$var}) eq 'ARRAY') ;
							    	}
							    }
print " ## var=$var  can replace from hash=$replace\n" if $class_debug;
	
								## If not found, use vars
								if (!$replace)
								{
									## use vars 
									foreach my $href (@$vars_aref)
									{
									    if (defined $href->{$var}) 
									    {
									        $replace = $href->{$var};            # expand variable
								    		$replace = join("\n", @{$hash_ref->{$var}}) if (ref($href->{$var}) eq 'ARRAY') ;
		print " ## found var=$var replace=$replace\n" if $class_debug;
									        last ;
									    }
									}					    
								}
print " ## var=$var  can replace now=$replace\n" if $class_debug;

								if (!$replace)
								{
									$replace = "" ;
	print " ## no replacement\n" if $class_debug;
	print " ## DONE\n" if $class_debug;
								}
							}
													
	print " ## ALL DONE $key: $escaped$var = \"$prefix$replace\"\n\n" if $class_debug;
							"$prefix$replace" ;
						}egxm;	## NOTE: /m is for multiline anchors; /s is for multiline dots
		}

$class->prt_data("Hash now=", $hash_ref) if $class_debug>=2;

		# mark as expanded
		${$_state_href->{$key}} = 'expanded' ;		

$class->prt_data("State now=", $_state_href) if $class_debug>=2;
	}
}



##============================================================================================
#
#=back
#
#=head2 OBJECT DATA METHODS
#
#=over 4
#
#=cut
#
##============================================================================================


##============================================================================================
#
#=back
#
#=head2 OBJECT METHODS
#
#=over 4
#
#=cut
#
##============================================================================================


#============================================================================================
#
# PRIVATE
#
#============================================================================================

# ============================================================================================
# END OF PACKAGE

=back

=head1 DIAGNOSTICS

Setting the debug flag to level 1 prints out (to STDOUT) some debug messages, setting it to level 2 prints out more verbose messages.

=head1 AUTHOR

Steve Price C<< <sdprice at cpan.org> >>