File Coverage

blib/lib/Dotiac/DTL/Filter.pm

Criterion	Covered	Total	%
statement	706	803	87.9
branch	416	634	65.6
condition	100	240	41.6
subroutine	56	59	94.9
pod	55	55	100.0
total	1333	1791	74.4

###############################################################################
#Filter.pm
#Last Change: 2009-01-19
#Copyright (c) 2009 Marc-Seabstian "Maluku" Lucksch
#Version 0.8
####################
#This file is part of the Dotiac::DTL project.
#http://search.cpan.org/perldoc?Dotiac::DTL
#
#Filter.pm is published under the terms of the MIT license, which basically
#means "Do with it whatever you want". For more information, see the
#license.txt file that should be enclosed with libsofu distributions. A copy of
#the license is (at the time of writing) also available at
#http://www.opensource.org/licenses/mit-license.php .
###############################################################################

package Dotiac::DTL::Filter;
use strict;
use warnings;
require Scalar::Util;
our $VERSION = 0.8;

sub add {
	my $value=shift;
	my $add=shift;
	$value->set($value->repr+$add->repr) if $value->number and $add->number;
	$value->set($value->repr.$add->repr) unless $value->number and $add->number;
	return $value;

}

sub addslashes {
	my $value =shift;
	my $val=$value->repr();
	$val=~s/([\\'"])/\\$1/g;
	$value->set($val);
	return $value;
}

sub capfirst {
	my $value=shift;
	return $value->set(ucfirst $value->repr);
}

sub center {
	my $value=shift;
	my $length=shift;
	return $value unless $length->number;
	my $padding = shift;
	my $pad=" ";
	$pad=substr($padding->repr,0,1) if $padding;
	my $val=$value->repr;
	my $len=$length->repr;
	$len-=CORE::length $val;
	$val=($pad x int($len/2)).$val.($pad x int($len/2)).($len%2?$pad:"");
	$value->set($val);
	return $value;
}

sub cut {
	my $value=shift;
	my $val=$value->repr();
	my $t=shift;
	$t=$t->repr();
	$val=~s/\Q$t//g;
	$value->set($val);
	return $value;
}

#locale stuff
our @datemonths=qw( Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec );
our @datemonthl=qw( January February March April May Juni Juli August September October November December );
our @datemontha=qw( Jan. Feb. March April May Juni Juli Aug. Sep. Oct. Nov. Dec. );
our @weekdays=qw/Sun Mon Tue Wed Thu Fri Sat/;
our @weekdayl=qw/Sunday Monday Tuesday Wednesday Thursday Friday Saturday/;
our @timeampm=qw/a.m. p.m. AM PM/;
our @timespotnames=qw/midnight noon/;
our @datesuffixes=qw/th st nd rd/; #qw/Default day1 day2 day3 day4 day5...

sub date {
	my $value=shift;
	return $value unless $value->number() or $value->array();
	my $time=$value->repr();
	my $safe=0;
	my $string=shift;
	if (not defined $string or not $string->scalar()) {
		$string=$Dotiac::DTL::DATE_FORMAT;
		$safe=1;
	}
	else {
		$safe=$string->safe();
		$string=$string->repr;
	}
	my @t;
	if ($value->number()) {
		@t=localtime($time);
	}
	else {
		@t=@{$value->content};
	}
	my @s=split //,$string;
	my $res;
	while (my $s=shift(@s)) {
		if ($s eq '\\') {
			$res.=shift(@s);
		}
		elsif ($s eq "a") {
			if ($t[2] > 12 or ($t[2] == 12 and $t[1] > 0)) {
				$res.=$timeampm[0];
			}
			else {
				$res.=$timeampm[1];
			}
		}
		elsif ($s eq "A") {
			if ($t[2] > 12 or ($t[2] == 12 and $t[1] > 0)) {
				$res.=$timeampm[2];
			}
			else {
				$res.=$timeampm[3];
			}
		}
		elsif ($s eq "b") {
			$res.=lc($datemonths[$t[4]]);
		}
		elsif ($s eq "d") {
			$res.=sprintf("%02d",$t[3]);
		}
		elsif ($s eq "D") {
			$res.=$weekdays[$t[6]];
		}
		elsif ($s eq "f") {
			my $h=$t[2];
			$h=$h%12;
			$h=12 unless $h;
			$res.=$h;
			$res.=sprintf(":%02d",$t[1]) if ($t[1]);
		}
		elsif ($s eq "F") {
			$res.=$datemonthl[$t[4]];
		}
		elsif ($s eq "g") {
			my $h=$t[2];
			$h=$h%12;
			$h=12 unless $h;
			$res.=$h;
		}
		elsif ($s eq "G") {
			$res.=$t[2];
		}
		elsif ($s eq "h") {
			my $h=$t[2];
			$h=$h%12;
			$h=12 unless $h;
			$res.=sprintf("%02d",$h);
		}
		elsif ($s eq "H") {
			$res.=sprintf("%02d",$t[2]);
		}
		elsif ($s eq "i") {
			$res.=sprintf("%02d",$t[1]);
		}
		elsif ($s eq "j") {
			$res.=$t[3];
		}
		elsif ($s eq "l") {
			$res.=$weekdayl[$t[6]];
		}
		elsif ($s eq "L") {
			my $d=$t[5]+1900;
			$res.=(((not $d%4 and $d%100) or not $d%400)?"1":"0");
		}
		elsif ($s eq "m") {
			$res.=sprintf("%02d",$t[4]+1);
		}
		elsif ($s eq "M") {
			$res.=$datemonths[$t[4]];
		}
		elsif ($s eq "n") {
			$res.=$t[4]+1;
		}
		elsif ($s eq "N") {
			$res.=$datemontha[$t[4]];
		}
		elsif ($s eq "O") {
			my @tt=localtime(0);
			$tt[2]+=1 if $t[8];
			$res.=sprintf("%+05d",$tt[2]*100+$tt[1]);
		}
		elsif ($s eq "P") {
			if ($t[2] == 12 and $t[1] == 0) {
				$res.=$timespotnames[1];
			}
			elsif ($t[2] == 0 and $t[1] == 0) {
				$res.=$timespotnames[0];
			}
			else {
				my $h=$t[2];
				$h=$h%12;
				$h=12 unless $h;
				$res.=$h;
				$res.=sprintf(":%02d",$t[1]) if ($t[1]);
				if ($t[2] > 12 or ($t[2] == 12 and $t[1] > 0)) {
					$res.=" ".$timeampm[0];
				}
				else {
					$res.=" ".$timeampm[1];
				}
			}

		}
		elsif ($s eq "r") {
			$res.=$weekdays[$t[6]];
			$res.=", ";
			$res.=$t[4]+1;
			$res.=" ".$datemonths[$t[4]]." ".($t[5]+1900);
			$res.=sprintf(" %02d:%02d:%02d",$t[2],$t[1],$t[0]);
			my @tt=localtime(0);
			$tt[2]+=1 if $t[8];
			$res.=sprintf(" %+05d",$tt[2]*100+$tt[1]);
		}
		elsif ($s eq "s") {
			$res.=sprintf("%02d",$t[0]);
		}
		elsif ($s eq "S") {
			if ($datesuffixes[$t[3]]) {
				$res.=$datesuffixes[$t[3]];
			}
			else {
				$res.=$datesuffixes[0]
			}
		}
		elsif ($s eq "t") {
			if ($t[4] == 1 or $t[4]==3 or $t[4] == 5 or $t[4] == 7 or $t[4] == 8 or $t[4] == 10 or $t[4] == 12) {
				$res.="31";
			}
			elsif ($t[4] == 2) {
				my $d=$t[5]+1900;
				if ((not $d%4 and $d%100) or not $d%400) {
					$res.="29";
				}
				else {
					$res.="28";
				}
			}
			else {
				$res.="30";
			}
		}
		elsif ($s eq "T") {
			require POSIX;
			$res.=POSIX::strftime("%Z", @t);
		}
		elsif ($s eq "t") {
			$res.=$t[6];
		}
		elsif ($s eq "W") {
			require POSIX;
			$res.=POSIX::strftime("%W", @t);
		}
		elsif ($s eq "y") {
			$res.=sprintf("%02d",($t[5]%100));
		}
		elsif ($s eq "Y") {
			$res.=sprintf("%04d",$t[5]+1900);
		}
		elsif ($s eq "z") {
			$res.=$t[7];
		}
		elsif ($s eq "Z") {
			my @tt=localtime(0);
			$tt[2]+=1 if $t[8];
			$res.=$tt[2]*3600+$t[1]*60+$t[0];
		}
		elsif ($s eq "\n") {
			$res.="n";
		}
		elsif ($s eq "\t") {
			$res.="t";
		}
		elsif ($s eq "\f") {
			$res.="f";
		}
		elsif ($s eq "\b") {
			$res.="b";
		}
		elsif ($s eq "\r") {
			$res.="r";
		}
		else {
			$res.=$s;
		}
	}
	return Dotiac::DTL::Value->new($res,$safe);
}

sub default {
	my $val=shift;
	my $def=shift;
	return $def unless $val->true;
	return $val;
}

sub default_if_none {
	my $val=shift;
	my $def=shift;
	return $def unless $val->defined;
	return $val;
}

sub dictsort {
	my $value=shift;
	return $value unless $value->array();
	my $by=shift;
	unless ($by) {
		$value->set([sort { if (Scalar::Util::looks_like_number($a) and Scalar::Util::looks_like_number($b)) {
				$a <=> $b
			}
			else {
				$a cmp $b
			}
			} @{$value->content}]);
		return $value;
	}
	$by=$by->repr();
	$value->set([sort {
		my $aa = $a;
		if (ref $a) {
			$aa = $a->{$by} if Scalar::Util::reftype($a) eq "HASH" and exists $a->{$by};
			$aa = $a->[$by] if Scalar::Util::reftype($a) eq "ARRAY" and Scalar::Util::looks_like_number($by) and exists $a->[$by];
			$aa = $a->$by() if Scalar::Util::blessed($a) and $a->can($by);
		}
		my $bb = $b;
		if (ref $b) {
			$bb = $b->{$by} if Scalar::Util::reftype($b) eq "HASH" and $b->{$by};
			$bb = $b->[$by] if Scalar::Util::reftype($a) eq "ARRAY" and Scalar::Util::looks_like_number($by) and exists $b->[$by];
			$bb = $b->$by() if Scalar::Util::blessed($b) and $b->can($by);
		}
		if (Scalar::Util::looks_like_number($aa) and Scalar::Util::looks_like_number($bb)) {
			$aa <=> $bb
		}
		else {
			$aa cmp $bb
		}
	} @{$value->content}]);
	return $value;

}

sub dictsortreversed {
	my $value=shift;
	return $value unless $value->array();
	my $by=shift;
	unless ($by) {
		$value->set([reverse sort { if (Scalar::Util::looks_like_number($a) and Scalar::Util::looks_like_number($b)) {
				$a <=> $b
			}
			else {
				$a cmp $b
			}
			} @{$value->content}]);
		return $value;
	}
	$by=$by->repr();
	$value->set([reverse sort {
		my $aa = $a;
		if (ref $a) {
			$aa = $a->{$by} if Scalar::Util::reftype($a) eq "HASH" and exists $a->{$by};
			$aa = $a->[$by] if Scalar::Util::reftype($a) eq "ARRAY" and Scalar::Util::looks_like_number($by) and exists $a->[$by];
			$aa = $a->$by() if Scalar::Util::blessed($a) and $a->can($by);
		}
		my $bb = $b;
		if (ref $b) {
			$bb = $b->{$by} if Scalar::Util::reftype($b) eq "HASH" and $b->{$by};
			$bb = $b->[$by] if Scalar::Util::reftype($a) eq "ARRAY" and Scalar::Util::looks_like_number($by) and exists $b->[$by];
			$bb = $b->$by() if Scalar::Util::blessed($b) and $b->can($by);
		}
		if (Scalar::Util::looks_like_number($aa) and Scalar::Util::looks_like_number($bb)) {
			$aa <=> $bb
		}
		else {
			$aa cmp $bb
		}
	} @{$value->content}]);
	return $value;

}

sub divisibleby {
	my $value=shift;
	return Dotiac::DTL::Value->safe(0) unless $value->number;
	my $by=shift;
	return Dotiac::DTL::Value->safe(0) unless $by;
	return Dotiac::DTL::Value->safe(0) unless $by->number;
	my $res=!($value->content % $by->content);
	return Dotiac::DTL::Value->safe($res);
}

sub escape {
	my $value=shift;
	$value->escape(1);
	return $value;
}

#Not for JSON output of objects, I need to write an JSON-Addon for that.

my %jsescape = (
	"\n" => "\\n",
	"\r" => "\\r",
	"\t" => "\\t",
	"\f" => "\\f",
	"\b" => "\\b",
	'"' => "\\\"",
	"\\" => "\\\\",
	"'" => "\\'",
);

sub escapejs {
	my $value=shift;
	my $val=$value->repr();
	$val =~ s/([\n\r\t\f\b"'\\])/$jsescape{$1}/eg;
	#$val =~ s/([\x00-\x08\x0b\x0e-\x1f\x7f-\x{FFFF}])/'\\u' .sprintf("%04x",ord($1))/eg; #Won't work in Perl 5.6.0
	$val =~ s/([^\x09\x0a\x0c\x0d\x20-\x7e])/'\\u' .sprintf("%04x",ord($1))/eg;
	$value->set($val);
	return $value;
}

#Locale crap
our @filesizeformat=qw/bytes Kb Mb Gb Tb Eb Pb manybytes manybytes manybytes manybytes/;

our $floatformatlocale="";
#sub {
#	my $v=shift;
#	$v=s/\./,/g;
#	return $v;
#}

sub filesizeformat {
	my $val=shift;
	return $val unless $val->number();
	my $value=$val->content();
	my $i=0;
	while ($value >= 1024.0) {
		$value=$value/1024.0;
		$i++;
	}
	if ($value < 10) {
		$value=sprintf("%1.2f",$value);
	}
	else {
		$value=sprintf("%4.1f",$value);
	}
	$value=~s/0+$//g;
	$value=~s/\.$//g;
	$value=$floatformatlocale->($value) if $floatformatlocale;
	$val->set($value." ".$filesizeformat[$i]);
	return $val;
}

sub first {
	my $value=shift;
	if ($value->object) {
		if ($value->content->can("__getitem__")) {
			my $x = $value->content->__getitem__(0);
			if (defined $x) {
				$value->set($x);
				return $value;
			}
		}
	}
	if ($value->array) {
		$value->set($value->content->[0]);
	}
	elsif ($value->hash) {
		my @a=sort keys %{$value->content};
		$value->set($value->content->{$a[0]});
	}
	return $value;
}

sub fix_ampersands {
	my $value=shift;
	my $val=$value->repr();
	$val=~s/&/&/g;
	$value->set($val);
	return $value;
}

sub floatformat {
	my $val=shift;
	return $val if not $val->number;
	my $value=$val->content;
	my $arg=shift;
	if ($arg and not $arg->number) {
		$val->set(int($value+0.5));
		return $val
	}
	if ($arg) {
		$arg=$arg->content;
	}
	else {
		$arg=-1;
	}
	my $skip=$arg=~s/^-//;
	$value=sprintf("%.".$arg."f",$value);
	unless ($skip) {
		$value=$floatformatlocale->($value) if $floatformatlocale;
		$val->set($value);
		return $val;
	}
	$value=~s/0+$//g;
	$value=~s/\.$//g;
	$value=$floatformatlocale->($value) if $floatformatlocale;
	$val->set($value);
	return $val;
}

my $escape=sub {
	my $val=shift;
	$val=~s/&/&/g;
	$val=~s/
	$val=~s/>/>/g;
	$val=~s/\"/"/g;
	$val=~s/\'/'/g;
	return $val;
};

sub force_escape {
	my $value=shift;
	$value->escape(1);
	return Dotiac::DTL::Value->safe($value->string());
}

sub get_digit {
	my $value=shift;
	return $value unless $value->number;
	my $val=$value->content;;
	my $pos = shift;
	return $val unless defined $pos and $pos->number;
	$pos=int $pos->content;
	return $value if $pos < 1;
	return Dotiac::DTL::Value->safe(0) if $pos > CORE::length($val);
	$value->set(substr $val,-$pos,1);
	return $value;
}

#Should only be used together with urlencode
sub iriencode {
	my $val=shift;
	my $value=$val->repr;
	#require Encode;
	#$value=Encode::encode_utf8($value) if Encode::is_utf8($value);
	$value = eval { pack("C*", unpack("U0C*", $value))} || pack("C*", unpack("C*", $value));
	$value=~s/([^a-zA-Z0-9\[\]\(\)\$\%\&\/:;#=,!\?\*_.~-])/uc sprintf("%%%02x",ord($1))/eg;
	$val->set($value);
	return $val;
}

sub join {
	my $value=shift;
	my $j=shift;
	if ($j) {
		$j=$j->repr;
	}
	else {
		$j="";
	}
	if ($value->object) {
		if ($value->content->can("__len__") and $value->content->can("__getitem__")) { #No support for __iter__ right now.
			my @a;
			foreach my $i (0 .. $value->content->__len__()-1) {
				push @a,$value->content->__getitem__($i);
			}
			$value->set(CORE::join($j,@a));
			return $value
		}
		if ($value->content->can("count") and $value->content->can("__getitem__")) { #No support for __iter__ right now.
			my @a;
			foreach my $i (0 .. $value->content->count()-1) {
				push @a,$value->content->__getitem__($i);
			}
			$value->set(CORE::join($j,@a));
			return $value;
		}
	}
	$value->set(CORE::join($j,@{$value->content})) if $value->array;
	$value->set(CORE::join($j,values %{$value->content})) if $value->hash;
	return $value;
}

sub last {
	my $value=shift;
	if ($value->object) {
		if ($value->content->can("__len__") and $value->content->can("__getitem__")) {
			my $x = $value->content->__getitem__($value->content->__len__()-1);
			if (defined $x) {
				$value->set($x);
				return $value;
			}
		}
		if ($value->content->can("count") and $value->content->can("__getitem__")) {
			my $x = $value->content->__getitem__($value->content->count()-1);
			if (defined $x) {
				$value->set($x);
				return $value;
			}
		}
	}
	if ($value->array) {
		if (@{$value->content}) {
			$value->set($value->content->[-1]);
		}
		else {
			$value->set(undef);
		}
	}
	elsif ($value->hash) {
		my @a=sort keys %{$value->content};
		if (@a) {
			$value->set($value->content->{$a[-1]});
		}
		else {
			$value->set(undef);
		}
	}
	return $value;
}

sub length {
	my $value=shift;
	return Dotiac::DTL::Value->safe(0) if $value->undef;
	return Dotiac::DTL::Value->safe(CORE::length($value->content)) if $value->scalar;
	return Dotiac::DTL::Value->safe($value->content->count()) if $value->object and $value->content->can("count");
	return Dotiac::DTL::Value->safe($value->content->__len__()) if $value->object and $value->content->can("__len__");
	return Dotiac::DTL::Value->safe(scalar @{$value->content}) if $value->array;
	return Dotiac::DTL::Value->safe(scalar keys %{$value->content}) if $value->hash;
	return Dotiac::DTL::Value->safe(0);
}

#output will be 1 or 0, not True or False
sub length_is {
	my $value=shift;
	my $is=shift;
	if ($is->number) {
		$is=int($is->content());
	}
	else {
		$is=0;
	}
	$is = 0 unless defined $is and Scalar::Util::looks_like_number($is);
	return Dotiac::DTL::Value->safe(!$is) if $value->undef;
	return Dotiac::DTL::Value->safe(CORE::length($value->content) == $is) if $value->scalar();
	return Dotiac::DTL::Value->safe($value->content->count() == $is) if $value->object and $value->content->can("count");
	return Dotiac::DTL::Value->safe($value->content->__len__() == $is) if $value->object and $value->content->can("__len__");
	return Dotiac::DTL::Value->safe(@{$value->content} == $is) if $value->array;
	return Dotiac::DTL::Value->safe(keys %{$value->content} == $is) if $value->hash;
	return Dotiac::DTL::Value->safe(0)
}

sub linebreaks {
	my $value=shift;
	$value=$value->string();
	$value=~s/\n\s*\n/<\/p>/g;
	$value=~s/\n//g;
	return Dotiac::DTL::Value->safe("".$value."");
}

sub linebreaksbr {
	my $value=shift;
	$value=$value->string();
	$value=~s/\n//g;
	return Dotiac::DTL::Value->safe($value);
}

sub linenumbers {
	my $val=shift;
	my $value=$val->repr();
	return $val->set("1: $value") unless $value;
	my $count = ($value =~ tr/\n/\n/);
	$count=CORE::length $count;
	my $i=1;
	$value=~s/\n/sprintf("\n%0$count"."d: ",++$i)/eg;
	return $val->set(sprintf("%0$count"."d: ",1).$value);
}

sub ljust {
	my $value=shift;
	my $length=shift;
	return $value unless $length->number;
	my $padding = shift;
	my $pad=" ";
	$pad=substr($padding->repr,0,1) if $padding;
	my $val=$value->repr;
	my $len=$length->repr;
	$len-=CORE::length $val;
	$val=$val.($pad x int($len));
	$value->set($val);
	return $value;
}

sub lower {
	my $value=shift;
	return $value->set(lc $value->repr);
}

sub make_list {
	my $value=shift;
	my $val=$value->repr;
	my $by=shift;
	if ($by) {
		$by=quotemeta $by->repr;
		$value->set([split /$by/,$val]);
	}
	return $value->set([split //,$val]);
}

#No locale for now

sub phone2numeric {
	my $val=shift;
	my $value=$val->repr;
	$value=~y/AaBbCcDdEeFfGgHhIiJjKkLlMmNnOoPpRrSsTtUuVvWwXxYy/222222333333444444555555666666777777888888999999/;
	return $val->set($value);
}

our $pluralizedefault = "s";

sub pluralize {
	my $value=shift;
	my $val=0;
	$val=CORE::length $value->content if $value->scalar;
	$val=$value->content if $value->number;
	$val=scalar keys %{$value->content} if $value->hash;
	$val=scalar @{$value->content} if $value->array;
	my $s = $pluralizedefault;
	if (@_) {
		$s=shift() if @_;
		$s=$s->repr();
	}
	my $p;
	my $o;
	if (@_) {
		$o=$s;
		$p=shift;
		$p=$p->repr();
	}
	else {
		($o,$p) = split /,/,$s,2;
	}
	unless ($p) {
		$p=$o;
		$o="";
	}
	return $value->set($val==1?$o:$p);
}


sub pprint {
	require Data::Dumper;
	return Dotiac::DTL::Value->new(Data::Dumper->Dump([@_]));
}

sub random {
	my $value=shift;
	if ($value->object) {
		if ($value->content->can("__len__") and $value->content->can("__getitem__")) {
			my $x = $value->content->__getitem__(int(rand($value->content->__len__())));
			if (defined $x) {
				return $value->set($x);
			}
		}
		if ($value->content->can("count") and $value->content->can("__getitem__")) {
			my $x = $value->content->__getitem__(int(rand($value->content->count())));
			if (defined $x) {
				return $value->set($x);
			}
		}
	}
	if ($value->array) {
		if (@{$value->content}) {
			return $value->set($value->content->[int(rand(scalar @{$value->content}))]);
		}
		else {
			return $value->set(undef);
		}
	}
	elsif ($value->hash) {
		my @a=sort keys %{$value->content};
		if (@a) {
			return $value->set($value->content->{$a[int(rand(scalar @a))]});
		}
		else {
			return $value->set(undef);
		}
	}
	return $value;
}

sub removetags {
	my $val=shift;
	my $value=$val->repr();
	my $tags=shift;
	$tags=$tags->repr;
	if ($tags) {
		my @t=split /\s+/,$tags;
		my $t=CORE::join("|",map {quotemeta $_} @t);
		$value=~s/<\/?(?:$t)(?:\/?>|\s[^>]+>)//g;
	}
	return $val->set($value);
}

sub rjust {
	my $value=shift;
	my $length=shift;
	return $value unless $length->number;
	my $padding = shift;
	my $pad=" ";
	$pad=substr($padding->repr,0,1) if $padding;
	my $val=$value->repr;
	my $len=$length->repr;
	$len-=CORE::length $val;
	$val=($pad x int($len)).$val;
	$value->set($val);
	return $value;
}

sub safe {
	my $value=shift;
	$value->safe(1);
	return $value;
}

sub slice {
	my $value=shift;
	return $value unless $value->hash or $value->array;
	my $slice=shift;
	return $value unless $slice;
	$slice=$slice->repr;
	my @slice=split /:/,$slice,2;

	my @value;
	@value=@{$value->content} if $value->array;
	@value=sort keys %{$value->content} if $value->hash;

	$slice[0] = int($slice[0] || 0) || 0;
	unless ($#slice) {
		return $value unless Scalar::Util::looks_like_number($slice[0]);
		return $value->set($value[int($slice[0])]) if $value->array;
		return $value->set($value->content->{$value[int($slice[0])]}) if $value->hash;
	}

	$slice[1] = int($slice[1] || 0) || 0;
	$slice[1]-=$slice[0] if ($slice[1] > 0);
	$slice[1]=scalar(@value)-$slice[0] unless $slice[1];
	return $value->set([splice(@value,$slice[0],$slice[1])]) if $value->array;
	return $value->set([map {$value->content->{$_}} splice(@value,$slice[0],$slice[1])]) if $value->hash;
}

sub slugify {
	my $value=shift;
	my $val=$value->repr();
	$val=lc($val);
	$val=~s/[^\w\s]//g;
	$val=~s/^\s+//g;
	$val=~s/\s+$//g;
	$val=~s/\s/-/g;
	$value->safe(1);
	return $value->set($val);
}



#This follows perls sprintf rules for now, which are about the same, but there is no "r"

sub stringformat {
	my $value=shift;
	my $format=shift;
	return $value unless $format;
	$format=$format->repr;
	my $val="";
	if ($format=~tr/r/s/) {
		$val=$value->pyrepr;
	}
	else {
		$val=$value->repr;
	}
	my $v;
	eval {
		local $SIG{__WARN__} = sub {};
		$v=sprintf("%$format",$val);
	};
	return $value->set($v) unless $@;
	undef $@;
	return $value;
}

sub striptags {
	my $value=shift;
	my $val=$value->repr;
	my $tags=shift;
	$val=~s/<[^>]+>//g;
	return $value->set($val);
}

sub time {
	my $value=shift;
	return $value unless $value->number() or $value->array();
	my $time=$value->repr();
	my $safe=0;
	my $string=shift;
	if (not defined $string or not $string->scalar()) {
		$string=$Dotiac::DTL::DATE_FORMAT;
		$safe=1;
	}
	else {
		$safe=$string->safe();
		$string=$string->repr;
	}
	my @t;
	if ($value->number()) {
		@t=localtime($time);
	}
	else {
		@t=@{$value->content};
	}
	my @s=split //,$string;
	my $res;
	while (my $s=shift(@s)) {
		if ($s eq '\\') {
			$res.=shift(@s);
		}
		elsif ($s eq "a") {
			if ($t[2] > 12 or ($t[2] == 12 and $t[1] > 0)) {
				$res.=$timeampm[0];
			}
			else {
				$res.=$timeampm[1];
			}
		}
		elsif ($s eq "A") {
			if ($t[2] > 12 or ($t[2] == 12 and $t[1] > 0)) {
				$res.=$timeampm[2];
			}
			else {
				$res.=$timeampm[3];
			}
		}
		elsif ($s eq "f") {
			my $h=$t[2];
			$h=$h%12;
			$h=12 unless $h;
			$res.=$h;
			$res.=sprintf(":%02d",$t[1]) if ($t[1]);
		}
		elsif ($s eq "g") {
			my $h=$t[2];
			$h=$h%12;
			$h=12 unless $h;
			$res.=$h;
		}
		elsif ($s eq "G") {
			$res.=$t[2];
		}
		elsif ($s eq "h") {
			my $h=$t[2];
			$h=$h%12;
			$h=12 unless $h;
			$res.=sprintf("%02d",$h);
		}
		elsif ($s eq "H") {
			$res.=sprintf("%02d",$t[2]);
		}
		elsif ($s eq "i") {
			$res.=sprintf("%02d",$t[1]);
		}
		elsif ($s eq "O") {
			my @tt=localtime(0);
			$tt[2]+=1 if $t[8];
			$res.=sprintf("%+05d",$tt[2]*100+$tt[1]);
		}
		elsif ($s eq "P") {
			if ($t[2] == 12 and $t[1] == 0) {
				$res.=$timespotnames[1];
			}
			elsif ($t[2] == 0 and $t[1] == 0) {
				$res.=$timespotnames[0];
			}
			else {
				my $h=$t[2];
				$h=$h%12;
				$h=12 unless $h;
				$res.=$h;
				$res.=sprintf(":%02d",$t[1]) if ($t[1]);
				if ($t[2] > 12 or ($t[2] == 12 and $t[1] > 0)) {
					$res.=" ".$timeampm[0];
				}
				else {
					$res.=" ".$timeampm[1];
				}
			}

		}
		elsif ($s eq "s") {
			$res.=sprintf("%02d",$t[0]);
		}
		elsif ($s eq "Z") {
			my @tt=localtime(0);
			$tt[2]+=1 if $t[8];
			$res.=$tt[2]*3600+$t[1]*60+$t[0];
		}
		elsif ($s eq "\n") {
			$res.="n";
		}
		elsif ($s eq "\t") {
			$res.="t";
		}
		elsif ($s eq "\f") {
			$res.="f";
		}
		elsif ($s eq "\b") {
			$res.="b";
		}
		elsif ($s eq "\r") {
			$res.="r";
		}
		else {
			$res.=$s;
		}
	}
	return Dotiac::DTL::Value->new($res,$safe);
}

our @timenames=qw/year years month month week weeks day days hour hours minute minutes/;

sub timesince {
	my $val=shift;
	return $val unless $val->number;
	$val=$val->content;
	my $comp=shift;
	if ($comp and $comp->number) {
		$comp=$comp->content;
	}
	else {
		$comp=CORE::time();
	}
	my $dist=$comp-$val;
	return Dotiac::DTL::Value->safe("0 $timenames[11]") if $dist < 60;
	my $mi=int($dist/60);
	my $h=int($mi/60);
	$mi=$mi%60;
	my $d=int($h/24);
	$h=$h%24;
	my $w=int($d/7);
	my $m=int($d/30);
	if ($m) {
		$d=$d%30;
	}
	else {
		$d=$d%7;
	}
	my $y=int($m/12);
	$m=$m%12;
	if (@_) {
		my $r=($y?"$y ".($y==1?"$timenames[0] ":"$timenames[1] "):"").($m?"$m ".($m==1?"$timenames[2] ":"$timenames[3] "):($w?"$w ".($w==1?"$timenames[4] ":"$timenames[5] "):"")).($d?"$d ".($d==1?"$timenames[6] ":"$timenames[7] "):"").($h?"$h ".($h==1?"$timenames[8] ":"$timenames[9] "):"").($mi?"$mi ".($mi==1?"$timenames[10] ":"$timenames[11] "):"");
		$r=~s/\s$//;
		return Dotiac::DTL::Value->safe($r);
	}
	return Dotiac::DTL::Value->safe("$y ".($y==1?$timenames[0]:$timenames[1])) if ($y);
	return Dotiac::DTL::Value->safe("$m ".($m==1?$timenames[2]:$timenames[3])) if ($m);
	return Dotiac::DTL::Value->safe("$w ".($w==1?$timenames[4]:$timenames[5])) if ($w);
	return Dotiac::DTL::Value->safe("$d ".($d==1?$timenames[6]:$timenames[7])) if ($d);
	return Dotiac::DTL::Value->safe("$h ".($h==1?$timenames[8]:$timenames[9]).($mi?" $mi ".($mi==1?$timenames[10]:$timenames[11]):"")) if $h;
	return Dotiac::DTL::Value->safe("$mi ".($mi==1?$timenames[10]:$timenames[11])) if ($mi);

}

sub timeuntil {
	my $val=shift;
	return $val unless $val->number;
	$val=$val->content;
	my $comp=shift;
	if ($comp and $comp->number) {
		$comp=$comp->content;
	}
	else {
		$comp=CORE::time();
	}
	my $dist=$val-$comp;
	return Dotiac::DTL::Value->safe("0 $timenames[11]") if $dist < 60;
	my $mi=int($dist/60);
	my $h=int($mi/60);
	$mi=$mi%60;
	my $d=int($h/24);
	$h=$h%24;
	my $w=int($d/7);
	my $m=int($d/30);
	if ($m) {
		$d=$d%30;
	}
	else {
		$d=$d%7;
	}
	my $y=int($m/12);
	$m=$m%12;
	if (@_) {
		my $r=($y?"$y ".($y==1?"$timenames[0] ":"$timenames[1] "):"").($m?"$m ".($m==1?"$timenames[2] ":"$timenames[3] "):($w?"$w ".($w==1?"$timenames[4] ":"$timenames[5] "):"")).($d?"$d ".($d==1?"$timenames[6] ":"$timenames[7] "):"").($h?"$h ".($h==1?"$timenames[8] ":"$timenames[9] "):"").($mi?"$mi ".($mi==1?"$timenames[10] ":"$timenames[11] "):"");
		$r=~s/\s$//;
		return Dotiac::DTL::Value->safe($r);
	}
	return Dotiac::DTL::Value->safe("$y ".($y==1?$timenames[0]:$timenames[1])) if ($y);
	return Dotiac::DTL::Value->safe("$m ".($m==1?$timenames[2]:$timenames[3])) if ($m);
	return Dotiac::DTL::Value->safe("$w ".($w==1?$timenames[4]:$timenames[5])) if ($w);
	return Dotiac::DTL::Value->safe("$d ".($d==1?$timenames[6]:$timenames[7])) if ($d);
	return Dotiac::DTL::Value->safe("$h ".($h==1?$timenames[8]:$timenames[9]).($mi?" $mi ".($mi==1?$timenames[10]:$timenames[11]):"")) if $h;
	return Dotiac::DTL::Value->safe("$mi ".($mi==1?$timenames[10]:$timenames[11])) if ($mi);

}

sub title {
	my $val=shift;
	my $value=$val->repr();
	$value=~s/(\w+)/ucfirst($1)/eg;
	return $val->set($value);
}

sub truncatewords {
	my $value=shift;
	my $words=shift;
	return $value unless $words and $words->number;
	my @val = split /(\s+)/,$value->repr;
	$words=($words->content-1)*2;
	return $value if $words >= $#val;
	#$words=$#val if $words > $#val;
	return $value->set(CORE::join("",@val[0 .. $words],($val[$words]=~/\.\.\./?"":"...")));
}

my %singletags=qw/br 1 col 1 link 1 base 1 img 1 param 1 area 1 hr 1 input 1/;

sub truncatewords_html {
	my $val=shift;
	my $value=$val->string();
	my $words=shift;
	return $val unless $words and $words->number;
	my $len=CORE::length($value);
	$words=$words->content;
	my $ret="";
	my @tags;
	while ($words and (pos($value)||0) < $len) {
		my $pos=pos($value);
		if ($a=$value=~m/\G(\s*[^<\s]+\s*)/g) {
			$ret.=$1;
			#warn "$1 $words";
			$words--;
			next;
		}
		else {
			pos($value)=$pos;
		}
		if ($a=$value=~m/\G\s*
			if ($a=$value=~m/([^>]+)>/g) {
				$ret.="<$1>";
				my $tag=lc($1);
				if ($tag eq "/") { #SGML: Close last tag , never seen it used in HTML, but whatever.
					shift @tags;
				}
				elsif ($tag=~s/^\///) {
					my @t=@tags;
					$tag=~m/^(\w+)/;
					$tag=$1;
					my $t=shift @t;
					$t=shift @t while (@t and $t ne $tag);
					if ($t eq $tag) {
						@tags=@t; #SGML: bbb, the  also closes .
					}
					next;
				}
				elsif ($tag=~s/\/$//) { #XML: Singletag
					next;
				}
				else {
					$tag=~m/^(\w+)/;
					$tag=$1;
					unshift @tags,$tag unless $singletags{$tag}; #Some HTML-Tags shouldn't be closed, (why not, I wonder)
					next;
				}
			}
			else {
				return $val->set($ret); #Parsingerror.
			}
		}
		else {
			pos($value)=$pos;
		}

	}
	return $val if $words > 0; #Should be allright then.
	$ret=~s/\s+$//g;
	$ret.="..." unless $ret=~m/\.\.\.$/;
	foreach my $t (@tags) {
		$ret.="";
	}
	return $val->set($ret);
}


#TODO TODO TODO
# Split in subfuntion ziehe safe aus $value->safe();
#TODO TODO TODO
#
my $unordered_list;
$unordered_list = sub {
	my $e=shift;
	my $save=shift;
	my $level=shift;
	my $res="";
	return "" unless ref $e and ref $e eq "ARRAY";
	my @loop=@$e;
	while (@loop) {
		my $title=shift @loop;
		$title=$escape->($title) unless $save;
		$res.="\t"x($level)."$title";
		if (ref $loop[0] and ref $loop[0] eq "ARRAY") {
			$res.="\n"."\t"x($level)."\n";
			$res.=$unordered_list->(shift(@loop),$save,$level+1);
			$res.="\t"x($level)."\n";
			$res.="\t"x($level);
		}

		$res.="\n"
	}
	return $res;

};

sub unordered_list {
	my $value=shift;
	return "".$value->string()."\n" if $value->scalar;
	return $value unless $value->array;
	my @loop=@$value;
	if (@loop==2 and ref $loop[1] and Scalar::Util::reftype($loop[1]) eq "ARRAY" and (ref $loop[1]->[0] or not @{$loop[1]})) {
		#$ret.=unordered_list($loop[0],$save,$level);
		my $r=sub {
			my $d=shift;
			my $r=shift;
			return ($d->[0],[map {$r->($_,$r)} @{$d->[1]}]);
		};
		@loop=$r->($value,$r);
		#@loop=($loop[0],[map {@$_} @{$loop[1]}]);
	}
	my $ret=$unordered_list->($value->content(),$value->safe,0);
	return Dotiac::DTL::Value->safe($ret);
}


sub upper {
	my $value=shift;
	$value->set(uc $value->repr);
	return $value;
}

#This awesome Regex ripped of http://geekswithblogs.net/casualjim/archive/2005/12/01/61722.aspx

#Addition: parameters: Safechars. urlencode:"" encodes also slashes, needed if you are gonna built an url and urlencode:":/?=&" can be run over an http://foo/bar?foo=bar string
sub urlencode {
	my $val=shift;
	my $value=$val->repr;
	my $safe="/";
	if (@_) {
		$safe=shift;
		$safe=$safe->repr() if ref $safe; # For internal use
	}
	$safe="" unless $safe;
	$safe=quotemeta($safe);
	my $find=qr/([^\w$safe\.~-])/;
	$value=~s/$find/uc sprintf("%%%02x",ord($1))/eg;
	return $val->set($value);
}

sub urlize {
	my $value=shift;
	$value=$value->string();
	#$value=~s"(^|(?'.$a.''"eg;
	$value=~s"((?#Protocol)(?:(?:ht|f)tp(?:s?)\:\/\/|~/|/)?(?#Username:Password)(?:\w+:\w+@)?(?#Subdomains)(?:(?:[-\w]+\.)+(?#TopLevel Domains)(?:com|org|net|gov|mil|biz|info|mobi|name|aero|jobs|museum|travel|[a-z]{2}))(?#Port)(?::[\d]{1,5})?(?#Directories)(?:(?:(?:/(?:[-\w~!\$+|.,=]|%[a-f\d]{2})+)+|/)+|\?|#)?(?#Query)(?:(?:\?(?:[-\w~!\$+|.,*:]|%[a-f\d{2}])+=(?:[-\w~!\$+|.,*:=]|%[a-f\d]{2})*)(?:(?:&|&|;)(?:[-\w~!\$+|.,*:]|%[a-f\d{2}])+=(?:[-\w~!\$+|.,*:=]|%[a-f\d]{2})*)*)*(?#Anchor)(?:#(?:[-\w~!\$+|.,*:=]|%[a-f\d]{2})*)?)"my $a=$1;''.$a.''"eg;
	return Dotiac::DTL::Value->safe($value);
}

sub urlizetrunc {
	my $value=shift;
	$value=$value->string();
	my $len=shift;
	if ($len and $len->number) {
		$len=int($len->content);
	}
	else {
		$len=0;
	}
	$len=15 unless $len;
	#$value=~s"(^|(?'.($len >= CORE::length($a)?$a:substr($a,0,$len).'...').''"eg;
	$value=~s"((?#Protocol)(?:(?:ht|f)tp(?:s?)\:\/\/|~/|/)?(?#Username:Password)(?:\w+:\w+@)?(?#Subdomains)(?:(?:[-\w]+\.)+(?#TopLevel Domains)(?:com|org|net|gov|mil|biz|info|mobi|name|aero|jobs|museum|travel|[a-z]{2}))(?#Port)(?::[\d]{1,5})?(?#Directories)(?:(?:(?:/(?:[-\w~!\$+|.,=]|%[a-f\d]{2})+)+|/)+|\?|#)?(?#Query)(?:(?:\?(?:[-\w~!\$+|.,*:]|%[a-f\d{2}])+=(?:[-\w~!\$+|.,*:=]|%[a-f\d]{2})*)(?:(?:&|&|;)(?:[-\w~!\$+|.,*:]|%[a-f\d{2}])+=(?:[-\w~!\$+|.,*:=]|%[a-f\d]{2})*)*)*(?#Anchor)(?:#(?:[-\w~!\$+|.,*:=]|%[a-f\d]{2})*)?)"my $a=$1;''.($len >= CORE::length($a)?$a:substr($a,0,$len).'...').''"eg;
	return Dotiac::DTL::Value->safe($value);
}



sub wordcount {
	my $value=shift;
	$value=$value->repr;
	return Dotiac::DTL::Value->safe(scalar( ()=$value=~m/\S+/g));
}

sub wordwrap {
	my $val=shift;
	my @value = split /(\s+)/,$val->repr;
	my $len=shift;
	if ($len and $len->number) {
		$len=int($len->content);
	}
	else {
		$len=0;
	}
	$len=80 unless $len;
	my $line=shift @value;
	my $ret="";
	while (my $space=shift(@value)) {
		my $word=shift(@value);
		$word="" unless $word;
		if (CORE::length($line.$space.$word) > $len) {
			$ret.=$line."\n";
			$line=$word;
		}
		else {
			$line.=$space.$word;
		}
	}
	$ret.=$line;
	return $val->set($ret);
}



sub yesno {
	my $value=shift;
	my $yes=shift;
	if (@_) {
		my $no=shift;
		my $undef=shift;
		$yes=Dotiac::DTL::Value->safe("") unless $yes;
		$no=Dotiac::DTL::Value->safe("") unless $no;
		$undef=$no unless $undef;
		return $yes if $value->true;
		return $undef if $value->undef;
		return $no;
	}
	if ($yes) {
		$yes=$yes->string();
	}
	else {
		$yes="";
	}
	my ($y,$no,$undef) = split /,/,$yes,3;
	$no="" unless $no;
	$undef=$no unless $undef;
	return Dotiac::DTL::Value->safe($y) if $value->true;
	return Dotiac::DTL::Value->safe($undef) if $value->undef;
	return Dotiac::DTL::Value->safe($no);
}


=head1 SEE ALSO

L, L

=cut
1;

__END__