# bsta_lib.pm is generated from bsta_lib.1.pm
# 
# Library of functions
#
# Copyright (C) 2016, 2017, 2019, 2020, 2022, 2023  Balthasar Szczepański
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU Affero General Public License as
# published by the Free Software Foundation, either version 3 of the
# License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU Affero General Public License for more details.
#
# You should have received a copy of the GNU Affero General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.

package bsta_lib;

use strict;
#use warnings

use utf8;
use Exporter;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);

###PERL_EXPORT_VERSION: our $VERSION = 'x.x.x';
our @ISA         = qw(Exporter);
our @EXPORT      = ();
our @EXPORT_OK   = (
	'STATE',
	'entityencode', # TO REMOVE
	'failpage', 'fail_method', 'fail_content_type',
	'gethttpheader', 'getcgi', # TO REMOVE
	'urldecode', # TO REMOVE
	'readdatafile', 'writedatafile', 'printdatafile',
	'printdatafileht', # TO REMOVE ???
	'urlencode', # TO REMOVE
	'linehtml', # TO REMOVE
	'bb2ht', 'bb2bb'
);

###PERL_LIB: use lib /botm/lib/bsta
use botm_common (
	'url_query_decode', 'url_query_encode',
	'url_decode', 'url_encode',
	'html_entity_encode_dec',
	'merge_url',
	'read_header_env',
	'read_data_file', 'write_data_file'
);

###PERL_CGI_GOTO_PATH:      CGI_GOTO_PATH      = /bsta/g
###PERL_CGI_LOGO_PATH:      CGI_LOGO_PATH      = /bsta/botmlogo.png

###PERL_WEBSITE:            WEBSITE            = 1190.bicyclesonthemoon.info


