#!/usr/bin/perl -wT

use strict;
use CGI::Carp qw( fatalsToBrowser set_message);                                        
use CGI;
use Mail::Sendmail;

# Access to html file under docroot from web will be blocked 
# so long as RewriteEngine is running (look in .htaccess)
my $mailparamfile="/mailparam.html";
my $atsmotto="spoil";
my %mailparam=(
	'maildomain' => 'Crusius.de', 
	'msgdist' => 'msg-dist@friz.net',
	'defsender' => 'mailform@csec.de',
	'emptymsg' => 'Please enter a message!',
	'successmsg' => 'Your message has been received.',
	'failuremsg' => 'Your message has not been received.',
	'tnxforspam' => 'Thank you for sending spam!',
	'senderads' => 'Sender address input:'
);

my $errorparamfile="/errorparam.html";
my %errorparam=(
	'error' => 'Error',
	'oops' => 'Oops! Content missing or invalid link! :-/'
);

BEGIN {
        sub errmsg {
                my $msg = shift;
                print "<h1>Script error</h1>";
                print "<p>$msg</p>";
        }
        set_message(\&errmsg);
}

sub slurp_indexfile;
sub process_contextlink;
sub parse_defaultindexpage;
sub slurp_mailparam;
sub slurp_errorparam;
sub get_errormsg;
sub make_theme_href;
sub make_theme_active;
sub send_kontakt_mail;
sub make_statnavipos;
sub make_theme_path;
sub make_theme_indexpath;
sub make_page_href;
sub parse_gallery;
sub redirect_http;

my $q = new CGI;
my ($content, $contentfile, $failmsg);
my $index = "";
my $emptyindex = "&nbsp;"; # Navy sidebar for email form, if not empty
# meta description tag from <!-- <description>(...)</description> --> content comment
my $meta_description = ""; 
# stylesheet tag from <!-- <stylesheet>(...)</stylesheet> --> content comment
my @stylesheets;
my $theme = $q->param("th");
my $subtheme = $q->param("sth");
my $page = $q->param("pg");
my $defaulttheme = "home";
my $defaultpage = "default";
my $defaultindexpage;
my %pages; # Page map
my %themes; # Theme map
my %subthemes; # Subtheme map
my %themespages; # Theme to default page map
# Headline from <!-- <headline>(...)</headline> --> index comment
my $themeheadline;

if (!$theme) {
	# Called from docroot, new session?
	parse_defaultindexpage($defaulttheme);
	$page = $themespages{$defaulttheme};
	if ($page) {
		redirect_http("/$defaulttheme/$page.html");
	} else {
		redirect_http("/$defaulttheme.html");
	}
	exit 0;
}

if ($theme eq "contact") {
	send_kontakt_mail;
} else {
	$defaultindexpage = slurp_indexfile();
	$page or $page = $defaultpage;
	$contentfile = make_theme_path($page);
}

if ($contentfile) {
	# Check extra conditions, gallery?
	my %imagehash = parse_gallery;
	my $ctx;
	if (open($ctx, "< $contentfile")) {
		if (scalar keys %imagehash > 0) {
			my ($img, $max, $prev, $next, $imgpath, $imgname);
			$img = $q->param("img");
			if (!$img) { $img="1"; }
			$max = scalar keys %imagehash;
			$prev = $img - 1;
			$next = $img + 1;
			if ($prev < 1) { $prev = $max; }
			if ($next > $max) { $next = 1; }
			$imgpath = $imagehash{$img} . $img . ".jpg";
			$imgname = $imagehash{$img};
			$imgname =~ /([\w_]+)$/;
			$imgname = $1;
			$imgname =~ s/_/ /g;
			# Parse for gallery tags
			foreach (<$ctx>) {
				s/\$imgname/$imgname/g;
				s/\$imgpath/$imgpath/g;
				s/\$imgprev/\/$theme\/$page\/$prev.html/g;
				s/\$imgnext/\/$theme\/$page\/$next.html/g;
				$content = $content . $_;
			}
		} else {
			$content = "";
			while (!$content) {
				my $l = <$ctx>;
				if ($l =~ /^\s*<!--\s*<\s*(\w+)\s*>([^<>]*)<\s*\/\s*\1\s*>\s*-->\s*$/) {
					if ($1 eq "description") {
						$meta_description = $2;
					} elsif ($1 eq "stylesheet") {
						@stylesheets = (@stylesheets, $2);
					}
				} else {
					$content = $l;
				}
			}
			# just slurp the rest
			$content .= do { local $/, <$ctx> };
		}
		close($ctx);
	} else {
		$content = get_errormsg('oops');
	}
}

if ($failmsg) {
	$content = $content . "<br><br>" . get_errormsg('error') . ": " . $failmsg;
}

print $q->header( -type => "text/html", -expires => "+1m" );

