#!/usr/bin/perl -w
#===============================================================================
#
#         FILE:  JLouisBiz2Tel.pl
#
#        USAGE:  JLouisBiz2Tel.cgi 
#
#  DESCRIPTION: Displays TEL website in a selected template 
#
#      OPTIONS:  ---
# REQUIREMENTS:  ---
#         BUGS:  ---
#        NOTES:  This software is given as public domain.
#       AUTHOR:  THETABIZ S.A. (TC), <http://www.teldomaintel.com/contact>
#      COMPANY:  Thetabiz S.A.
#      VERSION:  1.0
#      CREATED:  03/01/2010 06:52:36 AM EST
#     REVISION:  ---
#===============================================================================

use strict;
use warnings;
use Data::Dumper;
use CGI;
use feature ':5.10';
use Net::DNS;
use HTML::Entities;
use IDNA::Punycode;
use MIME::Base64 qw(encode_base64);
use Sys::Hostname;
use Text::NeatTemplate;
use Perl6::Slurp;
use Fcntl ':flock';
use utf8;
$| = 1;

$CGI::POST_MAX = 2048;
$CGI::DISABLE_UPLOADS = 1;

binmode(STDOUT, ":utf8");
binmode(STDIN, ":utf8");

idn_prefix("xn--");

my $q = new CGI;

my $res = Net::DNS::Resolver->new;

my $tobj = Text::NeatTemplate->new();
my %template;

my $stdtel = 'teldomaintel.tel';
my $domain;
my $log = '/tmp/.teldomaintel.log';
unless(-e $log) { open(LOG, ">", $log); close LOG; }

if($q->param('domain') && $q->param('domain') ne $stdtel && $q->param('domain') =~ /\.tel$/i) {
	$domain = $q->param('domain');
	open(TMP, ">>", $log);
	if(flock(TMP, LOCK_SH | LOCK_NB)) {
		print TMP $domain, "\n";
	}
	close TMP;
} else {
	$domain = $stdtel;
}

my $css    = $q->param('css') || 2;
unless($css =~ /^\d{1}$/) { $css = 2 }

my $host = hostname;
my $dir  = 'protected/www.teldomaintel.com/cgi-bin';
if($host eq 'localhost') { $host = 'localhost'; } else { $host = 'www.teldomaintel.com'; $dir  = 'cgi-bin'; }
my $website = "http://$host/$dir/JLouisBiz.cgi";
my $proxy = "http://$host/$dir/JLouisBiz.cgi?css=$css&amp;domain=";
my $style = "http://www.w3.org/StyleSheets/Core/parser.css?family=$css&amp;doc=XML";
my $template_content = slurp "../files/private-tel-domain-proxy/template/index.html", { utf8 => 1 };