# TO REMOVE
use constant entitycode => {
	'amp' => '&',
	'gt' => '>',
	'lt' => '<',
	'quot' => '"',
	'acute' => '´',
	'cedil' => '¸',
	'circ' => 'ˆ',
	'macr' => '¯',
	'middot' => '·',
	'tilde' => '˜',
	'uml' => '¨',
	'Aacute' => 'Á',
	'aacute' => 'á',
	'Acirc' => 'Â',
	'acirc' => 'â',
	'AElig' => 'Æ',
	'aelig' => 'æ',
	'Agrave' => 'À',
	'agrave' => 'à',
	'Aring' => 'Å',
	'aring' => 'å',
	'Atilde' => 'Ã',
	'atilde' => 'ã',
	'Auml' => 'Ä',
	'auml' => 'ä',
	'Ccedil' => 'Ç',
	'ccedil' => 'ç',
	'Eacute' => 'É',
	'eacute' => 'é',
	'Ecirc' => 'Ê',
	'ecirc' => 'ê',
	'Egrave' => 'È',
	'egrave' => 'è',
	'ETH' => 'Ð',
	'eth' => 'ð',
	'Euml' => 'Ë',
	'euml' => 'ë',
	'Iacute' => 'Í',
	'iacute' => 'í',
	'Icirc' => 'Î',
	'icirc' => 'î',
	'Igrave' => 'Ì',
	'igrave' => 'ì',
	'Iuml' => 'Ï',
	'iuml' => 'ï',
	'Ntilde' => 'Ñ',
	'ntilde' => 'ñ',
	'Oacute' => 'Ó',
	'oacute' => 'ó',
	'Ocirc' => 'Ô',
	'ocirc' => 'ô',
	'OElig' => 'Œ',
	'oelig' => 'œ',
	'Ograve' => 'Ò',
	'ograve' => 'ò',
	'Oslash' => 'Ø',
	'oslash' => 'ø',
	'Otilde' => 'Õ',
	'otilde' => 'õ',
	'Ouml' => 'Ö',
	'ouml' => 'ö',
	'Scaron' => 'Š',
	'scaron' => 'š',
	'szlig' => 'ß',
	'THORN' => 'Þ',
	'thorn' => 'þ',
	'Uacute' => 'Ú',
	'uacute' => 'ú',
	'Ucirc' => 'Û',
	'ucirc' => 'û',
	'Ugrave' => 'Ù',
	'ugrave' => 'ù',
	'Uuml' => 'Ü',
	'uuml' => 'ü',
	'Yacute' => 'Ý',
	'yacute' => 'ý',
	'yuml' => 'ÿ',
	'Yuml' => 'Ÿ',
	'cent' => '¢',
	'curren' => '¤',
	'euro' => '€',
	'pound' => '£',
	'yen' => '¥',
	'brvbar' => '¦',
	'bull' => '•',
	'copy' => '©',
	'dagger' => '†',
	'Dagger' => '‡',
	'frasl' => '⁄',
	'hellip' => '…',
	'iexcl' => '¡',
	'image' => 'ℑ',
	'iquest' => '¿',
	'lrm' => '‎',
	'mdash' => '—',
	'ndash' => '–',
	'not' => '¬',
	'oline' => '‾',
	'ordf' => 'ª',
	'ordm' => 'º',
	'para' => '¶',
	'permil' => '‰',
	'prime' => '′',
	'Prime' => '″',
	'real' => 'ℜ',
	'reg' => '®',
	'rlm' => '‏',
	'sect' => '§',
	'shy' => '­',
	'sup1' => '¹',
	'trade' => '™',
	'weierp' => '℘',
	'bdquo' => '„',
	'laquo' => '«',
	'ldquo' => '“',
	'lsaquo' => '‹',
	'lsquo' => '‘',
	'raquo' => '»',
	'rdquo' => '”',
	'rsaquo' => '›',
	'rsquo' => '’',
	'sbquo' => '‚',
	'emsp' => ' ',
	'ensp' => ' ',
	'nbsp' => ' ',
	'thinsp' => ' ',
	'zwj' => '‍',
	'zwnj' => '‌',
	'deg' => '°',
	'divide' => '÷',
	'frac12' => '½',
	'frac14' => '¼',
	'frac34' => '¾',
	'ge' => '≥',
	'le' => '≤',
	'minus' => '−',
	'sup2' => '²',
	'sup3' => '³',
	'times' => '×',
	'alefsym' => 'ℵ',
	'and' => '∧',
	'ang' => '∠',
	'asymp' => '≈',
	'cap' => '∩',
	'cong' => '≅',
	'cup' => '∪',
	'empty' => '∅',
	'equiv' => '≡',
	'exist' => '∃',
	'fnof' => 'ƒ',
	'forall' => '∀',
	'infin' => '∞',
	'int' => '∫',
	'isin' => '∈',
	'lang' => '⟨',
	'lceil' => '⌈',
	'lfloor' => '⌊',
	'lowast' => '∗',
	'micro' => 'µ',
	'nabla' => '∇',
	'ne' => '≠',
	'ni' => '∋',
	'notin' => '∉',
	'nsub' => '⊄',
	'oplus' => '⊕',
	'or' => '∨',
	'otimes' => '⊗',
	'part' => '∂',
	'perp' => '⊥',
	'plusmn' => '±',
	'prod' => '∏',
	'prop' => '∝',
	'radic' => '√',
	'rang' => '⟩',
	'rceil' => '⌉',
	'rfloor' => '⌋',
	'sdot' => '⋅',
	'sim' => '∼',
	'sub' => '⊂',
	'sube' => '⊆',
	'sum' => '∑',
	'sup' => '⊃',
	'supe' => '⊇',
	'there4' => '∴',
	'Alpha' => 'Α',
	'alpha' => 'α',
	'Beta' => 'Β',
	'beta' => 'β',
	'Chi' => 'Χ',
	'chi' => 'χ',
	'Delta' => 'Δ',
	'delta' => 'δ',
	'Epsilon' => 'Ε',
	'epsilon' => 'ε',
	'Eta' => 'Η',
	'eta' => 'η',
	'Gamma' => 'Γ',
	'gamma' => 'γ',
	'Iota' => 'Ι',
	'iota' => 'ι',
	'Kappa' => 'Κ',
	'kappa' => 'κ',
	'Lambda' => 'Λ',
	'lambda' => 'λ',
	'Mu' => 'Μ',
	'mu' => 'μ',
	'Nu' => 'Ν',
	'nu' => 'ν',
	'Omega' => 'Ω',
	'omega' => 'ω',
	'Omicron' => 'Ο',
	'omicron' => 'ο',
	'Phi' => 'Φ',
	'phi' => 'φ',
	'Pi' => 'Π',
	'pi' => 'π',
	'piv' => 'ϖ',
	'Psi' => 'Ψ',
	'psi' => 'ψ',
	'Rho' => 'Ρ',
	'rho' => 'ρ',
	'Sigma' => 'Σ',
	'sigma' => 'σ',
	'sigmaf' => 'ς',
	'Tau' => 'Τ',
	'tau' => 'τ',
	'Theta' => 'Θ',
	'theta' => 'θ',
	'thetasym' => 'ϑ',
	'upsih' => 'ϒ',
	'Upsilon' => 'Υ',
	'upsilon' => 'υ',
	'Xi' => 'Ξ',
	'xi' => 'ξ',
	'Zeta' => 'Ζ',
	'zeta' => 'ζ',
	'crarr' => '↵',
	'darr' => '↓',
	'dArr' => '⇓',
	'harr' => '↔',
	'hArr' => '⇔',
	'larr' => '←',
	'lArr' => '⇐',
	'rarr' => '→',
	'rArr' => '⇒',
	'uarr' => '↑',
	'uArr' => '⇑',
	'clubs' => '♣',
	'diams' => '♦',
	'hearts' => '♥',
	'spades' => '♠',
	'loz' => '◊',
};

use constant STATE => {
	'inactive' => 0,
	'waiting'  => 1,
	'ready'    => 2,
	'end'      => 3,
};
use constant TEXT_MODE => {
	'normal' => 0,
	'bb'     => 1,
	'info'   => 2,
};