my ($frame, $framefile);
open($framefile, "< ./frame.html") or die "Cannot open frame\n";
foreach (<$framefile>) {
	if (/^\s*<\s*meta\s+name\s*=\s*\"\s*description\s*\".*>\s*$/) {
		if ($meta_description) {
			$_ = "<meta name=\"description\" content=\"$meta_description\">\n";
		}	
	} elsif (/^\s*<!--\s*<\s*(\w+)\s*>([^<>]*)<\s*\/\s*\1\s*>\s*-->\s*$/) {
		if ($1 eq "stylesheets") {
			my $stylesheet;
			$_ = "";
			foreach $stylesheet (@stylesheets) {
				$_ .= "<LINK REL=\"stylesheet\" TYPE=\"text/css\" HREF=\"$stylesheet\" TITLE=\"Default\">\n";
			}
		}
	} elsif (/\$statnavi_(\w+)__([\w\&\;\ö\Ö\ü\Ü\ä\Ä\ß_]+)/) {
		my $href;
		my ($a, $b, $c) = ($1, $2, $2);
		$b =~ s/_/ /g;
		$themes{$a} = $b;
		if ($a eq $theme) {
			if ($defaultindexpage && !$subtheme) {$themespages{$a} = $defaultindexpage; }
			$href = "<span>" . make_theme_active($a) . "</span>&nbsp;";
		} else {
			parse_defaultindexpage($a);	
			$href = make_theme_href($a) . "&nbsp;";
		}
		s/\$statnavi_$a\__$c/$href/;
	} elsif (/\$statnavipos/) {
		my $statnavipos;
		if ($themeheadline) {
			$statnavipos = $themeheadline;
		} else {
			$statnavipos = make_statnavipos();
		}
		s/\$statnavipos/$statnavipos/g;
	} elsif (/\$contextcell/) {
		if (!$index) { $index = $emptyindex; }
		s/\$contextcell/$index/g;
	} else {
		s/\$content/$content/g;
	}
	$frame = $frame . $_;
}
close($framefile);

print $frame;

sub slurp_indexfile {
	# Try to slurp index
	my $idx;
	my $defp;
	if (open($idx, "< " . make_theme_path("index"))) {
		foreach (<$idx>) {
			if (/^\s*<!--\s*<\s*(\w+)\s*>([^<>]*)<\s*\/\s*\1\s*>\s*-->\s*$/) {
				if ($1 eq "headline") {
					$themeheadline = $2;
					if (!$themeheadline) { $themeheadline = " "; }
				} elsif ($1 eq "subtheme") {
					$2 =~ /([a-z|A-Z|0-9]+)__([\w\&\;\ö\Ö\ü\Ü\ä\Ä\ß_]+)/;	
					$subthemes{$1} = $2;
				}
				$_ = "";
			} elsif (/\$context_(\w+)__([\w\&\;\ö\Ö\ü\Ü\ä\Ä\ß_]+)/) {
				my @args = ($_, $1, $2, $2);
				if (!$contentfile) { $defp = $1; }
				$_ = process_contextlink(@args);
			} elsif (/\$context_(\w+):(\w+)__([\w\&\;\ö\Ö\ü\Ü\ä\Ä\ß_]+)/) {
				my @args = ($_, $2, $3, $3, $1);
				if (!$contentfile) { $defp = $2; }
				$_ = process_contextlink(@args);
			}
			$index = $index . $_;	
		}
		close($idx);
	} 
	else { $index = "&nbsp;"; }
	return $defp;
}

sub process_contextlink {
	my $href;
	# $a: page, $b: pagename, $c: copy of pagename, $d: subtheme
	my ($line, $a, $b, $c, $d) = @_;
	$b =~ s/_/ /g;
	$pages{$a} = $b;
	if (!$contentfile) {
		$contentfile = make_theme_path($a, $d);
		if (!$page) { $page = $a; }
	}
	if ($a eq $page) {
		$line =~ s/FlexNaviActivate/FlexNaviActive/;
		$href = make_page_active($a);
	} else {
		$href = make_page_href($a, $d);
	}
	if ($d) {
		$line =~ s/\$context_$d\:$a\__$c/$href/;
	} else {
		$line =~ s/\$context_$a\__$c/$href/;
	}
	return $line;
}

sub parse_defaultindexpage {
	my $idx;
	my $theme = shift;
	if (open($idx, "< " . make_theme_indexpath($theme))) {
		foreach (<$idx>) {
			if (/\$context_(\w+)__/) {
				$themespages{$theme} = $1;
				last;
			}
		}
		close($idx);
	}
}

sub slurp_mailparam {
	my $mf;
	if (open($mf, "< .$mailparamfile")) {
		foreach (<$mf>) {
			if (/^(defsender|msgdist) +(\S+) +at +(\w+) +dot +(\w+)/) {
				# somewhat spamsafe email-ads
				$mailparam{$1} = $2 . '@' . $3 . '.' . $4;
			} elsif (/^(\w+) +(\S.*\S)\s*/) {
				$mailparam{$1} = $2;
			}
		}
		close($mf);
	}
} 

sub slurp_errorparam {
	my $mf;
	if (open($mf, "< .$errorparamfile")) {
		foreach (<$mf>) {
			if (/^(\w+) +(\S.*\S)\s*/) {
				$errorparam{$1} = $2;
			}
		}
		close($mf);
	}
} 

sub get_errormsg {
	my $parm = shift;
	slurp_errorparam;
	return $errorparam{$parm};
}

