File Coverage

blib/lib/Tenjin/Util.pm

Criterion	Covered	Total	%
statement	18	68	26.4
branch	0	16	0.0
condition	0	2	0.0
subroutine	8	20	40.0
pod	13	13	100.0
total	39	119	32.7

package Tenjin::Util;

use strict;
use warnings;
use HTML::Entities;

our $VERSION = "0.070001";
$VERSION = eval $VERSION;

=head1 NAME

Tenjin::Util - Utility methods for Tenjin.

=head1 VERSION

version 0.070001

=head1 SYNOPSIS

	# in your templates:

	# encode a URL
	[== encode_url('http://www.google.com/search?q=tenjin&ie=utf-8&oe=utf-8&aq=t') =]
	# returns http%3A//www.google.com/search%3Fq%3Dtenjin%26ie%3Dutf-8%26oe%3Dutf-8%26aq%3Dt

	# escape a string of lines of HTML code
	You & Me\nMe & You'; ?>
	[== text2html($string) =]
	# returns <h1>You & Me</h1>\n<h2>Me & You</h2>

=head1 DESCRIPTION

This module provides a few utility functions which can be used in your
templates for your convenience. These include functions to (un)escape
and (en/de)code URLs.

=head1 METHODS

=head2 expand_tabs( $str, [$tabwidth] )

Receives a string that might contain tabs in it, and replaces those
tabs with spaces, each tab with the number of spaces defined by C<$tabwidth>,
or, if C<$tabwidth> was not passed, with 8 spaces.

=cut

sub expand_tabs {
	my ($str, $tabwidth) = @_;

	$tabwidth ||= 8;
	my $s = '';
	my $pos = 0;
	while ($str =~ /.*?\t/sg) { # /(.*?)\t/ may be slow
		my $end = $+[0];
		my $text = substr($str, $pos, $end - 1 - $pos);
		my $n = rindex($text, "\n");
		my $col = $n >= 0 ? length($text) - $n - 1 : length($text);
		$s .= $text;
		$s .= ' ' x ($tabwidth - $col % $tabwidth);
		$pos = $end;
	}
	my $rest = substr($str, $pos);
	return $s;
}

=head2 escape_xml( $str )

Receives a string of XML (or (x)HTML) code and converts the characters
<>&\' to HTML entities. This is the method that is invoked when you use
[= $expression =] in your templates.

=cut

sub escape_xml {
	encode_entities($_[0], '<>&"\'');
}

=head2 unescape_xml( $str )

