package mkxhtml;

BEGIN {
	use Exporter   ();
	our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
	$VERSION = 0.04;
	@ISA = qw(Exporter);
	@EXPORT = qw(&parse &parsef);
	@EXPORT_OK = qw(%G $trusted &parsep);
}

our($trusted,%G);

my $maxdepth = 10;
$trusted = 0;
%G = %ENV;
$G{VERSION} = 'mkXhtml '.$VERSION;
$G{VNUM} = $VERSION;

sub parse;  #parse the argument
sub parsef; #parse file given as string arg
sub parsep; #parse paragraph given in $_

###############################################################
# End of interface
###############################################################

sub parset; #parse list

sub sspace {
	local $_ = shift;
	s/ /#7/g;
	$_;
}

sub mktag {
	local $_ = shift;
	s/\\ /#7/g;
	s/(".*?")/sspace $1/eg;
	my ($t,@r) = split / /;
	$t = 'p' unless defined $t && $t ne '';
	my @cls;
	my $o = '<'.$t;
	$o .= ' id="'.(shift @r).'"' if ($r[0] && !($r[0] =~ /^\.|=/));
	for (@r) { 
		if (/=/) {
			$o .= " $_"
		} else {
			s/^\.//;
			push @cls, $_;
		}
	}
	$o .= ' class="'.join(' ',@cls).'"' if @cls;
	(unhash($o),"</$t>");
}

sub parse {
	local $_ = shift;
	s/#/#0/g;
	s/\\\\/#9/g;
	s/\\{/#1/g;
	s/\\;/#2/g;
	s/\\}/#3/g;
	s/\\\[/#4/g;
	s/\\\]/#5/g;
	s/\\\$/#6/g;
	s/\\&/#8/g;
	s/\\>/#a/g;
	s/\\</#b/g;
	my @l = split /([\[\$\]{;}])/;
#print "<!-- $_ -->\n";
	parset \@l;
}

sub revhash {
	local $_ = shift;
	s/#1/\\{/g;
	s/#2/\\;/g;
	s/#3/\\}/g;
	s/#4/\\[/g;
	s/#5/\\]/g;
	s/#6/\\\$/g;
	s/#7/\\ /g;
	s/#8/\\&/g;
	s/#9/\\\\/g;
	s/#a/\\>/g;
	s/#b/\\</g;
	s/#0/#/g;
	$_
}

sub unhash {
	local $_ = shift;
	s/#1/{/g;
	s/#2/;/g;
	s/#3/}/g;
	s/#4/[/g;
	s/#5/]/g;
	s/#6/\$/g;
	s/#7/ /g;
	s/#8/&amp;/g;
	s/#9/\\\\/g;
	s/#a/&gt;/g;
	s/#b/&lt;/g;
	s/#0/#/g;
	$_
}

sub safeeval {
	return unless $trusted;
	local ($_,$/,$|,$\,$,,$.,$[,$],%SIG);
	$_[0] =~ /^([\0-\xff]*)/;
#	print "<!--perl code '$1'-->";
	eval $1;
}

sub parset {
	my @l = @{+shift};
	my @ts;
#my $ssubgo = shift;
	my $n = 0;

	while ($n < @l) {
		$_ = $l[$n++];
		/{/ ? do {
			my $t = $l[$n++];
		#perl and html do not parse the inside
			if ($t eq 'perl' || $t eq 'html') {
				my $p = '';
				my $s = 1;
				$n++ if $l[$n] eq ';';
				while ($s && $n < @l) {
					my $c = revhash $l[$n++];
					$s++ if $c eq '{';
					$s-- if $c eq '}';
					$p .= $c if $s;
				}
				$t eq 'perl' ? safeeval $p : print $p;
				next;
			} 

			my ($o,$c) = $t eq '' ? @ts ? @{$ts[0]}[2,3] : ('<p','</p>') : mktag $t;
			my $tse = [$c,';','<span','</span>'];
			
		#self-closing tags are also an exception
			if ($l[$n] eq '}') {
				print "$o />";
				$n++;
				next;
			} 
			$o .= '>';
			if ($t =~ /^ul( |$)/) {
				$o .= '<li>';
				@$tse[0,1] = ('</li></ul>','</li><li>');
			} elsif ($t =~ /^table( |$)/) {
				@$tse[1,2,3] = (';','<tr><td','</td></tr>');
			} elsif ($c eq '</td></tr>') {
				$$tse[1] = '</td><td>';
			} elsif ($t =~ /^img( |$)/) {
				$o =~ s/>$/ src="/;
				@$tse[0,1] = ('" />', '" alt="');
			} elsif ($t eq '!') {
				$o = '<!--';
				$tse = ['-->',';','{','}'];
			}
			print $o;
			unshift @ts,$tse;
			$n++ if $l[$n] eq ';';
		}: /[]}]/ ? do {
			my $c = shift @ts;
			print $$c[0];
			unless (@ts) {
				my ($N,$nws) = $n;
				while (++$N < @l && !$nws) {
					$nws++ if $l[$N] =~ /\S/;
				}
				if ($nws) {
					print "<!-- Syntax error -->";
					warn "XSHTML Syntax Error";
					return;
				}
			}
		}: /\[/ ? do {
			my ($link,$rest) = split /\s+/, $l[$n++], 2;
			my ($o,$c) = mktag 'a href="'.$link.'" '.(defined $rest ? $rest : '');
			#$link = unhash $link;
			print $o.'>';
			if ($l[$n] eq ']') {
				print "$link</a>";
				$n++;
			} else {
				unshift @ts, ['</a>',';','<span','</span>'];
				$n++ if $l[$n] eq ';';
			}
		}: /;/ ? do {
			print $ts[0][1];
		}: /\$/ ? do {
			if ($l[$n] eq '{') {
				$n++;
				my $v = unhash $l[$n++];
				print exists $G{$v} ? $G{$v} : '${'.$v.'}';
				$n++ if $l[$n] eq '}';
			} else {
				$l[$n] =~ s/^([A-Za-z0-9_]+)//;
				print exists $G{$1} ? $G{$1} : '$'.$1;
			}
		}: print unhash $_;
	}
	print $$_[0] for @ts;
}

sub parsep {
	my ($lmode);
	return if /^#[;!]/;
	if (/^(.*?);/) {
		$1 eq 'import' and do {
			/;\s+(.*)\n+$/;
			parsef $1;
			return;
		};
		$1 eq 'include' and do {
			/;\s+(.*)\n+$/;
			my $fh;
			open $fh, $1;
			print while <$fh>;
			close $fh;
			return;
		};
	} else {
		$_ = ';'.$_;
	}
	s/(\n+)$/}$1/;
	parse '{'.$_;
}

sub parsef {
	unless ($maxdepth--) {
		print "<!-- Maximum import depth reached at file $_ -->";
		warn "Maximum import depth reached at file $_\n";
	} else {
		local $/ = '';
		my $fh;
		open $fh, $_[0] or print STDERR "Error opening file $_[0]: $!";
		parsep while <$fh>;
		close $fh;
	}
	$maxdepth++;
}

1;