use constant tagsbb => {
	'ht'    => '',
	'/ht'   => '',
	'fq'    => '[quote]',
	'/fq'   => '[/quote]',
	'tq'    => '[quote]',
	'/tq'   => '[/quote]',
	'ni'    => '[color=#0057AF]',
	'/ni'   => '[/color]',
	'br'    => '[color=#BB6622]',
	'/br'   => '[/color]',
	'po'    => '[color=#FF8800]',
	'/po'   => '[/color]',
	'url'   => '[url]',
	'url='  => '[url=',
	'url/=' => ']',
	'/url'  => '[/url]',
	'i'     => '[i]',
	'/i'    => '[/i]',
	'list'  => '[list]',
	'list=' => '[list=',
	'list/='=> ']',
	'/list' => '[/list]',
	'*'     => '[*]',
	'/*'    => '[/*]',
	'?'     => '[unknown!]',
	'/?'    => '[/unknown!]',
};
use constant tagsht => {
	'ht'     => '',
	'/ht'    => '',
	'fq'     => '<div class="fq">',
	'/fq'    => '</div>',
	'tq'     => '<div class="tq">',
	'/tq'    => '</div>',
	'ni'     => '<span class="ni">',
	'/ni'    => '</span>',
	'br'     => '<span class="br">',
	'/br'    => '</span>',
	'po'     => '<span class="po">',
	'/po'    => '</span>',
	'url'    => '<a href="#">',#think: how to add selfincluding?
	'url='   => '<a href="',
	'url/='  => '">',
	'/url'   => '</a>',
	'i'      => '<i>',
	'/i'     => '</i>',
	'list'   => '<ul>',
	'list='  => '<ol style="list-style-type: ',
	'list=1' => 'decimal',
	'list=A' => 'upper-alpha',
	'list=a' => 'lower-alpha',
	'list=I' => 'upper-roman',
	'list=i' => 'lower-roman',
	'list/=' => '">',
	'/list'  => '</ul>',
	'/list=' => '</ol>',
	'*'      => '<li>',
	'/*'     => '</li>',
	'?'      => '[unknown!]',
	'/?'     => '[/unknown!]',
};



# Function to return an error page
# arguments: 1 - header fields, 2 - page title, 3 - error message, 4 method
sub failpage {
	(my $header, my $title, my $message, my $method) = @_;
	if($header ne ''){
		print $header;
	}
	if($method eq 'HEAD') {
		print "\n";
		return;
	}
	print "Content-type: text/html; charset=UTF-8\n\n";
	
	print '<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "">'."\n";
	print '<html lang="en"><head>'."\n";
	print '<meta http-equiv="Content-type" content="text/html; charset=UTF-8">'."\n";
	if ($title ne '') {
		print '<title>'.html_entity_encode_dec($title, 1).'</title>'."\n";
	}
	print '</head><body>'."\n";
	if ($title ne '') {
		print '<h1>'.html_entity_encode_dec($title, 1).'</h1>'."\n";
	}
	if ($message ne '') {
		print '<p>'.html_entity_encode_dec($message, 1).'</p>'."\n";
	}
	print '</body></html>'."\n";
}

sub fail_method {
	(my $method, my $allowed) = @_;
	
	my $header = "Status: 405 Method Not Allowed\n";
	if ($allowed ne '') {
		$header .= "Allow: $allowed\n";
	}
	return failpage(
		$header,
		"405 Method Not Allowed",
		"The interface does not support the $method method.",
		$method
	);
}

sub fail_content_type
{
	(my $content_type, my $method) = @_;
	
	return failpage(
		"Status: 415 Unsupported Media Type\n",
		"415 Unsupported Media Type",
		"Unsupported Content-type: $content_type.",
		$method
	);
}


# TO REMOVE
# function to encode entities, decimal, 
sub entityencode {
	(my $t, my $all) = @_;
	return html_entity_encode_dec($t, 1, $all);
}

# TO REMOVE
# function to get values of http header fields. Returns a hash. names of header
# fields are lowercase
sub gethttpheader {
	(my $env) = @_;
	
	return read_header_env($env);
}

# TO REMOVE
# The function to get CGI parameters from string.
# Format is: name=url_encoded_value&name=url_encoded_value& ... &name=url_encoded_value
sub getcgi {
	return url_query_decode($_[0]);
}

# TO REMOVE
# Function for decoding URL-encoded text
sub urldecode {
	return url_decode($_[0]);
}

# TO REMOVE
# Function to read data from datafiles.
# Very similar to http header file reading. (function readheaderfile() in proxy
# library)
# 
# Differences:
#
# 1. After field name and colon there must be exactly one whitespace (space or
# tab). Any other leading or trailing whitespace (but not the newline character
# at the end of the line) is treated as part of the field value.
#
# 2. Instead of colon an equal sign can be used. The number of whitespaces after
# it is then zero and not one.
#
# 3. When header field is split into multiple lines the next lines must start
# with exactly one whitespace (tab or space) Any other leading or trailing
# whitespace (but not the newline character at the end of the line) is treated
# as part of the field value. the lines will be joined with a newline between
# them.
#
# 4. When the same field name appears it replaces the previous one.
# 
# 5. Line separator is LF and not CR LF. The CR character is treated as part of
# the field value.
#
# 6. After the end of header (double newline) all next lines are treated as the
# value of the "content" field.
#
# Returns a hash containing the values.
# Names are case sensitive and are converted to lowercase
#
# Argument can be a path or a file handle. In case of a file handle it will just
# read the file. In case of path it opens the file before reading and closes
# after. On failure (file not open) returns empty hash.
# 
sub readdatafile {
	(my $datapath) = @_;
	
	return read_data_file($datapath);
}