Receives a string of escaped XML (or (x)HTML) code (for example, a string
that was escaped with the L function,
and 'unescapes' all HTML entities back to their actual characters.

=cut

sub unescape_xml {
	decode_entities($_[0]);
}

=head2 encode_url( $url )

Receives a URL and encodes it by escaping 'non-standard' characters.

=cut

sub encode_url {
	my $url = shift;

	$url =~ s/([^-A-Za-z0-9_.\/])/sprintf("%%%02X", ord($1))/sge;
	$url =~ tr/ /+/;
	return $url;
}

=head2 decode_url( $url )

Does the opposite of L.

=cut

sub decode_url {
	my $url = shift;

	$url =~ s/\%([a-fA-F0-9][a-fA-F0-9])/pack('C', hex($1))/sge;
	return $url;
}

=head2 checked( $val )

Receives a value of some sort, and if it is a true value, returns the string
' checked="checked"' which can be appended to HTML checkboxes.

=cut

sub checked {
	$_[0] ? ' checked="checked"' : '';
}

=head2 selected( $val )

Receives a value of some sort, and if it is a true value, returns the string
' selected="selected"' which can be used in an option in an HTML select box.

=cut

sub selected {
	$_[0] ? ' selected="selected"' : '';
}

=head2 disabled( $val )

Receives a value of some sort, and if it is a true value, returns the string
' disabled="disabled"' which can be used in an HTML input.

=cut

sub disabled {
	$_[0] ? ' disabled="disabled"' : '';
}

=head2 nl2br( $text )

Receives a string of text containing lines delimited by newline characters
(\n, or possibly \r\n) and appends an HTML line break () to every
line (the newline character is left untouched).

=cut

sub nl2br {
	my $text = shift;

	$text =~ s/(\r?\n)/$1/g;
	return $text;
}

=head2 text2html( $text )

Receives a string of text containing lines delimited by newline characters,
and possibly some XML (or (x)HTML) code, escapes that code with
L and then appends an HTML line break
to every line with L.

=cut

sub text2html {
	nl2br(escape_xml($_[0]));
}

=head2 tagattr( $name, $expr, [$value] )

=cut

sub tagattr {
	my ($name, $expr, $value) = @_;

	return '' unless $expr;
	$value = $expr unless defined $value;
	return " $name=\"$value\"";
}

=head2 tagattrs( %attrs )

=cut

sub tagattrs {
	my (%attrs) = @_;

	my $s = '';
	while (my ($k, $v) = each %attrs) {
		$s .= " $k=\"".escape_xml($v)."\"" if defined $v;
	}
	return $s;
}

=head2 new_cycle( @items )

Creates a subroutine reference that can be used for cycling through the
items of the C<@items> array. So, for example, you can:

	my $cycle = new_cycle(qw/red green blue/);
	print $cycle->(); # prints 'red'
	print $cycle->(); # prints 'green'
	print $cycle->(); # prints 'blue'
	print $cycle->(); # prints 'red' again

=cut

sub new_cycle {
	my $i = 0;
	sub { $_[$i++ % scalar @_] };  # returns
}

=head1 INTERNAL(?) METHODS

=head2 _p( $expression )

Wraps a Perl expression in a customized wrapper which will be processed
by the Tenjin preprocessor and replaced with the standard [== $expression =].

=cut

sub _p {
	"<`\#$_[0]\#`>";
}

=head2 _P( $expression )

Wrap a Perl expression in a customized wrapper which will be processed
by the Tenjin preprocessor and replaced with the standard [= $expression =],
which means the expression will be escaped.

=cut

sub _P {
	"<`\$$_[0]\$`>";
}

=head2 _decode_params( $s )

=cut

sub _decode_params {
	my $s = shift;

	return '' unless $s;

	$s =~ s/%3C%60%23(.*?)%23%60%3E/'[=='.decode_url($1).'=]'/ge;
	$s =~ s/%3C%60%24(.*?)%24%60%3E/'[='.decode_url($1).'=]'/ge;
	$s =~ s/<`\#(.*?)\#`>/'[=='.unescape_xml($1).'=]'/ge;
	$s =~ s/<`\$(.*?)\$`>/'[='.unescape_xml($1).'=]'/ge;
	$s =~ s/<`\#(.*?)\#`>/[==$1=]/g;
	$s =~ s/<`\$(.*?)\$`>/[=$1=]/g;

	return $s;
}

1;

=head1 SEE ALSO

L, L, L.

=head1 AUTHOR

The CPAN version of Tenjin was forked by Ido Perlmuter Eido at ido50.netE
from version 0.0.2 of the original plTenjin, which is developed by Makoto Kuwata
at L.

Development of Tenjin is done with github at L.

=head1 LICENSE AND COPYRIGHT

Tenjin is licensed under the MIT license.

	Copyright (c) 2007-2010 the aforementioned authors.

	Permission is hereby granted, free of charge, to any person obtaining
	a copy of this software and associated documentation files (the
	"Software"), to deal in the Software without restriction, including
	without limitation the rights to use, copy, modify, merge, publish,
	distribute, sublicense, and/or sell copies of the Software, and to
	permit persons to whom the Software is furnished to do so, subject to
	the following conditions:

	The above copyright notice and this permission notice shall be
	included in all copies or substantial portions of the Software.

	THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
	EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
	MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
	NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
	LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
	OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
	WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

=cut