my @lasttels = slurp $log, { chomp => 1, utf8 => 1 };
@lasttels = reverse @lasttels;
@lasttels = splice(@lasttels, 1, 10);
for(@lasttels) { s/$_/<li><a href="$proxy$_" title="$_">http:\/\/$_<\/a><\/li>/ }
my $navigation = join("\n", @lasttels);

	my $referer = $q->referer() || $website;;

	my %icon = %{icons()};
	my $checkout = checkout();

	domain($domain);

	sub domain {
		my $domain = shift;
		my $kdns = $res->search($domain, 'TXT');
		my $rdns = $res->search($domain, 'NAPTR');
		my ($title, %keywords, $keycount, %records, $rtxtcount);
		my $description = '';
		my $rawdescription = '';

		if($kdns) {
			foreach my $rr ($kdns->answer) {
				next unless $rr->type eq "TXT";
				my @list = $rr->char_str_list();
				unless(grep { /^\./ } @list) {
					$rawdescription .= join(" ", @list);
					$rawdescription =~ s/\n/, /g;
					for(@list) { s/\n/<br\/>/g }
					$description = '<p>';
					$description .= join("</p><p>", @list);
					$description .= '</p>';
					utf8::upgrade($description);
					utf8::decode($description);
				}
				if(grep { /^\.tsm/ } @list) {
					if($list[2] =~ /dds/i) {
						$title = $list[3] || $domain;
						utf8::upgrade($title);
						utf8::decode($title);
					}
				}
				if(grep { /^\.tlb/ } @list) {
					if($list[2] && $list[3]) {
						my $order       = $list[2];
						my $preference  = $list[3];
						my $description = $list[4];
						utf8::upgrade($description);
						utf8::decode($description);
						$records{$preference}{'description'} = $description;
					}
				}
				if(grep { /^\.tkw/ } @list) {
						$keycount++;
					if($list[2] eq 'hi') {
						$keywords{$keycount}{'Hobbies and Interests'} = $list[3] || '';
					} elsif($list[2] eq 'ft') {
						$keywords{$keycount}{'Keywords'} = $list[3] || '';
					} elsif($list[2] eq 'bi') {
						$keywords{$keycount}{'Business Information'} = $list[3] || '';
					} elsif($list[2] eq 'di') {
						$keywords{$keycount}{'Directory Information'} = $list[3] || '';
					} elsif($list[2] eq 'bpa') {
						$keywords{$keycount}{'Business Address'} = $list[3] || '';
					} else {
						$keywords{$keycount}{$list[2]} = $list[3] || '';
					}
				}
			}
		} else {
			print $q->redirect($website);
		}

		if($rdns) {
			foreach my $rr ($rdns->answer) {
				next unless $rr->type eq 'NAPTR';
				my $preference  = $rr->preference;
				my $order       = $rr->order || '';
				my $flags       = $rr->flags || '';
				my $service     = $rr->service || '';
				my $regexp      = $rr->regexp || '';
				my $replacement = $rr->replacement || '';
				if($preference) {
					$records{$preference}{'order'} = $order;
					$records{$preference}{'flags'} = $flags;
					$records{$preference}{'service'} = $service;
					$records{$preference}{'regexp'} = $regexp;
					$records{$preference}{'replacement'} = $replacement;
					if($service =~ /^E2U\+x-photo:http/) {
						my ($service, $label, $location, $record) = service($service, $regexp);
						$records{'icon'} = $record;
						delete $records{$preference};
					}
				}
			}
		}

		unless($title) { $title = $domain }
	#	for ($title, $description) { utf8::upgrade($_); utf8::decode($_) }
	#	print Dumper %records; <STDIN>;
		page($domain, $title, $description, $rawdescription, \%keywords, \%records);
	}


	sub page {
		my ($domain, $title, $description, $rawdescription, $keywords, $records) = @_;
		my %keywords = %$keywords;
		my %records  = %$records;
		my $template = Text::NeatTemplate->new();
		my $breadcrumbs = breadcrumbs($domain);
		print $q->header( -charset => 'utf-8' );
		my $page_content;
		#print $checkout;
		#print $q->hr({-style => 'clear: both;'}) if $records{'icon'};
		for my $k (sort(keys %records)) {
		next if $k eq 'icon';
		if($records{$k}{'flags'} eq 'u') { 
			my ($service, $record, $icon, $loc) = prepservice($records{$k}{'service'}, $records{$k}{'regexp'});
			if($loc) { $loc = ' - ' . ucfirst($loc) }
			$service = encode_entities($service);
			if($icon) {
				$page_content .= qq{<p><img src="} . $icon{$icon}{'url'} . qq{" style="border-style: none;" alt="$service" title="$service" width="} . $icon{$icon}{'width'} . qq{" height="} . $icon{$icon}{'height'} . qq{"/></p>};
			} 
			$page_content .= $q->h3($service, $loc) if $service;
			$page_content .= $q->p($record) if $record;
		} elsif($records{$k}{'service'} eq '') {
			my $description = $records{$k}{'description'} || 'Go to';
			$description = encode_entities($description);
			$page_content .= $q->h3($description);
			my $puny = puny(split(/\./, $records{$k}{'replacement'}));
			my $link = qq{<a href="$proxy$records{$k}{'replacement'}">$puny</a>};
			$page_content .= $q->p($link);
		}
		if($records{$k}{'flags'} eq 'u') { 
		}
	}
	for my $k (keys %keywords) {
		for my $k1 (keys %{$keywords{$k}}) {
			my $mark;
			if($keywords{$k}{$k1}) { 
				$mark = ' - ' . $keywords{$k}{$k1};
				utf8::upgrade($mark);
				utf8::decode($mark);
#				$mark =~ s/\n/<br\/>/g;
#				$mark .= '<br/>';
			} else { 
				$mark = ''; 
			}
			$k1 = encode_entities($k1);
			$mark = encode_entities($mark);
			$page_content .= $q->h3($k1, $mark);
		}
	}
	$page_content .= $q->start_form( -method => 'GET' );
	$page_content .= $q->h2("Review any TEL domain over this script");
	$page_content .= $q->textfield( -name => 'domain', 
	                             -default => $domain,
								-override => 1);
	$page_content .= $q->submit;
	$page_content .= $q->end_form;
	$page_content .= $checkout;
	unless(exists $records{'icon'}) {
		$records{'icon'} = '';
	}

	my $adsense = adsense();
	my $adsense_links = adsense_links();
	my %temp_hash = ( 
		page_title => $title,
	    css => $style,
        page_description => $rawdescription,
		description => $description . '<br/>',
		header1 => qq{<h1>$title</h1>},
		breadcrumbs => $breadcrumbs,
		page_content => $page_content,
		icon => $records{'icon'},
		navigation_title => 'Last 10 TELs',
		page_navigation => $navigation,
		adsense => $adsense,
		adsense_links => $adsense_links
	);
	my $template_result = $template->fill_in(data_hash => \%temp_hash, template => $template_content);
	print $template_result;
}