# TO REMOVE
# the function to write data to datafiles (see readdatafile() description)
#
# First argument can be a path or a file handle. In case of a file handle it
# will just write the file. In case of path it opens the file before writing and
# closes after.
#
# On failure (file not open) returns 0.
# On success returns 1.
#
sub writedatafile {
	(my $headerpath, my %header) = @_;
	
	return write_data_file($headerpath, '', 0, \%header);
}

# TO REMOVE
# the function to print data to stdout (see readdatafile() description)
#
# On success returns 1.
#
sub printdatafile {
	(my %header) = @_;
	
	return write_data_file(\*STDOUT, '', 0, \%header);
}

# TO REMOVE
# the function to print data to stdout as html (see readdatafile() description)
#
# On success returns 1.
#
sub printdatafileht {
	(my %header) = @_;
	
	print_html_data(\*STDOUT, \%header);
	return 1;
}


# TO REMOVE
sub urlencode {
	(my $t, my $all) = @_;
	return url_encode($t, '', $all);
}

#analyse bbcode text to build tag tree #TODO make [/*] optional!
sub bbtree {
	(my $bb, my $printdebug) = @_;
	my %bbtree;
	my $ind;
	my $tag;
	my $tagname;
	my $tagvalue;
	my $tagend;
	my $level=0;
	my $pretext;
	my $debug;
	
	$ind="_";
	$level=0;
	$bbtree{"_.n"}="ht";
	$bbtree{"_.v"}='';
	$bbtree{"_.t"}="tg";
	$bbtree{"_.e"}=0;
	$bbtree{"_.c"}='';
	$debug .= debug($printdebug, "\n<!--GENERATING BBCODE TREE:\n".'[_]automatic tag: [ht]'."\n");
	
	while ($bb ne '') {
		if($bb =~ m/(\[(\/?)([a-z]+|\*)(=([^\[\]]*))?\])/g) {
			$tag = $1;
			$tagend = $2;
			$tagname = $3;
			$tagvalue = $5;
			$pretext = substr($bb,0,pos ($bb)-length($tag));
			$bb = substr ($bb,pos ($bb));
			
			if ($pretext ne '') {
				$debug .= debug($printdebug, '['.$ind.'.'.$bbtree{$ind.'.e'}.']text: '.$pretext."\n");
				$bbtree{$ind.'.'.$bbtree{$ind.'.e'}.'.t'}='tx';
				$bbtree{$ind.'.'.$bbtree{$ind.'.e'}.'.v'}=$pretext;
				$bbtree{$ind.'.e'} += 1;
			}
			
			if($tagname =~ /^(fq|tq|br|ni|po|url|i|list|\*)$/) {
				if ($tagend ne '') {
					if(($tagname ne $bbtree{$ind.'.n'}) || ($level <= 0)) {
						$debug .= debug($printdebug, '['.$ind.'.'.$bbtree{$ind.'.e'}.']text: '.$tag."\n");
						$bbtree{$ind.'.'.$bbtree{$ind.'.e'}.'.t'}='tx';
						$bbtree{$ind.'.'.$bbtree{$ind.'.e'}.'.v'}=$tag;
						$bbtree{$ind.'.e'} += 1;
					}
					else {
						$debug .= debug($printdebug, '['.$ind.'.'.$bbtree{$ind.'.e'}.']tag: '.$tag."\n");
						$bbtree{$ind.'.'.$bbtree{$ind.'.e'}.'.t'}='tg';
						$bbtree{$ind.'.'.$bbtree{$ind.'.e'}.'.n'}='/'.$tagname;
						$bbtree{$ind.'.'.$bbtree{$ind.'.e'}.'.v'}=$tagvalue;
						$bbtree{$ind.'.e'} += 1;
						$bbtree{$ind.'.c'}=1;
						$level -= 1;
						$ind =~ s/\.[0-9]+$//;
					}
				}
				else
				{
					$debug .= debug($printdebug, '['.$ind.'.'.$bbtree{$ind.'.e'}.']tag: '.$tag."\n");
					$bbtree{$ind.'.'.$bbtree{$ind.'.e'}.'.t'}='tg';
					$bbtree{$ind.'.'.$bbtree{$ind.'.e'}.'.n'}=$tagname;
					$bbtree{$ind.'.'.$bbtree{$ind.'.e'}.'.v'}=$tagvalue;
					$bbtree{$ind.'.'.$bbtree{$ind.'.e'}.'.e'}=0;
					$bbtree{$ind.'.'.$bbtree{$ind.'.e'}.'.c'}='';
					$bbtree{$ind.'.e'} += 1;
					$level += 1;
					$ind = $ind.'.'.($bbtree{$ind.'.e'}-1);
				}
			}
			else {
				$debug .= debug($printdebug, '['.$ind.'.'.$bbtree{$ind.'.e'}.']text: '.$tag."\n");
				$bbtree{$ind.'.'.$bbtree{$ind.'.e'}.'.t'}='tx';
				$bbtree{$ind.'.'.$bbtree{$ind.'.e'}.'.v'}=$tag;
				$bbtree{$ind.'.e'} += 1;
			}
		}
		else {
			$debug .= debug($printdebug, '['.$ind.'.'.$bbtree{$ind.'.e'}.']text: '.$bb."\n");
			$bbtree{$ind.'.'.$bbtree{$ind.'.e'}.'.t'}='tx';
			$bbtree{$ind.'.'.$bbtree{$ind.'.e'}.'.v'}=$bb;
			$bbtree{$ind.'.e'} += 1;
			$bb='';
		}
	}
	$debug .= debug($printdebug, '[_.'.$bbtree{'_.e'}.']automatic tag: [/ht]'."\n -->\n");
	$bbtree{'_.'.$bbtree{"_.e"}.'.t'}="tg";
	$bbtree{'_.'.$bbtree{"_.e"}.'.n'}='/ht';
	$bbtree{"_.e"}+=1;
	$bbtree{"_.c"}=1;
	
	return ($debug, %bbtree);
}

