view release on metacpan or  search on metacpan

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

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

print " + + val=$val\n" if $this->{debug}>=2;

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

$this->prt_data("to expand=", \%to_expand) if $this->{debug};

$this->prt_data("Hash=", $hash_ref) if $this->{debug};

	## Expand them
	foreach my $key (keys %to_expand)
	{
	print " # Key=$key State=${$_state_href->{$key}}\n" if $this->{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' ;		

$this->prt_data("Vals to expand=", \@vals) if $this->{debug};

#use re 'debugcolor' ;

		foreach my $val_ref (@vals)
		{

	print " # Expand \"$$val_ref\" ...\n" if $this->{debug};

			$$val_ref =~ s{
							(?:
								[\\\$]\$					# escaped dollar
							     \{{0,1}					# optional brace
							    ([\w\-\d]+)                 # find a "word" and store it in $1
							     \}{0,1}					# optional brace
						    )
							|
							(?:
							     \$                         # find a literal dollar sign
							     \{{0,1}					# optional brace
							    ([\w\-\d]+)                 # 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 $this->{debug};
							
							my $replace='' ;
							if ($escaped)
							{
								$prefix = '$' ;
								$replace = $escaped ;
	print " ## escaped prefix=$prefix replace=$replace\n" if $this->{debug};
	print " ## DONE\n" if $this->{debug};
							}
							else
							{		
								## use current HASH values before vars				
							    if (defined $hash_ref->{$var}) 
							    {
print " ## var=$var current state=${$_state_href->{$var}}\n" if $this->{debug};
							    	if (${$_state_href->{$var}} eq 'to_expand')
							    	{
print " ## var=$var call expand..\n" if $this->{debug};
							    		# go expand it first
							   			$this->expand_keys($hash_ref, $vars_aref, $_state_href, {$var => 1}) ; 		
							    	}
							    	if (${$_state_href->{$var}} eq 'expanded')
							    	{
print " ## var=$var already expanded\n" if $this->{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 $this->{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 $this->{debug};
									        last ;
									    }
									}					    
								}
print " ## var=$var  can replace now=$replace\n" if $this->{debug};

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

$this->prt_data("Hash now=", $hash_ref) if $this->{debug}>=2;

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

$this->prt_data("State now=", $_state_href) if $this->{debug}>=2;
	}
}

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

=item B<throw_fatal($message)>

Output error message then exit

=cut

sub throw_fatal
{
	my $this = shift ;
	my ($message, $errorcode) = @_ ;

	print "Fatal Error: $message\n" ;
	$this->exit( $errorcode || 1 ) ;
}

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

=item B<throw_nonfatal($message, [$errorcode])>

Add a new error (type=nonfatal) to this object instance, also adds the error to this Class list
keeping track of all runtime errors

=cut

sub throw_nonfatal
{
	my $this = shift ;
	my ($message, $errorcode) = @_ ;
	
	print "Non-Fatal Error: $message\n" ;
	return ($errorcode || 0) ;
}

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

=item B<throw_warning($message, [$errorcode])>

Add a new error (type=warning) to this object instance, also adds the error to this Class list
keeping track of all runtime errors

=cut

sub throw_warning
{
	my $this = shift ;