sub prepservice {
	my ($s, $r) = @_;
	my $icon;
	my ($service, $label, $location, $record) = service($s, $r);

	given($r) {
		when(/xbox.com/i)         { $icon = 'xbox' }
		when(/www.facebook.com/i) { $icon = 'facebook' }
		when(/www.dopplr.com/i)   { $icon = 'dopplr' }
		when(/blogspot.com/i)     { $icon = 'blogspot' }
		when(/twitter.com/i)      { $icon = 'twitter' }
		when(/slideshare.net/i)   { $icon = 'slideshare' }
		when(/skype/i)            { $icon = 'skype' }
		when(/!.*!aim/i)          { $icon = 'aim' }
		when(/telnic\.(org|com)/i){ $icon = 'telnic' }
		default { $icon = '' }
	}
	 utf8::upgrade($service);
	 utf8::decode($service); 
	return ($label, $record, $icon, $location);
}


sub icons {
	my %icon = ( 'facebook' => { url => 'http://static.ak.fbcdn.net/rsrc.php/z7N2A/hash/5u84f48n.png',
	                             width => 144,
								 height => 44,
								 alt => 'Facebook'
								 },
				'dopplr' => { url => 'http://www.dopplr.com/images/dopplr_logo.gif',
	                             width => 180,
								 height => 35,
								 alt => 'Dopplr'
							 },
				'blogspot' => { url => 'http://thedailyonliner.blogspot.com/favicon.ico',
								width => 32,
								height => 32,
								alt => 'Blogspot'
								},
				'twitter' => { url => 'http://twitter-badges.s3.amazonaws.com/twitter-a.png',
				              width => 61,
							  height => 23,
							  alt => 'Twitter'
							  },
				'slideshare' => { url => 'http://public.slidesharecdn.com/images/layout-09/header_logo.png',
								width => 149,
								height => 42,
								alt => 'Slideshare'
								},
				'skype' => { url => 'https://developer.skype.com/Download/SkypeIcons?action=AttachFile&do=get&target=SkypeBlue_32x32.png',
							width => 32,
							height => 32,
							alt => 'Skype'
							}, 
				'aim'   => { url => 'http://cdn.aim.com/i/redesign/aim_brand7.gif',
				             width => 160,
							 height => 72,
							 alt => 'AOL Instant Messenger'
							 },
			     'xbox'  => { url => 'http://www.xbox.com/xweb/xbox/xboxV2/images/xboxLogo.png',
				             width => 108,
							 height => 33,
							 alt => 'XBOX'
							 },
				'telnic' => { url => 'http://telnic.org/images/footer-telnic-logo.jpg',
					          width => 71,
							  height => 25,
							  alt => 'TELNIC LTD'
						  }
	);
	return \%icon;
}


sub breadcrumbs {
	# Programming Republic of Perl http://www.perl.org
	# I don't play golf: http://codegolf.com/
	my $domain = shift;
	my @domain = split(/\./, $domain);
	my $many   = @domain;
	my $orig   = $domain[$many-2] . '.tel';
	pop(@domain); pop(@domain);
	@domain = reverse @domain;
	my @sub;
	while(@domain) {
		my $sub = pop(@domain);
		my $puny = decode_punycode($sub);
		my $url = join('.', $sub, reverse(@domain), $orig);
		$sub = qq{<a href="$proxy$url" title="$url">$puny</a>};
		push(@sub, $sub);
	}
	my $sub = qq{<a href="$proxy$orig" title="$orig">$orig</a>};
	push(@sub, $sub);
	my $link = join(" &raquo; ", reverse @sub);
	$link .= '<br/>' . qq{<!-- AddThis Button BEGIN -->
	<a class="addthis_button" href="http://www.addthis.com/bookmark.php?v=250&amp;username=xa-4b9ae7a04eb37f4d"><img src="http://s7.addthis.com/static/btn/v2/lg-share-en.gif" width="125" height="16" alt="Bookmark and Share" style="border:0"/></a><script type="text/javascript" src="http://s7.addthis.com/js/250/addthis_widget.js#username=xa-4b9ae7a04eb37f4d"></script>
	<!-- AddThis Button END -->};
	return $link;
}

