#
# _modules/interval.pm
#
# Developed by Lubomir Host 'rajo' <rajo AT platon.sk>
# Copyright (c) 2004-2006 Platon Group, http://platon.sk/
# Licensed under terms of GNU General Public License.
# All rights reserved.
#
# Changelog:
# 18/04/2004 - created
#

# $Id: obfuscator.pm,v 1.2 2006/01/25 15:19:25 rajo Exp $

package obfuscator;

use strict;
use Carp;
use Time::HiRes qw(gettimeofday tv_interval);
use Template::Plugin;
use Template::Exception;

use base qw( Template::Plugin );
use vars qw( $VERSION $DEBUG );

$VERSION	= sprintf("%d", q$Revision: 1.2 $ =~ /(\d+)/);
$DEBUG		= 0 unless defined $DEBUG;

sub new
{ #{{{
    my $class   = shift;
    my $context = shift;
    my $self    = ref $class ? $class : bless { 
		_CONTEXT => $context, 
		_STH     => [ ],
    }, $class;

    bless $self, $class;

    return $self;
} # }}}

sub email
{ # {{{
	my ($self, $email, $prompt, $title, $usejs) = @_;

	# return if email doesn't validate
	return   if( $email !~ /[\w\-\[\]<>\+]+(\@|\-at\-)[\w\-\[\]<>]+(\.|\-dot\-)[\w\-]+/i);

	# mangle address -- character at a time --except \@
	$email  =~ s/(:)([^\s])/$1 $2/;
	$email  =~ s/([a-zA-Z0-9:\s_\-.])/&OB_randlet($1)/eg;

	my $at = &OB_randlet("\@");
	my ($ename, $edomain) = split(/\@/, $email);
	my $link = $ename.$at.$edomain;

 	# want address only? no problem.
	return $link	if !($prompt || $title);

	# put a space between mailto: and the address (drives spammers crazy)
	my($mailto) = &OB_ascape("mailto:").&OB_hexape(" ");


	# build hyperlink based on use javascript argument (or not)
	$link = $usejs ?
		"javascript:var e1='$edomain',e2='$mailto', e3='$ename';var e0=e2+e3+'$at'+e1;(window.location?window.location.replace(e0):document.write(e0));" :
		$mailto.$link;

  	# try to use a title, but when you can't ...
	$prompt = &OB_ascape($prompt);
	$prompt =~ s/</&lt;/g;
	$prompt =~ s/>/&gt;/g;
	return qq~<a href="$link">$prompt</a>~	if !($title);

	# got title?
	$title  = &OB_ascape($title);
	return qq~<a href="$link" title="$title">$prompt</a>~;
} # }}}

sub icq
{ # {{{
	my ($self, $icq) = @_;

	return &OB_ascape($icq);

} # }}}

sub callto
{ # {{{
	my ($self, $email, $prompt, $title, $usejs) = @_;

	# mangle address -- character at a time --except \@
	$email  =~ s/(:)([^\s])/$1 $2/;
	$email  =~ s/([a-zA-Z0-9:\s_\-.])/&OB_randlet($1)/eg;

	my $at = &OB_randlet("\@");
	my ($ename, $edomain) = split(/\@/, $email);
	my $link = $ename.$at.$edomain;

 	# want address only? no problem.
	return $link	if !($prompt || $title);

	# put a space between mailto: and the address (drives spammers crazy)
	my($mailto) = &OB_ascape("callto:").&OB_hexape("//");


	# build hyperlink based on use javascript argument (or not)
	$link = $usejs ?
		"javascript:var e1='$edomain',e2='$mailto', e3='$ename';var e0=e2+e3+'$at'+e1;(window.location?window.location.replace(e0):document.write(e0));" :
		$mailto.$link;

  	# try to use a title, but when you can't ...
	$prompt = &OB_ascape($prompt);
	$prompt =~ s/</&lt;/g;
	$prompt =~ s/>/&gt;/g;
	return qq~<a href="$link">$prompt</a>~	if !($title);

	# got title?
	$title  = &OB_ascape($title);
	return qq~<a href="$link" title="$title">$prompt</a>~;
} # }}}

# http://ironbark.bendigo.latrobe.edu.au/subjects/bitwen/lectures/w08.d/l15.d/slide3.html
sub OB_validmail
{ # {{{
	my($email) = @_;
	return ( $email =~ /^([\w\-._]+\@[\w\-.]+)$/ );
} # }}}

# 2 randoms, 1st for hex vs ascii, then again for ascii vs plain
sub OB_randlet
{ # {{{
 	my($l) = @_;
	my($r) = &OB_round(rand());
 	return sprintf("%%%02x",ord($l))	if $r;
	$r = &OB_round(rand());
 	return sprintf("&#%03d;",ord($l))	if $r;
	return $l;
} # }}}

# real numbers only
sub OB_round
{ # {{{
	my($n) = @_;
	return int($n + .5 * ($n <=> 0));
} # }}}

# ascii escape codes
sub OB_ascape
{ # {{{
	my($s) = @_;
	$s =~ s/([a-zA-Z0-9:\s\@_\-.])/uc sprintf("&#%03d;",ord($1))/eg;
	return $s;
} # }}}

# hex it up a bit
sub OB_hexape
{ # {{{
	my($s) = @_;
	$s =~ s/([a-zA-Z0-9:\s\@_\-.])/uc sprintf("%%%02x",ord($1))/eg;
	return $s;
} # }}}

1;

__END__

=head1 NAME

interval - <<<description of module>>>

=head1 SYNOPSIS

  use interval;

  my $xxx = new interval;

=head1 DESCRIPTION

The interval module allows you ...
<<<your description here>>>

=head2 EXPORT

<<here describe exported methods>>>

=head1 SEE ALSO

=head1 AUTHORS

Lubomir Host 'rajo', <rajo AT platon.sk>

=cut

# vim: ts=4
# vim600: fdm=marker fdl=0 fdc=3