view release on metacpan or  search on metacpan

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

=item (scalar) C<_quote_set> ([hashref], [scalar])

More SQL-ish, but not CGI-ish.  A blank hashref is used in place of the
CGI environment when passed no parameters.  Placemarkers are replaced
with the quote function of DBI via the Wyrd->dbl->quote function so as
to be used in SQL queries.

=cut

sub _quote_set {
	my ($self, $hash, $temp) = @_;
	#if a target ($temp) is provided, use it instead of the data
	$temp = $self->{'_data'} unless ($temp);
	$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}=$self->dbl->dbh->quote($hash{$i});
		$hash{$i}='NULL' if ($hash{$i} eq q(''));
	}
	#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;
}

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

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

=cut

sub _cgi_quote_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, 'quoted');
	#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<_escape_set> ([hashref], [scalar])

More HTML-form-ish but not CGI-ish.  A blank hashref is used in place of
the CGI environment when passed no parameters.  Values are HTML escaped
so they can be used within <input type="text"> tags in HTML.

=cut

sub _escape_set {
	my ($self, $hash, $temp) = @_;
	#if a target ($temp) is provided, use it instead of the data
	$temp = $self->{'_data'} unless ($temp);
	$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') {

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

}

=pod

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

internal method for performing value replacements.

=cut

sub _setter_replacements {
	my ($self, $hash, $temp) = @_;
	foreach my $i (sort {length($b) <=> length($a)} keys(%$hash)) {
		#sorted so that the longest go first, avoiding problems where one variable (key) name is a
		#substring of another
		next unless ($i);#this is to prevent strange tied hashes from creating iloops
		$self->_verbose("temp is '$temp', i is '$i' and value is '$$hash{$i}'");
		$temp =~ s/\$:\Q$i\E/$$hash{$i}/gi;
	}
	return $temp;
}

=pod

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

internal method for setting default template to BASECLASS::_data and default
parameters to null hash.

=cut

sub _setter_defaults {
	my ($self, $hash, $temp) = @_;
	#if a target ($temp) is provided, use it instead of the data
	$temp ||= $self->{'_data'};
	$hash = $self->_cgi_hash($temp) unless (ref($hash) eq 'HASH');
	return $hash, $temp;
}

=pod

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

internal method for interpreting the CGI environment into the template
data hashref.

=cut

sub _cgi_hash {
	my ($self, $temp, $modifier) = @_;
	my $hash = {};
	my @params = ();
	unless ($temp) {
		#give up and use CGIs params
		@params = $self->dbl->param;
	} else {
		#guess at the params from the template
		@params = ($temp =~ m/[\$\?\!]\:([a-zA-Z_][a-zA-Z0-9_]+)/g);
	}
	foreach my $param (@params) {
		if ($modifier eq 'escaped') {
			$hash->{$param} = Apache::Util::escape_html(scalar($self->dbl->param($param)));
		} elsif ($modifier eq 'quoted') {
			#scalar is used because of some funny business in dbh -- worth investigating?
			$hash->{$param} = $self->dbl->dbh->quote(scalar($self->dbl->param($param)));
		} else {
			$hash->{$param} = $self->dbl->param($param);
		}
		$self->_verbose("$param = $$hash{$param}");
	}
	$self->_debug("Found params ->" . join ', ', @params);
	return $hash
}

=pod

=item (scalar) C<_attribute_template> (array)

Shortcut method for quickly creating templates of all attributes in a
wyrd, given an array of attribute names.

=cut

sub _attribute_template {
	my ($self, @attributes) = @_;
	my $string = join ('', map {qq(\?\:$_\{ $_="\$\:$_\"})} @attributes);
	return $string;
}

=pod

=item (scalar) C<_template_hash> (string, [hashref])

Shortcut method for quickly creating a hash from a template.  If the
template is not provided, the object's _data attribute is used.  If a
hashref is supplied as the second value, values for the returned hashref are
based on that. Otherwise, the calling object itself provides the values.  By
default, template items that are not defined by the attributes of the object
or provided hashref are ignored.

=cut

sub _template_hash {
	my ($self, $template, $hash) = @_;
	$template ||= $self->{'_data'};
	$hash ||= $self;
	my @keys = $template =~ /[\$\!\?]:([_a-zA-Z][_a-zA-Z0-9]+)/g;
	my %out_hash = ();
	foreach my $key (@keys) {
		if (eval{exists($hash->{$key})}) {
			$out_hash{$key} = $hash->{$key};
		}
	}
	return \%out_hash;
}

=pod

=back

=head1 BUGS/CAVEATS/RESERVED METHODS

=head2 Interpolation Bug

"$:" is a variable in perl, so be sure to escape or single-quote your
in-code templates.  If you start seeing B<-variablename> in your pages,
you'll know why.

=head2 Defined Null Conditional Bug

There's some un-perlish behavior in the setting of conditionals.  Conditional
statements are set (?) or unset (!) depending on whether the item is defined,
not whether it is true.  An eq operator, for example, returns '' (the null
string) when the arguments are not equivalent strings, so a template with a
conditional that should be false, and therefore unset, is actually considered
true, since the result is defined and exists.  For example

    $result = $self->_set({'a' => 'a' eq 'b'}, '?:a{wrong}');

returns "wrong", not ''.  To prevent this, it should be written:

    $result = $self->_set({'a' => ('a' eq 'b') || undef}, '?:a{wrong}');

=head1 AUTHOR

Barry King E<lt>wyrd@nospam.wyrdwright.comE<gt>

=head1 SEE ALSO

=over

=item Apache::Wyrd

General-purpose HTML-embeddable perl object

=back

=head1 LICENSE

Copyright 2002-2007 Wyrdwright, Inc. and licensed under the GNU GPL.

See LICENSE under the documentation for C<Apache::Wyrd>.

=cut

1;