sub checkout {
	my $google = qq{
	<p><small>This custom proxy Perl script for TEL domains can be customized for your own domain, under any templates. You are purchasing the installation of the script on your domain. The script is public domain. We sell the installation for US \$100.</small></p>
	<form action="https://checkout.google.com/api/checkout/v2/checkoutForm/Merchant/313727564836749" id="BB_BuyButtonForm" method="post" name="BB_BuyButtonForm" target="_top">
	<p>
	<input name="item_name_1" type="hidden" value="Custom Perl Proxy Script for TEL Domains"/>
	<input name="item_description_1" type="hidden" value="This custom proxy Perl script for TEL domains can be customized for your own domain, under any templates. You are purchasing the script in the form as it is displayed here. The script is public domain. We sell it for US \$100."/>
	<input name="item_quantity_1" type="hidden" value="1"/>
	<input name="item_price_1" type="hidden" value="100.0"/>
	<input name="item_currency_1" type="hidden" value="USD"/>
	<input name="shopping-cart.items.item-1.digital-content.description" type="hidden" value="Simply download this script. You, as paying client, will get preferential treatment and you can request new features, such as advertising or anything, to be added on your request. We will consider your inquiry."/>
	<input name="shopping-cart.items.item-1.digital-content.url" type="hidden" value="http://www.teldomaintel.com/files/JLouisBiz.txt"/>
	<input name="_charset_" type="hidden" value="utf-8"/>
	<input alt="" src="https://checkout.google.com/buttons/buy.gif?merchant_id=313727564836749&amp;w=117&amp;h=48&amp;style=trans&amp;variant=text&amp;loc=en_US" type="image"/>
	</p>
	</form>
	};
}


sub label {
	my ($service, $record) = @_;
	my $label;
	given($service) {
		when(/voice:tel/) { $label = 'Phone'; $record =~ s/!(.*!)(tel:)(.*)!/<a href="callto:$3">$3<\/a>/; }
		when(/voice:skype/) { $label = 'Skype'; $record =~ s/!(.*!)(skype:)(.*)!/<a href="$2$3?call">$3<\/a>/;  }
		when(/voice:gtalk/) { $label = 'Google Talk' }
		when(/web:http$/) { $label = 'Web'; $record =~ s/!(.*!)(http:\/\/|)(.*)!/<a href="http:\/\/$3">$3<\/a>/; }
		when(/web:https$/) { $label = 'Secure Web'; $record =~ s/!(.*!)(https:\/\/|)(.*)!/<a href="https:\/\/$3">$3<\/a>/; }
		when(/fax:tel/) { $label = 'Fax'; $record =~ s/!(.*!)(tel:)(.*)!/$3/; }
		when(/im:skype/) { $label = 'Skype'; $record =~ s/!(.*!)(skype:)(.*)!/<a href="$2$3?chat">$3<\/a>/; }
		when(/im:icq/) { $label = 'ICQ Messenger'; $record =~ s/!(.*!)(icq:)(.*)!/<a href="$2$3">$3<\/a>/; }
		when(/im:aim/) { $label = 'AOL Messenger'; $record =~ s/!(.*!)(aim:)(.*)!/<a href="aim:goim?screenname=$3">$3<\/a>/; }
		when(/im:ymsgr/) { $label = 'Yahoo Messenger' }
		when(/im:gtalk/) { $label = 'Google Talk Messenger' }
		when(/im:msnim/) { $label = 'MSN Instant Messenger'; $record =~ s/!(.*!)(msnim:)(.*)!/<a href="msnim:chat?contact=$3">$3<\/a>/; }
		when(/email:mailto/) { $label = 'E-mail'; $record =~ s/!(.*!)(mailto:|)(.*)!/<a href="mailto:$3">$3<\/a>/; }
		when(/sms:mailto/) { $label = 'SMS by E-mail' }
		when(/sms:tel/) { $label = 'SMS Phone'; $record =~ s/!(.*!)(tel:)(.*)!/<a href="sms:$3">$3<\/a>/; }
		when(/ems:mailto/) { $label = 'EMS by E-mail' }
		when(/mms:mailto/) { $label = 'MMS by E-mail' }
		when(/mms:tel/) { $label = 'MMS Phone' }
		when(/ems:tel/) { $label = 'EMS Phone' }
		when(/ft:ftp/) { $label = 'FTP Server' }
		when(/user:data/) { $label = 'Username'; $record =~ s/!(.*!)(data:,)(.*)!/$3/; }
		when(/note:data/) { $label = 'Note'; 
			if($record =~ /!.*!data:;base64,.*!/) {
				$record =~ s/!(.*!)(data:;base64,)(.*)!/$3/;
				$record = MIME::Base64::decode_base64($record);
				utf8::upgrade($record);
				utf8::decode($record);
			} else {
				$record =~ s/!(.*!)(data:,)(.*)!/$3/;
			}
		}
		when(/^photo:http$/) { $label = 'Photo'; $record =~ s/!(.*!)(http:\/\/.*)!/<img src="$2" width="78" height="78" style="float: left; border-style: none; padding: 0.7em;" alt="$label"\/>/; }
		when(/^photo:https$/) { $label = 'Photo'; $record =~ s/!(.*!)(https:\/\/.*)!/<img src="$2" width="78" height="78" style="float: left; border-style: none; padding: 0.7em;" alt="$label"\/>/; }
		when(/^h323$/) { $label = 'H323' }
		when(/^sip$/) { $label = 'SIP Phone' }
		default { $label = "℡℡℡ Program Debug ℡℡℡" }
	}
	return ($label, $record);
}