sub make_theme_href {
	my $th = shift;
	my $theme = $themes{$th};
	my $page = $themespages{$th};
	if (!$theme) { $theme = $th; }
	my $httplink = "/$th";
	if ($page) { $httplink .= "/$page"; }
	my $href = "<a href=\"$httplink.html\">$theme</a>";
	return $href;
}

sub make_theme_active {
	my $th = shift;
	my $theme = $themes{$th};
	if (!$theme) { $theme = $th; }
	return $theme;
}

sub make_subtheme_active {
	my $th = shift;
	my $theme = $subthemes{$th};
	if (!$theme) { $theme = $th; }
	return $theme;
}

sub make_page_href {
	my ($pg, $subth) = @_;
	my $page = $pages{$pg};
	my $href;
	if (!$page) { $page = $pg; }
	#$page =~ s/ /·/g;
	if ($subth) {
		$href = "<a href=\"/$theme/$subth/$pg.html\">$page</a>";
	} else {
		$href = "<a href=\"/$theme/$pg.html\">$page</a>";
	}
	return $href;
}

sub make_subtheme_href {
	my ($pg, $subth) = @_;
	my $subtheme = $subthemes{$subth};
	my $href;
	if (!$subtheme) { $subtheme = $subth; }
	$subtheme =~ s/ /·/g;
	$href = "<a href=\"/$theme/$subth/$pg.html\">$subtheme</a>";
	return $href;
}

sub make_page_active { 
	my $pg = shift;
	my $page = $pages{$pg};
	if (!$page) { $page = $pg; }
	return "<span>" . $page . "</span>";
}

sub make_statnavipos {
	my $statnavipos;
	# if the theme is not the start theme, add a link to start
	if ($theme ne $defaulttheme) {
		$statnavipos = make_theme_href($defaulttheme) . " &gt; ";
	} else {
		$statnavipos = "";
	}
	my $noPage = (!$page or $page eq $defaultpage or $defaultindexpage and $page eq $defaultindexpage);
	if ($noPage and !$subtheme) {
		# Return empty string here if position not wanted at theme start
		# return "";
		$statnavipos .= make_theme_active($theme);
	} else {
		$statnavipos .= make_theme_href($theme);
	}
	if ($subtheme) {
		if ($noPage or !$defaultindexpage) {
			$statnavipos .= " &gt; " . make_subtheme_active($subtheme);
		} else {
			$statnavipos .= " &gt; " . make_subtheme_href($defaultindexpage, $subtheme);
		}
	}
	if ($page and $defaultindexpage) {
		$statnavipos .= " &gt; " . make_page_active($page);
	}
	return $statnavipos;
}

sub send_kontakt_mail {
	my $emailads = $q->param("email-ads");
	my $msg = $q->param("msg");
	my $snd = $q->param("sndmail");
	my $ats = $q->param("ats");
	# Check if docroot contains mail configuration file
	slurp_mailparam();
	if (!$msg) {
		$contentfile = "./misc/" . $theme . ".html";
		if ($snd) {
			$failmsg = $mailparam{'emptymsg'};
		}
	} elsif ($ats eq $atsmotto) {
	     	if ($emailads =~ /(\S.*\S)/) {
			$emailads = $mailparam{'senderads'} . " " . $1 . "\n\n";
		} else {
			$emailads = "";
		}
		my %mail = ( To      => $mailparam{'msgdist'},
			From    => $mailparam{'defsender'},
			Subject => $mailparam{'maildomain'},
			Message => 'From: ' . $q->remote_host() . ", " . $q->user_agent() . "\n\n" . $emailads . $msg );
		if (sendmail(%mail)) { 
			$content = "<br><br><br>" . $mailparam{'successmsg'};
		} else {
			$contentfile = "./misc/" . $theme . ".html";
			$failmsg = $mailparam{'failuremsg'} . $Mail::Sendmail::error;
		}
	} else {
		$content = "<br><br>" . $mailparam{'tnxforspam'};
	}
}

sub make_theme_path {
	my ($page, $subth) = @_;
	if (!$subth) {
		$subth = $subtheme;
	}
	my $ret;
	if ($subth) {
		$ret = "./content/$theme/$subth/" . $page . ".html";
	} else {
		$ret = "./content/$theme/" . $page . ".html";
	}
	return $ret;
}

sub make_theme_indexpath {
	return "./content/" . shift(@_) . "/index.html";
}

sub parse_gallery {
	my %imagehash;
	return %imagehash unless $page;
	my $ordinal;
	my $name;
	my $themedir = make_theme_path("$page");
	$themedir =~ s/\.html$//;
	if (-d $themedir) {
		foreach (<$themedir/*.jpg>) {
			if (/([0-9]+)\.jpg$/) {
				$ordinal = $1;
				/\.(.*)$1\.jpg$/;
				$imagehash{$ordinal} = $1;
			}
		}
	}
	return %imagehash;
}

sub redirect_http {
	my $newurl = shift;
        print $q->redirect(-uri => $newurl, -nph => 0);
        print $q->start_html('Redirection page');
        print $q->end_html();
}