view release on metacpan or  search on metacpan

Wyrd/Interfaces/Setter.pm  view on Meta::CPAN

	$hash = {} unless (ref($hash) eq 'HASH');
	#first do conditionals
	$temp = $self->_regexp_conditionals($hash, $temp);
	#then do quotations, altering a copy, not the original
	my %hash = %$hash;
	foreach my $i (keys(%hash)) {
		$hash{$i}=Apache::Util::escape_html($hash{$i});
	}
	#then do replacements
	foreach my $i (sort {length($b) <=> length($a)} keys(%hash)) {
		next unless ($i);#this is to prevent strange tied hashes from creating iloops
		$self->_verbose("temp is $temp, i is $i and hash is $$hash{$i}");
		$temp =~ s/\$:$i/$hash{$i}/gi;
	}
	return $temp;
}

=pod

=item (scalar) C<_cgi_escape_set>  ([scalar])

same as C<_escape_set>, but with the CGI environment option forced and
no interpreted hash option.

=cut

sub _cgi_escape_set {
	my ($self, $temp) = @_;
	#if a target ($temp) is provided, use it instead of the data
	$temp = $self->{'_data'} unless ($temp);
	#first get a clean hash -- no point in doing conditionals if undef is changed to NULL
	my $hash = $self->_cgi_hash($temp);
	#then do conditionals
	$temp = $self->_regexp_conditionals($hash, $temp);
	#then do quotations
	$hash = $self->_cgi_hash($temp, 'escaped');
	#then do replacements
	$temp = $self->_setter_replacements($hash, $temp);
	return $temp;
}

=pod

=item (scalar) C<_regexp_conditionals> (hashref, scalar)

internal method for performing conditional interpretation.

=cut

sub _regexp_conditionals {
	my ($self, $hash, $string) = @_;
	my $changed = 0; #toggle: if there is nothing left to change, it's time to return
	my $mode = 's'; #(s)eek a conditional (c)onfirm that it is a conditional, com(p)lete the expression
	my $state = '?'; #keep the argument or discard it
	my $buf = ''; #buffer for temp storage of the conditional
	my $out = ''; #buffer for the completed expression
	my $depth = 0; #how many layers of conditionals are we at?
	do {
		$changed = 0;
		foreach my $char (unpack('U*', $string)) {
			$char = chr($char);#returns unicode
			if ($mode eq 's') {#always begin by seeking
				if ($char eq '?' or $char eq '!') {
					$buf = '';
					$buf .= $char;
					$mode = 'c';
					$state = $char;
				} else {
					$out .= $char;
				}
			}
			elsif ($mode eq 'c') {
				if ((length($buf) > 3) and ($buf !~ /^[?!]:[_a-zA-Z][_a-zA-Z0-9]+$/)) {
					#not a valid identifier, move on...
					$out .= $buf . $char;
					$mode = 's';
				}
				if ($char eq '{') {
					my $identifier = substr($buf, 2);
					if (exists($$hash{$identifier})) {
						if (not(defined($$hash{$identifier}))) {
							$state =~ tr/?!/!?/;
						}
						$buf = '';
						$mode = 'p';
						$depth = 1;
						$changed = 1;
					} else {
						$out .= $buf . $char;
						$mode = 's';
					}
				} else {
					$buf .= $char;
				}
			}
			elsif ($mode eq 'p') {
				if($char eq '}') {
					$depth--
				}
				if($char eq '{') {
					$depth++
				}
				if ($depth == 0) {
					if ($state eq '?') {
						$out .= $self->_regexp_conditionals($hash, $buf);
					}
					$mode = 's';
				} else {
					$buf .= $char;
				}
			}
		}
		if ($mode eq 'p') {
			$self->_error('Malformed conditional in Setter:_[xxx_]set(). Aborting conditional expression evaluation.');
			return $string;
		}
		$string = $out;
		$out = '';
	} while ($changed);
	return $string;
}