sub location {
	my $location = shift;
	given($location) {
		when(/^main$/) { $location = 'Main' }
		when(/^home$/) { $location = 'Home' }
		when(/^work$/) { $location = 'Work' }
		when(/^mobile$/) { $location = 'Mobile' }
		when(/^transit$/) { $location = 'In Transit' }
		when(/^prs$/) { $location = 'Premium' }
		default { $location = '' }
	}
	return $location;
}

sub puny {
	my @puny = @_;
	for(@puny) { $_ = decode_punycode($_) }
	my $puny = join('.', @puny);
	return $puny;
}

sub service {
	my ($service, $record) = @_;
	my $label = '';
	my $location = '';
	my @chunks = split(/\+x-/, $service);
	my $nr = @chunks;
	my $member = join(" ", @chunks);
	if($nr == 1) { 
		$service = $chunks[0]; 
		my @temp = split(/\+/, $service); 
		$service = $temp[1]; 
		($label, $record) = label($service, $record); 
		$location = ''; 
	}
	if($nr == 2) {
		if($chunks[0] eq 'E2U') {
			$service = $chunks[1];
			($label, $record) = label($service, $record);
		} else {
			my $part = $chunks[0];
			my @part = split(/\+/, $part);
			$service = $part[1];
			$location = location($chunks[1]);
			if($chunks[1] =~/^lbl:(.*)/) {
				$label = $chunks[1];
				$label =~ s/^lbl:(.*)/$1/;
				$label =~ s/-/ /g;
				my $baslabel; ($baslabel, $record) = label($service, $record);
			} else {
				($label, $record) = label($service, $record);
			}
		}
		unless($label) { $label = label($service); }
	}
	if($nr == 3) {
		if($chunks[0] eq 'E2U') {
			$service = $chunks[1];
			($label, $record) = label($service, $record);
		} else {
			my $part = $chunks[0];
			my @part = split(/\+/, $part);
			$service = $part[1];
			$location = location($chunks[1]);
			if($chunks[1]) {
				$label = $chunks[1];
				$label =~ s/^lbl:(.*)/$1/;
				$label =~ s/-/ /g;
			}
			my $baslabel; ($baslabel, $record) = label($service, $record);
		}
		$location = location($chunks[2]);
	}
	if($nr == 4) {
		$service = $chunks[1];
		$label = $chunks[2];
		$label =~ s/^lbl:(.*)/$1/;
		$label =~ s/-/ /g;
		$location = location($chunks[3]);
		my $baslabel; ($baslabel, $record) = label($service, $record);
	}
	return ($service, $label, $location, $record);
}


sub adsense {
	my $sense = qq{<script type="text/javascript"><!--
	google_ad_client = "pub-5470909526096120";
	/* 120x90, created 3/12/10 */
	google_ad_slot = "5792128595";
	google_ad_width = 120;
	google_ad_height = 90;
	//-->
	</script>
	<script type="text/javascript"
	src="http://pagead2.googlesyndication.com/pagead/show_ads.js">
	</script>};
	return $sense;
}

sub adsense_links {
	my $sense = qq{<script type="text/javascript"><!--
	google_ad_client = "pub-5470909526096120";
	/* 468x15, created 3/12/10 */
	google_ad_slot = "1661800386";
	google_ad_width = 468;
	google_ad_height = 15;
	//-->
	</script>
	<script type="text/javascript"
	src="http://pagead2.googlesyndication.com/pagead/show_ads.js">
	</script>};
	return $sense;
}