#convert tag tree to final text
sub convtree {
	(my $printdebug, my $debug, my $lang, my %bbtree) = @_;
	my $ht;
	my $ind;
	my $indd;
	my $level=0;
	my $tagsr = ($lang eq 'html') ? tagsht : tagsbb;
	my %tags = %$tagsr;
	my $escape = ($lang eq 'html');
	
	# $debug .= debug($printdebug, "\n****\n");
	# foreach my $iiii (keys %tags) {
		# $debug .= debug($printdebug, $iiii.'='.$tags{$iiii}."\n");
	# }
	# $debug .= debug($printdebug, "****\n");
	
	$level=0;
	$ind='_';
	$ht='';
	$debug .= debug($printdebug, "\n<!--PROCESSING BBCODE TREE:\n");
	
	while ($level >=0) {
		$debug .= debug($printdebug, "[$level:$ind:".int($bbtree{$ind.'.e'})."]");
		#normal text
		if($bbtree{$ind.'.t'} eq 'tx') {
			$debug .= debug($printdebug, "text: ".$bbtree{$ind.'.v'});
			$ht .= $escape ? (html_encode_line($bbtree{$ind.'.v'})) : ($bbtree{$ind.'.v'});
			
			{do{
				$ind =~ s/\.([0-9]+)$//;
				$indd = int($1)+1;
				if ($indd < $bbtree{$ind.'.e'}){
					$ind = $ind.'.'.$indd;
					last;
				}
				else {
					#should not occur with a correct bbtree
					$debug .= debug($printdebug, "[<tx]");
					$level -= 1;
				}
			} while ($level>=0);}
		}
		#tag
		elsif($bbtree{$ind.'.t'} eq 'tg') {
			#endtag
			if($bbtree{$ind.'.n'} =~ /^\//) {
				$debug .= debug($printdebug, "tag: [".$bbtree{$ind.'.n'}."]");
				$indd = $ind;
				$indd =~ s/\.([0-9]+)$//;
				if (exists($tags{$bbtree{$ind.'.n'}.'='}) && ($bbtree{$indd.'.v'} ne '')) {
					$ht = $ht.$tags{$bbtree{$ind.'.n'}.'='};
				}
				elsif (exists($tags{$bbtree{$ind.'.n'}})) {
					$ht = $ht.$tags{$bbtree{$ind.'.n'}};
				}
				else {
					$ht = $ht.$tags{'/?'};
					$debug .= debug($printdebug, "[unknown!]");
				}
				
				$ind =~ s/\.([0-9]+)$//;
				$level -= 1;
				$debug .= debug($printdebug, "[<]");
				if($level>=0) {
					{do{
						$ind =~ s/\.([0-9]+)$//;
						$indd = int($1)+1;
						if ($indd < $bbtree{$ind.'.e'}){
							$ind = $ind.'.'.$indd;
							last;
						}
						else {
							#should not occur with a correct bbtree
							$debug .= debug($printdebug, "[<nd]");
							$level -= 1;
						}
					} while ($level>=0);}
				}
				else {
					# time to end this
					$level = -1;
				}
			}
			#starttag
			else {
				if($bbtree{$ind.'.c'} ne '') {
					$debug .= debug($printdebug, "tag: [".$bbtree{$ind.'.n'}."]");
					
					if (exists($tags{$bbtree{$ind.'.n'}.'='}) && ($bbtree{$ind.'.v'} ne '')) {
						if (exists($tags{$bbtree{$ind.'.n'}.'='.$bbtree{$ind.'.v'}})) {
							$ht = $ht.$tags{$bbtree{$ind.'.n'}.'='}.$tags{$bbtree{$ind.'.n'}.'='.$bbtree{$ind.'.v'}}.$tags{$bbtree{$ind.'.n'}.'/='};
						}
						else {
							$ht = $ht.$tags{$bbtree{$ind.'.n'}.'='}.($escape?entityencode($bbtree{$ind.'.v'}):$bbtree{$ind.'.v'}).$tags{$bbtree{$ind.'.n'}.'/='};
						}
					}
					elsif (exists($tags{$bbtree{$ind.'.n'}})) {
						$ht = $ht.$tags{$bbtree{$ind.'.n'}};
					}
					else {
						$ht = $ht.$tags{'?'};
						$debug .= debug($printdebug, "[unknown!]");
					}
				}
				else {
					$debug .= debug($printdebug, "unclosed tag: [".$bbtree{$ind.'.n'}."]");
					$ht .= '['.($escape?html_encode_line($bbtree{$ind.'.n'}):$bbtree{$ind.'.n'}).']';
				}
				if($bbtree{$ind.'.e'}>0) {
					$ind = $ind.'.0';
					$level += 1;
					$debug .= debug($printdebug, "[>]");
				}
				else {
					{do{
						$ind =~ s/\.([0-9]+)$//;
						$indd = int($1)+1;
						if ($indd < $bbtree{$ind.'.e'}){
							$ind = $ind.'.'.$indd;
							last;
						}
						else {
							#should not occur with a correct bbtree
							$debug .= debug($printdebug, "[<st]");
							$level -= 1;
						}
					} while ($level>=0);}
				}
			}
		}
		#what is this
		else {
			$debug .= debug($printdebug, "unknown thing: ".$bbtree{$ind.'.t'});
			#should not occur with a correct bbtree
			#unless unimplemented
			$ind =~ s/\.([0-9]+)$//;
			$level -= 1;
			$debug .= debug($printdebug, "[<ui]");
			if($level>0) {
				{do{
					$ind =~ s/\.([0-9]+)$//;
					$indd = int($1)+1;
					if ($indd < $bbtree{$ind.'.e'}){
						$ind = $ind.'.'.$indd;
						last;
					}
					else {
						#should not occur with a correct bbtree
						$debug .= debug($printdebug, "[<un]");
						$level -= 1;
					}
				} while ($level>=0);}
			}
			else {
				# time to end this
				$level = -1;
			}
		}
		$debug .= debug($printdebug, "[>$level:$ind]\n");
	}
	
	$debug .= debug($printdebug, "-->\n");
	return ($debug, $ht);
}

#bbcode to html, TBD
sub bb_to_html {
	(my $bb, my $printdebug) = @_;
	my $ht;
	my %bbtree;
	my $debug;
	
	($debug, %bbtree) = bbtree($bb,$printdebug);
	($debug, $ht) = convtree ($printdebug, $debug, 'html', %bbtree);
	
	return $ht;
}

#bbcode to bb, TBD
sub bb_to_bbcode {
	(my $bb, my $printdebug) = @_;
	my $ht;
	my %bbtree;
	my $debug;
	
	($debug, %bbtree) = bbtree($bb,$printdebug);
	($debug, $ht) = convtree ($printdebug, $debug, 'bb', %bbtree);
	
	return $ht;
}

# TO REMOVE
sub bb2ht {
	return bb_to_html(@_);
}

# TO REMOVE
sub bb2bb {
	return bb_to_bbcode(@_);
}

sub eval_bb {
	(my $bb) = @_;
	my $value;
	my $before;
	my $after;
	
	while ($bb =~ m/###([^#;]*);/g) {
		$value = $1;
		$before = $`;
		$after = $';
		
		if ($value =~ /^att&([0-9]+)$/) {
			$value = merge_url(
				SCHEME().WEBSITE(),
				CGI_ATTACH_PATH(),
				int($1)
			)
		}
		elsif ($value =~ /^vw&([0-9]+)$/) {
			$value = merge_url(
				SCHEME().WEBSITE(),
				CGI_VIEWER_PATH(),
				int($1)
			)
		}
		elsif ($value =~ /^fr&([0-9]+)$/) {
			$value = merge_url(
				SCHEME().WEBSITE(),
				CGI_FRAME_PATH(),
				int($1)
			)
		}
		else {
			$value = '';
		}
		$bb = $before . $value . $after;
	}
	return $bb;
}


sub html_encode_line {
	(my $text, my $non_ascii, my $all) = @_;
	my $html;
	my $ind;
	
	$text =~ s/\r\n/\n/gs;
	$text =~ s/\r/\n/gs;
	
	while ($text ne '') {
		$ind = index($text, "\n");
		if ($ind >= 0) {
			$html .= html_entity_encode_dec(substr($text, 0, $ind), $non_ascii, $all)."<br>\n";
			$text = substr($text, $ind+1);
		}
		else
		{
			$html .= html_entity_encode_dec($text, 1);
			$text = '';
		}
	}
	return $html;
}

# TO REMOVE
sub linehtml {
	return html_encode_line($_[0], 1);
}

# TO REMOVE ???
sub debug {
	(my $print, my $text) = @_;
	
	if ($print) {
		print $text;
	}
	
	return $text;
}


sub print_html_start {
	(my $fh) = @_;
	print $fh '<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "">'."\n";
	print $fh '<html lang="en">'."\n";
}

sub print_html_end {
	(my $fh) = @_;
	print $fh '</html>'."\n";
}

sub print_html_head_start {
	print $fh '<head>'."\n";
	print $fh '<meta http-equiv="Content-type" content="text/html; charset=UTF-8">'."\n";
	print $fh '<link rel="icon" type="image/png" href="'.html_entity_encode_dec(FAVICON_PATH(),1).'">'."\n";
	print $fh '<link rel="stylesheet" href="'.html_entity_encode_dec(CGI_CSS_PATH(),1).'">'."\n";
}

sub print_html_head_end {
	(my $fh) = @_;
	print $fh '</head>'."\n";
}
	
sub print_html_body_start {
	(my $fh) = @_;
	print $fh '<body>'."\n";
	print $fh '<a href="/"><img id="botmlogo" src="'.html_entity_encode_dec(CGI_LOGO_PATH(),1).'" alt="'.html_entity_encode_dec(WEBSITE(),1).'"></a>'."\n";
	print $fh '<div id="all">'."\n";
}

sub print_html_body_end {
	(my $fh) = @_;
	print $fh '</div>'."\n";
	print $fh '<a href="/" class="cz">'.html_entity_encode_dec(WEBSITE(),1).'</a>'."\n";
	print $fh '</body></html>'."\n";
}

sub print_html_data {
	(my $fh, my $data) = @_;
	
	foreach my $key (keys %$data) {
		unless ($key eq 'content') {
			my $val = $data->{'ind'};
			$val =~ s/(\r)?\n/\n /gs; # does the space make sense in HTML anyway?
			print $fh html_encode_line("$key: $val\n", 1);
		}
	}
	print $fh html_encode_line("\n".$data->{'content'});
}

sub print_viewer_page {
	(
		my $file,
		my $frame,
		my $password_ok,
		my $access,
		my $textmode,
		my $show_command,
		my $state,
		my $settings,
		my $frame_data,
		my $nextframe_data
	) = @_;
	my $fh;
	
	my $prev_available = ($frame > 0 && $access);
	my $next_available = ($password_ok || ($frame   < int($state->{'last'})));
	my $prefetch_next  = (
		$password_ok ||
		($frame+1 < int($state->{'last'})) || (
			($frame < int($state->{'last'})) &&
			(int($state->{'state'}) >= STATE->{'ready'})
		)
	);
	my $show_timer = ($password_ok || 
		($frame == int($state->{'last'})) &&
		(int($state->{'state'}) >= STATE->{'waiting'}) &&
		(int($state->{'state'}) <= STATE->{'ready'})
	);
	$show_command = (
		$password_ok ||
		($frame < int($state->{'last'})) ||
		((int($state{'state'}) >= STATE->{'ready'} ) && $show_command)
	);
	my $frame_indirect = !(
		(!$access) || (
			($frame < int($state->{'last'})) &&
			(int($state->{'state'}) > STATE->{'inactive'})
		)
	);
	my $nextframe_indirect = !($frame+1 < int($state{'last'}));
	
	my $password_query;
	
	my $goto_url = CGI_GOTO_PATH;
	my $timer_url = CGI_TIMER_PATH;
	my $viewer_full_url = merge_url(
		SCHEME().WEBSITE(),
		CGI_VIEWER_PATH(),
		$frame
	);
	my $viewer_0_url    = merge_url(CGI_VIEWER_PATH(), 0);
	my $viewer_prev_url = merge_url(CGI_VIEWER_PATH(), $frame-1);
	my $viewer_next_url = merge_url(CGI_VIEWER_PATH(), $frame+1);
	my $frame_file = '';
	my $frame_url;
	my $frame_next_url;
	my $frame_normal_url;
	my $frame_full_url;
	if ($frame_data->{'frame'} ne '') {
		$frame_file = $frame_data->{'frame'};
		$frame_normal_url = merge_url(CGI_PATH(), $frame_file);
	}
	else {
		$frame_file = sprintf($settings->{'frame'}, $frame, $frame_data->{'ext'});
		$frame_normal_url = merge_url(CGI_PATH(), $frame_file);
	}
	$frame_url = $frame_indirect ?
		merge_url(CGI_FRAME_PATH(), $frame) :
		$frame_normal_url;
	$frame_full_url = merge_url(
		SCHEME().WEBSITE(),
		$frame_normal_url
	);
	if ($nextframe_indirect) {
		$frame_next_url = merge_url(CGI_FRAME_PATH(), $frame);
	}
	elsif ($nextframe_data->{'frame'} ne '') {
		$frame_next_url = merge_url(CGI_PATH(), $nextframe_data->{'frame'});
	}
	else {
		$frame_next_url = merge_url(CGI_PATH(), sprintf(
			$settings->{'frame'}, $frame+1, $nextframe_data->{'ext'}
		));
	}
	
	if ($password_ok) {
		$password_query = '?'.url_query_encode(\('p', $settings->{'password'}));
		$goto_url        = merge_url($goto_url       , $password_query);
		$viewer_0_url    = merge_url($viewer_0_url   , $password_query);
		$viewer_prev_url = merge_url($viewer_prev_url, $password_query);
		$viewer_next_url = merge_url($viewer_next_url, $password_query);
		if ($frame_indirect) {
			$frame_url = merge_url($frame_url     , $password_query);
		}
		if ($nextframe_indirect) {
			$frame_url = merge_url($frame_next_url, $password_query);
		}
	}
	my $_goto_url        = html_entity_encode_dec($goto_url       , 1);
	my $_timer_url       = html_entity_encode_dec($timer_url      , 1);
	my $_viewer_full_url = html_entity_encode_dec($viewer_full_url, 1);
	my $_viewer_0_url    = html_entity_encode_dec($viewer_0_url   , 1);
	my $_viewer_prev_url = html_entity_encode_dec($viewer_prev_url, 1);
	my $_viewer_next_url = html_entity_encode_dec($viewer_next_url, 1);
	my $_frame_url       = html_entity_encode_dec($frame_url      , 1);
	my $_frame_next_url  = html_entity_encode_dec($frame_next_url , 1);
	my $_frame_full_url  = html_entity_encode_dec($frame_full_url , 1);
	
	my $_title = html_entity_encode_dec($framedata->{'title'}, 1);
	
	if ($textmode == TEXT_MODE->{'info'}) {
		if ($show_command) {
			$frame_data->{'command'} = $nextframe_data->{'title'};
		}
		if ($access) {
			$frame_data->{'frame'} = $frame_file;
		}
	}
	
	if (ref($file)) {
		$fh=$file;
		unless (seek($fh, 0, 0)) {
			#don't actually fail here
		}
	}
	else {
		unless (open ($fh, ">:encoding(UTF-8)", encode('locale_fs', $file))) {
			return 0;
		}
	}
	
	print_html_start($fh);
	print_html_head_start($fh);
	
	print $fh '<link rel="index" href="'.$_goto_url.'">'."\n";
	print $fh '<link rel="start" href="'.$_viewer_0_url.'">'."\n";
	if ($prev_available) {
		print $fh '<link rel="prev" href="'.$_viewer_prev_url.'">'."\n";
	}
	if ($next_available) {
		print $fh '<link rel="next" href="'.$_viewer_next_url.'">'."\n";
		if ($prefetch_next) {
			print $fh '<link rel="prefetch" href="'.$_viewer_next_url.'">'."\n";
			print $fh '<link rel="prefetch" href="'.$_frame_next_url.'">'."\n";
		}
	}
	if ($show_timer) {
		print $fh '<!-- <script src="'.$_timer_url.'"></script> -->'."\n";
	}
	
	print_html_head_end($fh);
	print_html_body_start($fh);
	
	print $fh '<div id="inst" class="ins">'."\n";
	
	print $fh '<div id="title">'."\n";
	print $fh '<h1 id="titletext">'.$_title.'</h1>'."\n";
	print $fh '</div>'."\n";
	
	print $fh '</div><div id="framespace">'."\n";
	
	print $fh '<img src="'.$_frame_url.'" id="frame" alt="'.$frame.'" title="'.$_title.'">'."\n";
	
	print $fh '</div><div id="insb" class="ins">'."\n";
	
	if ($textmode == TEXT_MODE->{'info'}) {
		print $fh '<div id="chat">'."\n";
		
		print_html_data($fh, $frame_data); 
		
		print $fh '</div>'."\n";
	}
	elsif ($textmode == TEXT_MODE->{'bb'}) {
		print $fh '<div id="chat">'."\n";
		
		print $fh '[quote][center][size=200]'.$_title.'[/size]<br>'."\n";
		print $fh '[url='.$_viewer_full_url.'][img]'.$_frame_full_url.'[/img][/url][/center]<br>'."\n";
		print $fh html_encode_line(bb_to_bbcode(eval_bb($frame_data->{'content'})));
		print $fh '[/quote]</div>'."\n";
		
		print $fh '</div>'."\n";
	}
	elsif ($frame_data->{'content'} ne '') {
		print $fh '<div id="undertext">'."\n";
		print $fh bb_to_html(eval_bb($frame_data->{'content'}))."\n";
		print $fh '</div>'."\n";
	}
	
	print $fh '<div id="command">'."\n";
	# TODO
	
	print_html_body_end($fh);
	print_html_end($fh);
	
	
	unless (ref($file)) {
		close ($fh);
	}
	else {
		truncate ($fh , tell($fh));
	}
	
	return 1;
}

1
