# bsta_lib.pm is generated from bsta_lib.1.pm
# 
# Library of functions
#
# Copyright (C) 2016, 2017, 2019, 2020, 2022, 2023, 2024  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/>.

# TODO: FQ NBSP ?
# TODO: DEBUG
# TODO: BB & INFO indent

package bsta_lib;

use strict;
#use warnings

use utf8;
use Encode ('encode', 'decode');
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', 'TEXT_MODE', 'INTF_STATE', 'CHAT_STATE', 'CHAT_ACTION',
	'failpage',
	'fail_method', 'fail_content_type', 'fail_open_file', 'fail_attachment', 'fail_500',
	'redirect',
	'get_remote_addr', 'get_id', 'get_frame', 'get_password',
	'merge_settings',
	'print_html_start', 'print_html_end',
	'print_html_head_start', 'print_html_head_end',
	'print_html_body_start', 'print_html_body_end',
	'print_viewer_page', 'print_goto',
	'write_index', 'write_static_viewer_page', 'write_static_goto',
	'get_frame_file', 'get_page_file',
	'read_frame_data', 'write_frame_data', 'read_default', 'read_noaccess',
	'read_state', 'write_state',
	'read_words_list', 'write_words_list', 'read_words', 'write_words',
	'read_story', 'write_story',
	'read_goto', 'write_goto',
	'read_chat', 'write_chat',
	'read_settings', 'read_attachment', 'read_coincidence',
	'ong',
	'eval_bb', 'bb_to_bbcode', 'bb_to_html'
);

###PERL_LIB: use lib /botm/lib/bsta
use botm_common (
	'HTTP_STATUS',
	'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',
	'join_path',
	'copy_encoded', 'open_encoded', '_x_encoded',
	'http_header_line', 'http_status',
	'http_header_status', 'http_header_allow', 'http_header_location'
);

###PERL_PATH_SEPARATOR:     PATH_SEPARATOR     = /

###PERL_CGI_PATH:           CGI_PATH           = /bsta/
###PERL_CGI_ATTACH_PATH:    CGI_ATTACH_PATH    = /bsta/a
###PERL_CGI_2WORDS_PATH:    CGI_2WORDS_PATH    = /bsta/2words
###PERL_CGI_BBCODE_PATH:    CGI_BBCODE_PATH    = /bsta/b
###PERL_DATA_CHAT_PATH:     DATA_CHAT_PATH     = /botm/data/bsta/chat
###PERL_CGI_COIN_PATH:      CGI_COIN_PATH      = /bsta/coin
###PERL_CGI_CSS_PATH:       CGI_CSS_PATH       = /bsta/bsta.css
###PERL_CGI_FRAME_PATH:     CGI_FRAME_PATH     = /bsta/f
###PERL_CGI_GOTO_PATH:      CGI_GOTO_PATH      = /bsta/g
###PERL_CGI_INFO_PATH:      CGI_INFO_PATH      = /bsta/i
###PERL_CGI_LIST_PATH:      CGI_LIST_PATH      = /bsta/goto.htm
###PERL_CGI_LOGO_PATH:      CGI_LOGO_PATH      = /bsta/botmlogo.png
###PERL_CGI_TIMER_PATH:     CGI_TIMER_PATH     = /bsta/timer.js
###PERL_CGI_VIEWER_PATH:    CGI_VIEWER_PATH    = /bsta/v
###PERL_CGI_WORDS_PATH:     CGI_WORDS_PATH     = /bsta/w

###PERL_DATA_PATH:          DATA_PATH          = /botm/data/bsta/
###PERL_DATA_ATTACH_PATH:   DATA_ATTACH_PATH   = /botm/data/bsta/a
###PERL_DATA_COIN_PATH:     DATA_COIN_PATH     = /botm/data/bsta/coincidence
###PERL_DATA_DEFAULT_PATH:  DATA_DEFAULT_PATH  = /botm/data/bsta/default
###PERL_DATA_LIST_PATH:     DATA_LIST_PATH     = /botm/data/bsta/list
###PERL_DATA_NOACCESS_PATH: DATA_NOACCESS_PATH = /botm/data/bsta/noaccess
###PERL_DATA_SETTINGS_PATH: DATA_SETTINGS_PATH = /botm/data/bsta/settings
###PERL_DATA_STATE_PATH:    DATA_STATE_PATH    = /botm/data/bsta/state
###PERL_DATA_STORY_PATH:    DATA_STORY_PATH    = /botm/data/bsta/story
###PERL_DATA_WORDS_PATH:    DATA_WORDS_PATH    = /botm/data/bsta/words/

###PERL_WWW_PATH:           WWW_PATH           = /botm/www/
###PERL_WWW_GOTO_PATH:      WWW_GOTO_PATH      = /botm/www/1190/bsta/goto.htm
###PERL_WWW_INDEX_PATH:     WWW_INDEX_PATH     = /botm/www/1190/bsta/index.htm

###PERL_SCHEME:             SCHEME             = http
###PERL_WEBSITE:            WEBSITE            = 1190.bicyclesonthemoon.info
###PERL_WEBSITE_NAME:       WEBSITE_NAME       = Bicycles on the Moon
###PERL_FAVICON_PATH:       FAVICON_PATH       = /img/favicon.png

###PERL_COIN_DATE:          COIN_DATE          = 13-Nov-2016 22:15
###PERL_INTF_DATE:          INTF_DATE          = 28-Sep-2016 20:34

###PERL_STORY_CREDITS:      STORY_CREDITS      = "BSTA" by Balthasar Szczepański
###PERL_INTF_CREDITS:       INTF_CREDITS       = Online interface © Balthasar Szczepański; AGPL 3 license
###PERL_SOURCE_URL:         SOURCE_URL         = http://bicyclesonthemoon.info/git-projects/?p=ott/bsta

###PERL_COMMENT_PAGE_LENGTH:COMMENT_PAGE_LENGTH= 16

use constant STATE => {
	'inactive' => 0,
	'waiting'  => 1,
	'ready'    => 2,
	'end'      => 3,
};
use constant INTF_STATE => {
	'X'  => 0b000000,
	'x'  => 0b000000,
	'||' => 0b000001,
	'>>' => 0b000100,
	'>>|'=> 0b000101,
	'<<' => 0b001000,
	'|<<'=> 0b001001,
	'>'  => 0b010000,
	'>|' => 0b010001,
	'mask'=>0b111111,
	'mode'=>0b111110,
};
use constant TEXT_MODE => {
	'normal' => 0,
	'bb'     => 1,
	'info'   => 2,
	'words'  => 3
};
use constant CHAT_STATE => {
	'disconnected' => 0,
	'ready'        => 1,
	'active'       => 2,
};
use constant CHAT_ACTION => {
	'none'   => 0,
	'join'   => 1,
	'leave'  => 2,
	'nopost' => 3,
	'file'   => 4,
};

use constant tags_bbcode => {
	'ht'     => '',
	'/ht'    => '',
	'fq'     => '[quote]',
	'/fq'    => '[/quote]',
	'tq'     => '[quote]',
	'/tq'    => '[/quote]',
	'quote'  => '[quote]',
	'quote=' => '[quote="',
	'quote/='=> '"]',
	'/quote' => '[/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 tags_html => {
	'ht'     => '',
	'/ht'    => '',
	'fq'     => '<div class="fq">',
	'/fq'    => '</div>',
	'tq'     => '<div class="tq">',
	'/tq'    => '</div>',
	'quote'  => '<div class="opomba"><div class="opomba_text">',
	'quote=' => '<div class="opomba"><div class="opomba_info"><b>',
	'quote/='=> '</b> wrote:</div><div class="opomba_text">',
	'/quote' => '</div></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, my $hyperlink) = @_;
	
	if (ref($header)) {
		foreach my $header_name (keys %$header) {
			print http_header_line($header_name, $header->{$header_name});
		}
	}
	elsif($header ne '') {
		print $header;
	}
	if($method eq 'HEAD') {
		print "\n";
		return;
	}
	my $_title     = html_entity_encode_dec($title    , 1);
	my $_message   = html_entity_encode_dec($message  , 1);
	my $_hyperlink = html_entity_encode_dec($hyperlink, 1);
	
	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">'."\n";
	print '  <head>'."\n";
	print '   <meta http-equiv="Content-type" content="text/html; charset=UTF-8">'."\n";
	if ($title ne '') {
		print '   <title>'.$_title.'</title>'."\n";
	}
	print '  </head>'."\n";
	print ' <body>'."\n";
	if ($title ne '') {
		print '  <h1>'.$_title.'</h1>'."\n";
	}
	if (($message ne '') || ($hyperlink ne '')) {
		print "  <p>\n";
		if ($message ne '') {
			print '   '.$_message.($hyperlink ne '' ? '<br>' : '')."\n";
		}
		if ($hyperlink ne '') {
			print '   <a href="'.$_hyperlink.'">'.$_hyperlink."</a>\n";
		}
		print "  </p>\n";
	}
	print ' </body>'."\n";
	print '</html>'."\n";
}

sub fail_method {
	(my $method, my $allowed) = @_;
	
	my $status = http_status(HTTP_STATUS->{'method_not_allowed'});
	my $header =
		http_header_line('status', $status) .
		http_header_allow($allowed);
	
	return failpage(
		$header,
		$status,
		"The interface does not support the $method method.",
		$method
	);
}

sub fail_content_type
{
	(my $method, my $content_type) = @_;
	
	my $status = http_status(HTTP_STATUS->{'unsupported_media_type'});
	my $header = http_header_line('status', $status);
	
	return failpage(
		$header,
		$status,
		"Unsupported Content-type: $content_type.",
		$method
	);
}

sub fail_open_file
{
	(my $method, my $type, my $path) = @_;
	
	my $status = http_status(HTTP_STATUS->{'not_found'});
	my $header = http_header_line('status', $status);
	
	return failpage(
		$header,
		$status,
			"Can't open ".
			($type ne '' ? $type : 'file').
			($path ne '' ? ': "'.$path.'"' : '').
			'.',
		$method
	);
}

sub fail_attachment
{
	(my $method, my $ID) = @_;
	
	my $status = http_status(HTTP_STATUS->{'not_found'});
	my $header = http_header_line('status', $status);

	return failpage(
		$header,
		$status,
		"Attachment $ID not found.",
		$method
	);
}

sub fail_500
{
	(my $method, my $text) = @_;
	
	my $status = http_status(HTTP_STATUS->{'internal_server_error'});
	my $header = http_header_line('status', $status);
	
	return failpage(
		$header,
		$status,
		$text,
		$method
	);
}

sub redirect
{
	(my $method, my $uri, my $code) = @_;
	my $header;
	my $status;
	if ($code eq '') {
		$code = HTTP_STATUS->{'found'};
	}
	# https://insanecoding.blogspot.com/2014/02/http-308-incompetence-expected.html
	# 301 Moved Permanently
	# 302 Found
	# 303 See Other
	# 307 Temporary Redirect
	# 308 Permanent Redirect
	$status = http_status($code);
	$header = http_header_line('status', $status);
	$header .= http_header_location($uri);
	
	return failpage(
		$header,
		$status,
		'',
		$method,
		$uri
	);
}


# function to obtain address of remote agent
sub get_remote_addr {
	if ($ENV{'HTTP_X_FORWARDED_FOR'} =~ /^.+$/) {
		return $&;
	}
	elsif ($ENV{'REMOTE_ADDR'} =~ /^.+$/) {
		return $&;
	}
	else {
		return '0.0.0.0';
	}
}

# functions to get ID/number etc.
sub get_id {
	(my $cgi, my $default, my $cgi_name) = @_;
		if ($default eq '') {
		$default = 0;
	}
	if ($cgi_name eq '') {
		$cgi_name = 'i';
	}
	
	if ($cgi->{$cgi_name} =~ /^.+$/) {
		return int($&);
	}
	elsif ($ENV{'PATH_INFO'} =~ /^\/(.+)$/) {
		return int($1);
	}
	else {
		return int($default);
	}
}

# function to obtain frame number
sub get_frame {
	(my $cgi, my $default) = @_;
	return get_id($cgi, $default, 'f');
}

# function to obtain password
sub get_password {
	(my $cgi) = @_;
	
	if ($cgi->{'p'} =~ /^.+$/) {
		return $&;
	}
	else {
		return '';
	}
}


sub merge_settings {
		my %final_settings;
	
	foreach my $settings (@_) {
		foreach my $ind (keys %$settings) {
			$final_settings{$ind} = $settings->{$ind};
		}
	}
	return %final_settings;
}


# BB code stuff
# different & simpler implementation than in post library
# to consider:
# a BBcode library?

#analyse bbcode text to build tag tree
#TODO make [/*] optional!
sub bbtree {
	(my $bb, my $printdebug) = @_;
	my %bbtree;
	my $ind;
	my $tag;
	my $tag_name;
	my $tag_value;
	my $tag_end;
	my $level=0;
	my $pre_text;
	my $debug;
	
	$ind="_";
	$level=0;
	$bbtree{"_.name" }  = "ht";
	$bbtree{"_.value" } = '';
	$bbtree{"_.type"  } = "tag";
	$bbtree{"_.count" } = 0;
	$bbtree{"_.closed"} = 0;
	$debug .= debug($printdebug,
		"\n".
		"<!--GENERATING BBCODE TREE:\n".
		'[_]automatic tag: [ht]'."\n"
	);
	
	while ($bb ne '') {
		my $new_ind = $ind.'.'.$bbtree{$ind.'.count'};
		
		if($bb =~ m/\[(\/?)([A-Za-z]+|\*)(=([^\[\]]*))?\]/g) {
			$pre_text = $`;
			$tag = $&;
			$tag_end = $1;
			$tag_name = lc($2);
			$tag_value = $4;
			$bb = $';
			if ($tag_value =~ /^"(.*)"$/) {
				$tag_value = $1;
			}
			
			if ($pre_text ne '') {
				$debug .= debug($printdebug, "[$new_ind]text: $pre_text\n");
				$bbtree{$new_ind.'.type' } = 'text';
				$bbtree{$new_ind.'.value'} = $pre_text;
				$bbtree{    $ind.'.count'}+= 1;
				$new_ind = $ind.'.'.$bbtree{$ind.'.count'};
			}
			
			if($tag_name =~ /^(fq|tq|quote|br|ni|po|url|i|list|\*)$/) {
				if ($tag_end ne '') {
					if (
						($tag_name ne $bbtree{$ind.'.name'}) ||
						($level <= 0)
					) {
						$debug .= debug($printdebug, "[$new_ind]text: $tag\n");
						$bbtree{$new_ind.'.type' } = 'text';
						$bbtree{$new_ind.'.value'} = $tag;
						$bbtree{    $ind.'.count'}+= 1;
						# $new_ind = $ind.'.'.$bbtree{$ind.'.count'};
					}
					else {
						$debug .= debug($printdebug, "[$new_ind]tag: $tag\n");
						$bbtree{$new_ind.'.type'  } = 'tag';
						$bbtree{$new_ind.'.name'  } = '/'.$tag_name;
						$bbtree{$new_ind.'.value' } = $tag_value;
						$bbtree{    $ind.'.count' }+= 1;
						$bbtree{    $ind.'.closed'} = 1;
						$level -= 1;
						$ind =~ s/\.[0-9]+$//;
						# $new_ind = $ind.'.'.$bbtree{$ind.'.count'};
					}
				}
				else
				{
					$debug .= debug($printdebug, "[$new_ind]tag: $tag\n");
					$bbtree{$new_ind.'.type'  } = 'tag';
					$bbtree{$new_ind.'.name'  } = $tag_name;
					$bbtree{$new_ind.'.value' } = $tag_value;
					$bbtree{$new_ind.'.count' } = 0;
					$bbtree{$new_ind.'.closed'} = 0;
					$bbtree{    $ind.'.count' }+= 1;
					$level += 1;
					$ind = $new_ind;
					# $new_ind = $ind.'.'.$bbtree{$ind.'.count'};
				}
			}
			else {
				$debug .= debug($printdebug, "[$new_ind]text: $tag\n");
				$bbtree{$new_ind.'.type' } = 'text';
				$bbtree{$new_ind.'.value'} = $tag;
				$bbtree{    $ind.'.count'}+= 1;
				# $new_ind = $ind.'.'.$bbtree{$ind.'.count'};
			}
		}
		else {
			$debug .= debug($printdebug, "[$new_ind]text: $bb\n");
			$bbtree{$new_ind.'.type' } = 'text';
			$bbtree{$new_ind.'.value'} = $bb;
			$bbtree{    $ind.'.count'}+= 1;
			# $new_ind = $ind.'.'.$bbtree{$ind.'.count'};
			$bb = '';
		}
	}
	my $final_ind = '_.'.$bbtree{"_.count"};
	$debug .= debug($printdebug, "[$final_ind]automatic tag: [/ht]\n -->\n");
	$bbtree{$final_ind.'.type' } = "tag";
	$bbtree{$final_ind.'.name' } = '/ht';
	$bbtree{         '_.count' }+= 1;
	$bbtree{         '_.closed'} = 1;
	
	return ($debug, %bbtree);
}

#convert tag tree to final text
sub convtree {
	(my $printdebug, my $debug, my $lang, my $bbtree) = @_;
	my $out;
	my $ind;
	my $indd;
	my $level = 0;
	my $tags = ($lang eq 'html') ? tags_html : tags_bbcode;
	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 = '_';
	$out = '';
	$debug .= debug($printdebug, "\n<!--PROCESSING BBCODE TREE:\n");
	
	while ($level >= 0) {
		my $goto_next = '';
		$debug .= debug($printdebug, "[$level:$ind:".int($bbtree->{$ind.'.count'})."]");
		#normal text
		if ($bbtree->{$ind.'.type'} eq 'text') {
			my $text = $bbtree->{$ind.'.value'};
			$debug .= debug($printdebug, "text: ".$text);
			$out .= $escape ? html_encode_line($text) : $text;
			
			$goto_next = 'tx';
		}
		#tag
		elsif ($bbtree->{$ind.'.type'} eq 'tag') {
			my $name = $bbtree->{$ind.'.name'};
			#endtag
			if ($name =~ /^\//) {
				$debug .= debug($printdebug, "tag: [$name]");
				$indd = $ind;
				$indd =~ s/\.([0-9]+)$//;
				if (exists($tags->{$name.'='}) && ($bbtree->{$indd.'.value'} ne '')) {
					$out .= $tags->{$name.'='};
				}
				elsif (exists($tags->{$name})) {
					$out .= $tags->{$name};
				}
				else {
					$out .= $tags->{'/?'};
					$debug .= debug($printdebug, "[unknown!]");
				}
				
				$ind =~ s/\.([0-9]+)$//;
				$level -= 1;
				$debug .= debug($printdebug, "[<]");
				if ($level > 0) {
					$goto_next = 'nd';
				}
				else {
					# time to end this
					$level = -1;
				}
			}
			#starttag
			else {
				my $value = $bbtree->{$ind.'.value'};
				if($bbtree->{$ind.'.closed'} ne '') {
					$debug .= debug($printdebug, "tag: [$name]");
					
					if (exists($tags->{$name.'='}) && ($value ne '')) {
						if (exists($tags->{$name.'='.$value})) {
							$out .=
								$tags->{$name.'='} .
								$tags->{$name.'='.$value} .
								$tags->{$name.'/='};
						}
						else {
							$out .=
								$tags->{$name.'='} .
								($escape ? html_entity_encode_dec($value, 1) : $value) .
								$tags->{$name.'/='};
						}
					}
					elsif (exists($tags->{$name})) {
						$out .= $tags->{$name};
					}
					else {
						$out .= $out.$tags->{'?'};
						$debug .= debug($printdebug, "[unknown!]");
					}
				}
				else {
					$debug .= debug($printdebug, "unclosed tag: [$name]");
					my $text = $name . (($value ne '') ? ('='.$value) : '');
					$out .= '['.($escape ? html_encode_line($text) : $text).']';
				}
				if ($bbtree->{$ind.'.count'} > 0) {
					$ind = $ind.'.0';
					$level += 1;
					$debug .= debug($printdebug, "[>]");
				}
				else {
					$goto_next = 'st';
				}
			}
		}
		# what is this
		else {
			$debug .= debug($printdebug, "unknown thing: ".$bbtree->{$ind.'.type'});
			#should not occur with a correct bbtree
			#unless unimplemented
			$ind =~ s/\.([0-9]+)$//;
			$level -= 1;
			$debug .= debug($printdebug, "[<ui]");
			if ($level > 0) {
				$goto_next = 'un';
			}
			else {
				# time to end this
				$level = -1;
			}
		}
		if ($goto_next ne '') {
			{do{
				$ind =~ s/\.([0-9]+)$//;
				my $i = int($1) + 1;
				if (($i < $bbtree->{$ind.'.count'}) and ($1 ne '')){
					# goto next
					$ind = $ind.'.'.$i;
					last;
				}
				else {
					# step out
					# should not occur with a correct bbtree
					$debug .= debug($printdebug, "[<$goto_next]");
					$level -= 1;
				}
			} while ($level >= 0);}
		}
		
		$debug .= debug($printdebug, "[>$level:$ind]\n");
	}
	
	$debug .= debug($printdebug, "-->\n");
	return ($debug, $out);
}

#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;
}

sub eval_bb {
	(my $bb, my $full_url, my $password) = @_;
	my $value;
	my $before;
	my $after;
	
	my $base_url = $full_url ?
		{'scheme' => SCHEME(), 'host' => WEBSITE()} :
		{'path' => ''};
	
	while ($bb =~ m/###([^#;]*);/g) {
		$value = $1;
		$before = $`;
		$after = $';
		
		if ($value =~ /^att&([0-9]+)$/) {
			$value = merge_url(
				$base_url,
				{'path' => CGI_ATTACH_PATH()},
				{'path' => int($1)}
			)
		}
		elsif ($value =~ /^vw&([0-9]+)$/) {
			$value = merge_url(
				$base_url,
				{'path' => CGI_VIEWER_PATH()},
				{'path' => int($1)}
			)
		}
		elsif ($value =~ /^fr&([0-9]+)$/) {
			$value = merge_url(
				$base_url,
				{'path' => CGI_FRAME_PATH()},
				{'path' => int($1)}
			)
		}
		else {
			$value = '';
		}
		if (($value ne '') && ($password ne '')) {
			$value = merge_url(
				$value,
				{'query' => {'p' => $password}}
			);
		}
		$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;
}

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 {
	(my $fh) = @_;
	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, my $hide_credits) = @_;
	print $fh '  </div>'."\n";
	unless ($hide_credits) {
		print $fh '  <p>'."\n";
		print $fh '   '.html_entity_encode_dec(STORY_CREDITS(),1).'<br>'."\n";
		print $fh '   '.html_entity_encode_dec(INTF_CREDITS(),1).'<br>'."\n";
		print $fh '   <a href="'.html_entity_encode_dec(SOURCE_URL(),1).'" class="cz">source code</a>'."\n";
		print $fh '  </p>'."\n";
	}
	print $fh '  <a href="/" class="cz">'.html_entity_encode_dec(WEBSITE(),1).'</a>'."\n";
	print $fh ' </body>'."\n";
}

sub print_html_data {
	(my $fh, my $data) = @_;
	
	foreach my $key (keys %$data) {
		unless ($key eq 'content') {
			my $val = $data->{$key};
			$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_goto {
	(
		my $file,
		my $state,
		my $settings,
		my $goto_list,
		my $password_ok,
	) = @_;
	
	my $fh;
	my $last_frame;
	my $ong_state;
	my $password_query;
	
	$last_frame = int($state->{'last'});
	$ong_state  = int($state->{'state'});
	$password_query = url_query_encode({'p', $settings->{'password'}});
	
	my $_title        = html_entity_encode_dec($settings->{'story'}, 1);
	my $_website_name = html_entity_encode_dec(WEBSITE_NAME()    , 1);
	my $_base_url     = html_entity_encode_dec(CGI_PATH()        , 1);
	
	if (ref($file)) {
		$fh=$file;
		unless (seek($fh, 0, 0)) {
			#don't actually fail here
		}
	}
	else {
		unless (open_encoded($fh, ">:encoding(UTF-8)", $file)) {
			return 0;
		}
	}
	
	print_html_start($fh);
	print_html_head_start($fh);
	
	print $fh '  <title>GOTO &bull; '.$_title.' &bull; '.$_website_name.'</title>'."\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>'."\n";
	print $fh '   <div id="insb" class="ins">'."\n";

	print $fh '    <div id="chat">'."\n";
	
	for (my $frame = 0; ; $frame += 1) {
		unless (
			$password_ok || (
				($frame <= $last_frame) &&
				($ong_state >= STATE->{'waiting'})
			)
		) {
			last;
		}
		my $title;
		my $ongtime;
		my @time_tab;
		my $time_text;
		my $timer_color;
		my $frame_text;
		my $viewer_url;
		
		$ongtime = $goto_list->{'ongtime-'.$frame};
		$title   = $goto_list->{'title-'  .$frame};
		if (($ongtime eq '') && ($title eq '')) {
			my %frame_data = read_frame_data($frame);
			$ongtime = $frame_data{'ongtime'};
			$title   = $frame_data{'title'};
			unless (keys %frame_data) {
				last;
			}
		}
		
		if ($ongtime ne '') {
			@time_tab = gmtime($ongtime);
			$time_text = sprintf(
				'%02d.%02d.%02d %02d:%02d',
				$time_tab[3],
				$time_tab[4]+1,
				$time_tab[5]%100,
				$time_tab[2],
				$time_tab[1]
			);
		}
		else {
			$time_text = (($frame <= $last_frame) && ($ong_state >= STATE->{'waiting'})) ?
				'EE.EE.EE EE:EE' : '--.--.-- --:--';
		}
		if ($title eq '') {
			$title = '_';
		}
		$timer_color = (($frame > $last_frame) || ($ong_state < STATE->{'waiting'})) ?
			'cz' : (
				(($frame == $last_frame) && ($ong_state < STATE->{'ready'})) ?
					'ni' : 'br'
			);
		$frame_text = sprintf('%03d',$frame);
		$viewer_url = merge_url(
			{'path' => CGI_VIEWER_PATH()},
			{'path' => $frame}
		); # TODO: consider static here?
		if ($password_ok) {
			$viewer_url = merge_url($viewer_url, {'query' => $password_query, 'append_query' => 1, 'preserve_fragment' => 1});
		}
		
		my $_viewer_url = html_entity_encode_dec($viewer_url, 1);
		my $_title      = html_entity_encode_dec($title     , 1);
		
		print $fh '     <span class="'.$timer_color.'">'.$frame_text.'</span> '.$time_text.' <a href="'.$_viewer_url.'">'.$_title.'</a><br>'."\n";
	}
	print $fh '    </div>'."\n";

	print $fh '    <div id="underlinks">'."\n";
	print $fh '     <a href="'.$_base_url.'">BSTA</a>'."\n";
	print $fh '    </div>'."\n";

	print $fh '   </div>'."\n";

	print_html_body_end($fh, $ong_state == STATE->{'inactive'});
	print_html_end($fh);
	
	unless (ref($file)) {
		close ($fh);
	}
	else {
		truncate ($fh , tell($fh));
	}
	
	return 1;
}

sub print_viewer_page {
	(
		my $file,
		my $context,
		my $state,
		my $settings,
		my $frame_data,
		my $prev_frame_data,
		my $next_frame_data,
		my $words_data,
	) = @_;
	my $fh;
	
	my $launch      = $context->{'launch'};
	my $access      = $context->{'access'};
	my $password_ok = $context->{'password_ok'};
	my $static      = $context->{'static'};
	
	my $goto           = int($context->{'goto'});
	my $frame          = int($context->{'frame'});
	my $text_mode      = int($context->{'text_mode'});
	my $timer_unlocked = int($context->{'timer_unlocked'});
	my $timer          = int($context->{'timer'});
	# my $words_page     = int($context->{'words_page'});
	
	my $prev_frame = $frame - 1;
	my $next_frame = $frame + 1;
	
	my $story = $settings->{'story'};
	my $title = $frame_data->{'title'};
	my $command = ($frame_data->{'command'} ne '') ?
		$frame_data->{'command'} :
		$next_frame_data->{'title'};
	
	my $last_frame = int($state->{'last'});
	my $ong_state  = int($state->{'state'});
	
	my $width  = int($frame_data->{'width'});
	my $height = int($frame_data->{'height'});
	my $frame_type = $frame_data->{'frametype'};
	
	my $timer_color_h = (($timer_unlocked >= 1) || ($ong_state >= STATE->{'ready'})) ? 'br' : 'ni';
	my $timer_color_m = (($timer_unlocked >= 2) || ($ong_state >= STATE->{'ready'})) ? 'br' : 'ni';
	my $timer_color_s = (($timer_unlocked >= 3) || ($ong_state >= STATE->{'ready'})) ? 'br' : 'ni';
	
	my $timer_h;
	my $timer_m;
	my $timer_s;
	if (
		($timer > 0) ||
		(($timer >= 0) && ($frame == 0))
	) {
		$timer_s = sprintf('%02d', $timer % 60);
		$timer_h = int($timer / 60);
		$timer_m = sprintf('%02d', $timer_h % 60);
		$timer_h = sprintf('%02d', $timer_h / 60);
	}
	elsif (($timer >= -15) && ($ong_state >= STATE->{'ready'})) {
		$timer_h = '00';
		$timer_m = '00';
		$timer_s = 'NG';
	}
	else {
		$timer_h = 'EE';
		$timer_m = 'EE';
		$timer_s = 'EE';
	}
	
	my $words_posts = int($words_data->{'posts'});
	my $words_link_text = 'Words'.(($words_posts > 0) ? "[$words_posts]" : '');
	
	my $prev_available = (($frame > 0) && $access);
	my $next_available = ($launch || $password_ok || ($next_frame <= $last_frame));
	my $prefetch_prev = (
		$password_ok ||
		($prev_frame < $last_frame) || (  # avoid unseen trigger!
			($prev_frame <= $last_frame) &&
			($ong_state >= STATE->{'ready'})
		)
	);
	my $prefetch_next  = (
		$password_ok ||
		($next_frame < $last_frame) || (  # avoid unseen trigger!
			($next_frame <= $last_frame) &&
			($ong_state >= STATE->{'ready'})
		)
	);
	my $show_timer = (
		(
			$access && $launch
		) || (
			($frame == $last_frame) && (
				($ong_state == STATE->{'waiting'}) ||
				($ong_state == STATE->{'ready'})
			)
		)
	);
	my $show_command = (
		$launch ||
		$password_ok ||
		(!$access) ||
		($frame < $last_frame) || (
			($ong_state >= STATE->{'ready'}) &&
			$context->{'show_command'}
		)
	);
	my $show_command_link = ($next_available || (!$access));
	my $show_command_cursor = ((!$next_available) || ($command eq ''));
	my $show_words = ($password_ok || ($access && !$launch));
	
	my $frame_indirect = !(
		(!$access) || (
			($frame <= $last_frame) &&
			($ong_state > STATE->{'inactive'})
		)
	);
	my $prevframe_indirect = !($prev_frame <= $last_frame);
	my $nextframe_indirect = !($next_frame <= $last_frame);
	
	my $password_query;
	
	my $base_url   = CGI_PATH();
	my $timer_url  = CGI_TIMER_PATH();
	my $viewer_full_url = merge_url(
		{'scheme' => SCHEME(), 'host' => WEBSITE()},
		{'path' => CGI_VIEWER_PATH()},
		{'path' => $frame}
	);
	my $viewer_url = merge_url(
		{'path' => CGI_VIEWER_PATH()},
		{'path' => $frame}
	);
	my $viewer_0_url = merge_url(
		{'path' => CGI_VIEWER_PATH()},
		{'path' => 0}
	);
	my $viewer_prev_url = merge_url(
		{'path' => CGI_VIEWER_PATH()},
		{'path' => $prev_frame}
	);
	my $viewer_next_url = merge_url(
		{'path' => CGI_VIEWER_PATH()},
		{'path' => $next_frame}
	);
	my $viewer_last_url = merge_url(
		{'path' => CGI_VIEWER_PATH()},
		{'path' => ($static ? -1 : $last_frame)}
	);
	my $goto_url = ($goto) ?
		CGI_GOTO_PATH() :
		merge_url(
			{'path' => $viewer_url},
			{
				'query' => {'g' => 1},
				'fragment' => 'goto'
			}
		);
	
	unless ($password_ok) {
		my $page_file;
		$viewer_0_url = $base_url;
		if ($prev_frame == 0) {
			$viewer_prev_url = $viewer_0_url;
		}
		else {
			$page_file = get_page_file($prev_frame, $prev_frame_data, $settings);
			if (_x_encoded('-f',
				join_path(PATH_SEPARATOR(), WWW_PATH() , $page_file)
			)) {
				$viewer_prev_url = merge_url(
					{'path' => $base_url},
					{'path' => $page_file}
				);
			}
		}
		if ($next_frame < $last_frame) {
			$page_file = get_page_file($next_frame, $next_frame_data, $settings);
			if (_x_encoded('-f',
				join_path(PATH_SEPARATOR(), WWW_PATH() , $page_file)
			)) {
				$viewer_next_url = merge_url(
					{'path' => $base_url},
					{'path' => $page_file}
				);
			}
		}
		if (
			$goto &&
			(_x_encoded('-f',WWW_GOTO_PATH()))
		) {
			$goto_url = CGI_LIST_PATH();
		}
	}
	my $bbcode_url = ($text_mode == TEXT_MODE->{'bb'}) ?
		merge_url(
			{'path' => CGI_BBCODE_PATH()},
			{'path' => $frame}
		) :
		merge_url (
			$viewer_url,
			{
				'query'=>{
				'b' => TEXT_MODE->{'bb'}
				},
				'fragment'=>'insb'
			}
		);
	my $info_url = ($text_mode == TEXT_MODE->{'info'}) ?
		merge_url(
			{'path' => CGI_INFO_PATH()},
			{'path' => $frame}
		) :
		merge_url (
			$viewer_url,
			{
				'query'=>{
				'b' => TEXT_MODE->{'info'}
				},
				'fragment'=>'insb'
			}
		);
	my $words_url = merge_url (
		$viewer_url,
		{
			'query'=>{
			'b' => TEXT_MODE->{'words'}
			},
			'fragment'=>'insw'
		}
	);
	my $frame_file;
	my $frame_url;
	my $frame_prev_url;
	my $frame_next_url;
	my $frame_normal_url;
	my $frame_full_url;
	$frame_file = get_frame_file($frame, $frame_data, $settings);
	$frame_normal_url = merge_url(
			{'path' => CGI_PATH()},
			{'path' => $frame_file}
		);
	$frame_url = $frame_indirect ?
		merge_url(
			{'path' => CGI_FRAME_PATH()},
			{'path' => $frame}
		) :
		$frame_normal_url;
	$frame_full_url = merge_url(
		{'scheme' => SCHEME(), 'host' => WEBSITE()},
		{'path' => $frame_normal_url}
	);
	if ($prevframe_indirect) {
		$frame_prev_url = merge_url(
			{'path' => CGI_FRAME_PATH()},
			{'path' => $prev_frame}
		);
	}
	else {
		$frame_prev_url = merge_url(
			{'path' => CGI_PATH()},
			{'path' => get_frame_file($prev_frame, $prev_frame_data, $settings)}
		);
	}
	if ($nextframe_indirect) {
		$frame_next_url = merge_url(
			{'path' => CGI_FRAME_PATH()},
			{'path' => $next_frame}
		);
	}
	else {
		$frame_next_url = merge_url(
			{'path' => CGI_PATH()},
			{'path' => get_frame_file($next_frame, $next_frame_data, $settings)}
		);
	}
	
	if ($password_ok) {
		$password_query = url_query_encode({'p', $settings->{'password'}});
		$goto_url        = merge_url($goto_url       , {'query' => $password_query, 'append_query' => 1, 'preserve_fragment' => 1});
		$info_url        = merge_url($info_url       , {'query' => $password_query, 'append_query' => 1, 'preserve_fragment' => 1});
		$words_url       = merge_url($words_url      , {'query' => $password_query, 'append_query' => 1, 'preserve_fragment' => 1});
		$bbcode_url      = merge_url($bbcode_url     , {'query' => $password_query, 'append_query' => 1, 'preserve_fragment' => 1});
		$viewer_url      = merge_url($viewer_url     , {'query' => $password_query, 'append_query' => 1, 'preserve_fragment' => 1});
		$viewer_0_url    = merge_url($viewer_0_url   , {'query' => $password_query, 'append_query' => 1, 'preserve_fragment' => 1});
		$viewer_prev_url = merge_url($viewer_prev_url, {'query' => $password_query, 'append_query' => 1, 'preserve_fragment' => 1});
		$viewer_next_url = merge_url($viewer_next_url, {'query' => $password_query, 'append_query' => 1, 'preserve_fragment' => 1});
		$viewer_last_url = merge_url($viewer_last_url, {'query' => $password_query, 'append_query' => 1, 'preserve_fragment' => 1});
		if ($frame_indirect) {
			$frame_url     = merge_url($frame_url      , {'query' => $password_query, 'append_query' => 1, 'preserve_fragment' => 1});
		}
		if ($prevframe_indirect) {
			$frame_prev_url= merge_url($frame_prev_url , {'query' => $password_query, 'append_query' => 1, 'preserve_fragment' => 1});
		}
		if ($nextframe_indirect) {
			$frame_next_url= merge_url($frame_next_url , {'query' => $password_query, 'append_query' => 1, 'preserve_fragment' => 1});
		}
	}
	my $_password = $password_ok ? html_entity_encode_dec($settings->{'password'}, 1) : '';
	my $_action_url      = html_entity_encode_dec(CGI_VIEWER_PATH(), 1);
	my $_base_url        = html_entity_encode_dec($base_url        , 1);
	my $_goto_url        = html_entity_encode_dec($goto_url        , 1);
	my $_info_url        = html_entity_encode_dec($info_url        , 1);
	my $_words_url       = html_entity_encode_dec($words_url       , 1);
	my $_bbcode_url      = html_entity_encode_dec($bbcode_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_url      = html_entity_encode_dec($viewer_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 $_viewer_last_url = html_entity_encode_dec($viewer_last_url , 1);
	my $_frame_url       = html_entity_encode_dec($frame_url       , 1);
	my $_frame_prev_url  = html_entity_encode_dec($frame_prev_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 $_story      = html_entity_encode_dec($story     , 1);
	my $_title      = html_entity_encode_dec($title     , 1);
	my $_command    = html_entity_encode_dec($command   , 1);
	my $_frame_type = html_entity_encode_dec($frame_type, 1);
	
	my $_website_name = html_entity_encode_dec(WEBSITE_NAME(), 1);
	
	if ($text_mode == TEXT_MODE->{'info'}) {
		if ($show_command) {
			$frame_data->{'command'} = $command;
		}
		if ($access) {
			$frame_data->{'frame'} = $frame_file;
		}
		if ($frame_data->{'page'} eq '') {
			unless (($access) && ($frame < $last_frame)) {
				$frame_data->{'page'} = '';
			}
			else {
				$frame_data->{'page'} = get_page_file($frame, $frame_data, $settings);
			}
		}
	}
	
	# everything determined, now start generating
	
	if (ref($file)) {
		$fh=$file;
		unless (seek($fh, 0, 0)) {
			#don't actually fail here
		}
	}
	else {
		unless (open_encoded($fh, ">:encoding(UTF-8)", $file)) {
			return 0;
		}
	}
	
	print_html_start($fh);
	print_html_head_start($fh);
	
	print $fh '  <title>'.$_title;
	if ($story ne $title) {
		print $fh ' &bull; '.$_story;
	}
	print $fh ' &bull; '.$_website_name.'</title>'."\n";
	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 ($prefetch_prev) {
			print $fh '  <link rel="prefetch" href="'.$_viewer_prev_url.'">'."\n";
			print $fh '  <link rel="prefetch" href="'.$_frame_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>'."\n";
	print $fh '   <div id="framespace">'."\n";
	
	print $fh '    <img src="'.$_frame_url.'" id="frame" class="'.$_frame_type.'" alt="'.$frame.'" title="'.$_title.'" width="'.$width.'" height="'.$height.'">'."\n";
	
	print $fh '   </div>'."\n";
	print $fh '   <div id="insb" class="ins">'."\n";
	
	if ($text_mode == TEXT_MODE->{'info'}) {
		print $fh '    <div id="chat">'."\n";
		
		print_html_data($fh, $frame_data); 
		
		print $fh '    </div>'."\n";
	}
	elsif ($text_mode == 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'},
					1
				)
			)
		);
		print $fh '[/quote]'."\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'},
				0,
				$password_ok ? $settings->{'password'} : ''
			)
		)."\n";
		print $fh '    </div>'."\n";
	}
	
	print $fh '    <div id="command">'."\n";
	
	if ($show_timer) {
		print $fh '     <span id="timer">';
		print $fh '[<span id="ongh" class="hv '.$timer_color_h.'">'.$timer_h.'</span>';
		print $fh ':<span id="ongm" class="hv '.$timer_color_m.'">'.$timer_m.'</span>';
		print $fh ':<span id="ongs" class="hv '.$timer_color_s.'">'.$timer_s.'</span>]';
		print $fh '</span><br>'."\n";
	}
	print $fh '     &gt;';
	if ($show_command_link) {
		print $fh '<a href="'.($access ? $_viewer_next_url : $_viewer_last_url).'">';
	}
	if ($show_command) {
		print $fh $_command;
	}
	if ($show_command_cursor) {
		print $fh '<span class="inp">_</span>';
	}
	if ($show_command_link) {
		print $fh '</a>';
	}
	print $fh "<br>\n";
	print $fh "    </div>\n";
	
	print $fh '    <div id="underlinks">'."\n     ";
	
	unless (($frame == 0) && $static) {
		print $fh '<a href="'.$_base_url.'">Once again</a> | ';
	}
	if ($prev_available) {
		print $fh '<a href="'.$_viewer_prev_url.'">Before</a> | ';
	}
	unless ($frame == $last_frame) {
		print $fh '<a href="'.$_viewer_last_url.'">Now</a> | ';
	}
	print $fh '<a href="'.$_goto_url.'">GOTO</a>'."\n";
	print $fh '     <span style="float: right;">'."\n      ";
	if (
		($text_mode == TEXT_MODE->{'normal'}) &&
		(!$goto)
	){
		if ($show_words) {
			print $fh '<a href="'.$_words_url.'">'.$words_link_text.'</a> | ';
		}
	}
	else {
		print $fh '<a href="'.$_viewer_url.'">Without</a> | ';
	}
	print $fh '<a href="'.$_info_url.'">Info</a> | ';
	print $fh '<a href="'.$_bbcode_url.'">BB</a>';
	print $fh "\n     </span>\n";
	
	print $fh "    </div>\n";
	
	if ($goto) {
		print $fh '    <div class="underlinks" id="goto">'."\n";
		print $fh '     <form class="goto" method="get" action="'.$_action_url.'">'."\n";
		print $fh '      GO TO:'."\n";
		print $fh '      <input class="intx" type="number" size="4" name="f"'.(
			($goto > 1) ?
				('value="'.$frame.'"') :
				''
			).'>'."\n";
		print $fh '      <input class="inbt" type="submit" value="GO">'."\n";
		if ($password_ok) {
			print $fh '      <input type="hidden" name="p" value="'.$_password.'">'."\n";
		}
		print $fh '      <input type="hidden" name="g" value="2">'."\n";
		print $fh '     </form>'."\n";
		print $fh "    </div>\n";
	}
	
	print $fh "   </div>\n";
	
	if (($text_mode == TEXT_MODE->{'words'}) && $show_words) {
		print_comments($fh, $context, $settings, $words_data);
	}
	
	print_html_body_end($fh, $ong_state == STATE->{'inactive'});
	print_html_end($fh);
	
	
	unless (ref($file)) {
		close ($fh);
	}
	else {
		truncate ($fh , tell($fh));
	}
	
	return 1;
}

sub print_comments {
	(my $fh, my $context, my $settings, my $words_data) = @_;
	
	my $password_ok = $context->{'password_ok'};
	my $frame = int($context->{'frame'});
	my $page = int($context->{'words_page'});
	my $post_count = int($words_data->{'posts'});
	my $id_start = $page * COMMENT_PAGE_LENGTH();
	my $id_stop = $id_start + COMMENT_PAGE_LENGTH();
	my $older = ($page > 0) ? ($page-1) : '';
	my $newer;
	my $password_query;
	if ($id_stop >= $post_count) {
			$id_stop = $post_count;
	}
	else {
		$newer = $page+1;
	}
	my $links;
	
	my $words_url = merge_url(
		{'path' => CGI_VIEWER_PATH()},
		{
			'path' => $frame,
			'query' => {'b' => TEXT_MODE->{'words'}},
		}
	);
	my $older_url = merge_url(
		$words_url,
		{
			'query' => {'i' => $page-1},
			'fragment' => 'insw',
			'append_query' => 1
		}
	);
	my $newer_url = merge_url(
		$words_url,
		{
			'query' => {'i' => $page+1},
			'fragment' => 'insw',
			'append_query' => 1
		}
	);
	
	if ($password_ok) {
		$password_query = url_query_encode({'p', $settings->{'password'}});
		$older_url = merge_url($older_url, {'query' => $password_query, 'append_query' => 1, 'preserve_fragment' => 1});
		$newer_url = merge_url($older_url, {'query' => $password_query, 'append_query' => 1, 'preserve_fragment' => 1});
	}
	
	my $_password = $password_ok ? html_entity_encode_dec($settings->{'password'}, 1) : '';
	my $_post_url = html_entity_encode_dec(CGI_WORDS_PATH(), 1);
	my $_older_url = html_entity_encode_dec($older_url, 1);
	my $_newer_url = html_entity_encode_dec($newer_url, 1);
	
	if (($older ne '') || ($newer ne '')) {
		$links .= '    <div class="underlinks">'."\n";
		$links .= '     ';
		if ($older ne '') {
			$links .= '<a href="'.$_older_url.'">Older</a>'
		}
		if (($older ne '') && ($newer ne '')) {
			$links .= ' | ';
		}
		if ($newer ne '') {
			$links .= '<a href="'.$_newer_url.'">Newer</a>';
		}
		$links .= "\n";
		$links .= '    </div>'."\n";
	}
	
	print $fh '   <div class="space"></div>'."\n";
	print $fh '   <div id="insw" class="ins">'."\n";
	
	print $fh '    <div class="title" id="wordstitle">'."\n";
	print $fh '     <h1 class="titletext" id="wordstitletext">Words</h1>'."\n";
	print $fh '    </div>'."\n";
	
	if ($links ne '') {
		print $fh $links;
	}
	
	print $fh '    <div class="undertext" id="words">'."\n";
	
	if ($post_count > 0) {
		for (my $i=$id_start; $i<$id_stop; ++$i) {
			my $ID = $words_data->{'content'}->[$i];
			my %post_data = read_words($ID);
			
			my $post_time = int($post_data{'posttime'});
			my $edit_time = int($post_data{'edittime'});
			
			my $post_time_text;
			my $edit_time_text;
			
			if ($post_time != 0) {
				my @time_tab = gmtime($post_time);
				$post_time_text = sprintf(
					'%04d.%02d.%02d %02d:%02d:%02d UTC',
					$time_tab[5]+1900,
					$time_tab[4]+1,
					$time_tab[3],
					$time_tab[2],
					$time_tab[1],
					$time_tab[0]
				);
			}
			if (($edit_time !=0) && ($edit_time != $post_time)) {
				my @time_tab = gmtime($edit_time);
				$edit_time_text = sprintf(
					'%04d.%02d.%02d %02d:%02d UTC',
					$time_tab[5]+1900,
					$time_tab[4]+1,
					$time_tab[3],
					$time_tab[2],
					$time_tab[1]
				);
			}
			my $quote_url = merge_url(
				{'path' => CGI_WORDS_PATH()},
				{
					'query' => {
						'f' => $frame,
						'quote' => $ID,
						'p' => ($password_ok ? $settings->{'password'} : '')
					}
				}
			);
			my $edit_url = merge_url(
				{'path' => CGI_WORDS_PATH()},
				{
					'query' => {
						'f' => $frame,
						'edit' => $ID,
						'key' => $post_data{'key'},
						'username' => $post_data{'name'},
						'p' => ($password_ok ? $settings->{'password'} : '')
					}
				}
			);
			my $remove_url = merge_url(
				{'path' => CGI_WORDS_PATH()},
				{
					'query' => {
						'f' => $frame,
						'remove' => $ID,
						'key' => $post_data{'key'},
						'username' => $post_data{'name'},
						'p' => ($password_ok ? $settings->{'password'} : '')
					}
				}
			);
			
			my $_ID         = html_entity_encode_dec($ID, 1);
			my $_name       = html_entity_encode_dec($post_data{'name'}, 1);
			my $_quote_url  = html_entity_encode_dec($quote_url, 1);
			my $_edit_url   = html_entity_encode_dec($edit_url, 1);
			my $_remove_url = html_entity_encode_dec($remove_url, 1);
			
			print $fh '     <div id="'.$_ID.'"class="opomba">'."\n";
			print $fh '      <div class="opomba_info">'."\n";
			print $fh '       <a href="#'.$_ID.'" class="bi hu">'.$i.': '.$_name;
			if ($post_time_text ne '') {
				print $fh ' &bull; '.$post_time_text;
			}
			if ($edit_time_text ne '') {
				print $fh ' &bull; '.$edit_time_text;
			}
			print $fh '</a>'."\n";
			print $fh '       <div class="pr">'."\n";
			print $fh '        <a href="'.$_quote_url.'" class="bi hu">quote</a> | <a href="'.$_edit_url.'" class="bi hu">edit</a> | <a href="'.$_remove_url.'" class="bi hu">remove</a>'."\n";
			print $fh '       </div>'."\n";
			print $fh '      </div>'."\n";
			print $fh '      <div class="opomba_text">'."\n";
		  print $fh bb_to_html(
				eval_bb(
					$post_data{'content'},
					0,
					$password_ok ? $settings->{'password'} : ''
				)
			)."\n";
			print $fh '      </div>'."\n";
			print $fh '     </div>'."\n";
			print $fh '     <br>'."\n";
		}
	}
	
	print $fh '     <form method="post" action="'.$_post_url.'">'."\n";
	print $fh '      <b>Your words:</b>'."\n";
	print $fh '      <textarea class="inta" name="words" rows="4"></textarea>'."\n";
	print $fh '      <table cellpadding="0" cellspacing="0" border="0"><tr>'."\n";
	print $fh '       <td><b>Your name: </b></td>'."\n";
	print $fh '       <td><input class="intx" type="text" name="username" value=""></td>'."\n";
	print $fh '       <td></td>'."\n";
	print $fh '      </tr><tr>'."\n";
	print $fh '       <td><b>Optional password: </b></td>'."\n";
	print $fh '       <td><input class="intx" type="password" name="password" value=""></td>'."\n";
	print $fh '       <td>(if you want to edit later)</td>'."\n";
	print $fh '      </tr><tr>'."\n";
	print $fh '       <td><b>Leave this empty: </b></td>'."\n";
	print $fh '       <td><input class="intx" type="text" name="password2" value=""></td>'."\n";
	print $fh '       <td>'."\n";
	print $fh '        <input class="inbt" type="submit" name="post" value="Send">'."\n";
	print $fh '        <input class="inbt" type="submit" name="preview" value="Preview">'."\n";
	print $fh '       </td>'."\n";
	print $fh '      </tr></table>'."\n";
	print $fh '      <input type="hidden" name="f" value="'.$frame.'">'."\n";
	if ($password_ok) {
		print $fh '      <input type="hidden" name="p" value="'.$_password.'">'."\n";
	}
	print $fh '     </form>'."\n";
	print $fh '    </div>'."\n";
	
	if ($links ne '') {
		print $fh $links;
	}
	
	print $fh '   </div>'."\n";
}

sub write_index {
	(
		my $state,
		my $settings,
		my $pass,
		my $mode,
		my $pause
	) = @_;
	my $fh;
	my $r = 1;
	my $ong_state = int($state->{'state'});
	
	unless (open_encoded($fh, ">:encoding(UTF-8)", WWW_INDEX_PATH())) {
		return 0;
	}
	
	# normal running story
	if ($ong_state > STATE->{'inactive'}) {
		my %default        = read_default();
		my %frame_data     = read_frame_data(0, \%default);
		my %next_frame_data= read_frame_data(1, \%default);
		my %words_data     = read_words_list(
			0, # frame ID
			1,  # header only
		);
		
		$r = print_viewer_page(
			$fh,
			{
				'launch'         => 0,
				'frame'          => 0,
				'access'         => 1,
				'password_ok'    => 0,
				'timer_unlocked' => 3, # not relevant
				'timer'          => 0, # not relevant
				'static'         => 1,
				'show_command'   => 1,
				'text_mode'      => TEXT_MODE->{'normal'},
				'words_page'     => 0, # not relevant
				'goto'           => 0
			},
			$state,
			$settings,
			\%frame_data,
			\%default, # prev
			\%next_frame_data,
			\%words_data
		);
	}
	# no conditions met, pretend a normal Apache2 index
	elsif ($pass != 1) { 
		my $index_of = CGI_PATH;
		$index_of =~ s/\/$//g;
		
		my $_index_of     = html_entity_encode_dec($index_of  , 1);
		my $_2words_date  = html_entity_encode_dec(INTF_DATE(), 1);
		my $_coin_date    = html_entity_encode_dec(COIN_DATE(), 1);
		my $_website      = html_entity_encode_dec(WEBSITE()  , 1);
		
		print_html_start ($fh);
		print $fh ' <head>'."\n";
		print $fh '  <meta http-equiv="Content-type" content="text/html; charset=UTF-8">'."\n";
		print $fh '  <title>Index of '.$_index_of.'</title>'."\n";
		print $fh ' </head>'."\n";
		print $fh ' <body>'."\n";
		print $fh '  <h1>Index of '.$_index_of.'</h1>'."\n";
		print $fh '  <table>'."\n";
		print $fh '   <tr>'."\n";
		print $fh '    <th><img src="/icons/blank.gif" alt="[ICO]"></th>'."\n";
		print $fh '    <th><a href="?C=N;O=D">Name</a></th>'."\n";
		print $fh '    <th><a href="?C=M;O=A">Last modified</a></th>'."\n";
		print $fh '    <th><a href="?C=S;O=A">Size</a></th>'."\n";
		print $fh '    <th><a href="?C=D;O=A">Description</a></th>'."\n";
		print $fh '   </tr><tr>'."\n";
		print $fh '    <th colspan="5"><hr></th>'."\n";
		print $fh '   </tr><tr>'."\n";
		print $fh '    <td valign="top"><img src="/icons/back.gif" alt="[DIR]"></td>'."\n";
		print $fh '    <td><a href="/">Parent Directory</a></td>'."\n";
		print $fh '    <td>&nbsp;</td>'."\n";
		print $fh '    <td align="right">  - </td>'."\n";
		print $fh '    <td>&nbsp;</td>'."\n";
		print $fh '   </tr><tr>'."\n";
		print $fh '    <td valign="top"><img src="/icons/folder.gif" alt="[DIR]"></td>'."\n";
		print $fh '    <td><a href="2words/">2words/</a></td>'."\n";
		print $fh '    <td align="right">'.$_2words_date.'  </td>'."\n";
		print $fh '    <td align="right">  - </td><td>&nbsp;</td>'."\n";
		print $fh '   </tr><tr>'."\n";
		print $fh '    <td valign="top"><img src="/icons/folder.gif" alt="[DIR]"></td>'."\n";
		print $fh '    <td><a href="coin/">coin/</a></td>'."\n";
		print $fh '    <td align="right">'.$_coin_date.'  </td>'."\n";
		print $fh '    <td align="right">  - </td><td> Coincidence </td>'."\n";
		print $fh '   </tr><tr>'."\n";
		print $fh '    <th colspan="5"><hr></th>'."\n";
		print $fh '   </tr>'."\n";
		print $fh '  </table>'."\n";
		print $fh '  <address>Apache/2.2.22 (Debian) Server at '.$_website.' Port 80</address>'."\n";
		print $fh '  </body>'."\n";
		print_html_end ($fh);
	}
	# the launch index
	else {
		my %default        = read_default();
		my %frame_data     = read_frame_data(0, \%default);
		my %next_frame_data= read_frame_data(1, \%default);
		my %coin_data      = read_coincidence();
		
		if (($mode == INTF_STATE->{'>'}) && $pause) {
			$r = print_viewer_page(
				$fh,
				{
					'launch'         => 1,
					'frame'          => 0,
					'access'         => 1,
					'password_ok'    => 0,
					'timer_unlocked' => 3,
					'timer'          => 0,
					'static'         => 1,
					'show_command'   => 1,
					'text_mode'      => TEXT_MODE->{'normal'},
					'words_page'     => 0, # not relevant
					'goto'           => 0
				},
				$state,
				$settings,
				\%frame_data,
				\%default, # prev
				\%next_frame_data,
				{'posts' => 0} # words_data
			);
			return $r;
		}
		
		my $index_of = CGI_PATH;
		$index_of =~ s/\/$//g;
		my $title;
		my $frame_file;
		my $undertext = '';
		my $show_parent_dir = 0;
		my $show_yb = 0;
		my $show_folders = 0;
		my $timer = '';
		my $timer_color = 'ni';
		if ($mode == INTF_STATE->{'>'}) {
			$title = $settings->{'story'}; # $frame_data{'title'} ?
			$frame_file = 'intf-tr.gif';
			$undertext = '...';
			$timer = '--';
		}
		elsif ($mode == INTF_STATE->{'<<'}) {
			$title = 'Index of';
			$frame_file = 'intf-ll.gif';
			$show_parent_dir = 1;
			$show_yb = 1;
			$timer = 'EE';
			$timer_color = 'br';
		}
		elsif ($mode == INTF_STATE->{'>>'}) {
			$title = 'Index of';
			$frame_file = 'intf-pp.gif';
			$show_parent_dir = 1;
			$show_yb = 1;
			$timer = 'EE';
		}
		else
		{
			$title = 'Index of '.$index_of;
			$frame_file = 'intf-kw.gif';
			$show_parent_dir = 1;
			$show_folders = 1;
		}
		my $frame_url = merge_url(
			{'path' => CGI_PATH()},
			{'path' => $frame_file}
		);
		my $coin_server = $coin_data{'server'};
		
		my $_title        = html_entity_encode_dec($title           , 1);
		my $_website_name = html_entity_encode_dec(WEBSITE_NAME()   , 1);
		my $_frame_url    = html_entity_encode_dec($frame_url       , 1);
		my $_undertext    = html_entity_encode_dec($undertext       , 1);
		my $_2words_date  = html_entity_encode_dec(INTF_DATE()      , 1);
		my $_coin_date    = html_entity_encode_dec(COIN_DATE()      , 1);
		my $_coin_server  = html_entity_encode_dec($coin_server     , 1);
		my $_2words_url   = html_entity_encode_dec(CGI_2WORDS_PATH(), 1);
		my $_coin_url     = html_entity_encode_dec(CGI_COIN_PATH()  , 1);
		
		print_html_start($fh);
		print_html_head_start($fh);
		
		print $fh '  <title>'.$_title.' &bull; '.$_website_name.'</title>'."\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>'."\n";
		print $fh '   <div id="framespace">'."\n";
		
		print $fh '    <img src="'.$_frame_url.'" id="frame" alt="0">'."\n"; # title="'.$_title.'"
		
		print $fh '   </div>'."\n";
		print $fh '   <div id="insb" class="ins">'."\n";
		
		print $fh '    <div id="undertext">'."\n";
		
		if ($show_parent_dir) {
			print $fh '     <img src="/icons/back.gif" alt="[DIR]"> <a href="..">Parent Directory</a><br>'."\n";
		}
		if ($show_folders) {
			print $fh '     <img src="/icons/folder.gif" alt="[DIR]"> <a href="'.$_2words_url.'">2words/</a> '.$_2words_date.' - <br>'."\n";
			print $fh '     <img src="/icons/folder.gif" alt="[DIR]"> <a href="'.$_coin_url.'">coin/</a> '.$_coin_date.' - '.$_coin_server."\n";
		}
		elsif ($show_yb) {
			print $fh '     <img src="/icons/folder.gif" alt="[DIR]"> <a href="'.$_2words_url.'">yyyyb/</a>'."\n";
		}
		if ($undertext ne '') {
			print $fh '     '.$_undertext."\n";
		}
		
		print $fh '    </div>'."\n";
		
		if ($timer ne '') {
			print $fh '    <div id="command">'."\n";
			
			print $fh '     [<span id="ongh" class="'.$timer_color.'">'.$timer.'</span>';
			print $fh      ':<span id="ongm" class="'.$timer_color.'">'.$timer.'</span>';
			print $fh      ':<span id="ongs" class="'.$timer_color.'">'.$timer.'</span>]<br>'."\n";
			
			if ($undertext ne '') {
				print $fh '&gt;<a href="'.$_2words_url.'">'.$_undertext.'</a><span class="inp">_</span>'."\n";
			}
			print $fh "    </div>\n";
		}
		
		print $fh "   </div>\n";
		
		print_html_body_end($fh, $ong_state == STATE->{'inactive'});
		print_html_end($fh);
	}
	close ($fh);
	return $r
}

sub write_static_viewer_page {
	(
		my $frame,
		my $state_ref,
		my $settings_ref,
		my $default_ref,
		my $frame_data_ref,
		my $prev_frame_data_ref,
		my $next_frame_data_ref,
		my $words_data_ref
	) = @_;
	
	my %state;
	my %settings;
	my %default;
	my %frame_data;
	my %prev_frame_data;
	my %next_frame_data;
	my %words_data;
	
	my $file;
	
	$frame = int($frame);
	my $prev_frame = $frame -1;
	my $next_frame = $frame +1;
	
	%state = (ref ($state_ref)) ?
		%$state_ref :
		read_state();
	my $ong_state = int($state{'state'});
	my $last_frame = int($state{'last'});
	
	unless ($ong_state > STATE->{'inactive'}) {
		return 0;
	}
	unless (
		($frame >= 0) && (
			($frame < $last_frame) || (
				($frame <= $last_frame) &&
				($ong_state >= STATE->{'end'})
			)
		)
	) {
		return 0;
	}
	
	%settings = (ref ($settings_ref)) ?
		%$settings_ref :
		read_settings();
	%default = (ref ($default_ref)) ?
		%$default_ref :
		read_default();
	
	%frame_data = (ref ($frame_data_ref)) ?
		%$frame_data_ref :
		read_frame_data($frame);
	
	%prev_frame_data = (ref ($prev_frame_data_ref)) ?
		%$prev_frame_data_ref : (
			($prev_frame >= 0) ?
			read_frame_data($prev_frame) :
			%default
		);
		
	%next_frame_data = (ref ($next_frame_data_ref)) ?
		%$next_frame_data_ref :
		read_frame_data($next_frame);
	
	%words_data = (ref ($words_data_ref)) ?
		%$words_data_ref :
		read_words_list(
			$frame, # frame ID
			1,  # header only
		);
	
	%frame_data      = merge_settings(\%default, \%frame_data);
	%prev_frame_data = merge_settings(\%default, \%prev_frame_data);
	%next_frame_data = merge_settings(\%default, \%next_frame_data);
	
	$file = get_page_file($frame, \%frame_data, \%settings);
	$file = join_path(PATH_SEPARATOR(), WWW_PATH(), $file);
	
	return print_viewer_page(
		$file,
		{
			'launch'        => 0,
			'frame'         => $frame,
			'access'        => 1,
			'password_ok'   => 0,
			'timer_unlocked'=> 3, # not relevant
			'timer'         => 0, # not relevant
			'static'        => 1,
			'show_command'  => 1,
			'text_mode'     => TEXT_MODE->{'normal'},
			'words_page'    => 0, # not relevant
			'goto'          => 0
		},
		\%state,
		\%settings,
		\%frame_data,
		\%prev_frame_data,
		\%next_frame_data,
		\%words_data
	);
}

sub write_static_goto {
	(my $state_ref, my $settings_ref, my $goto_ref) = @_;
	my %state;
	my %settings;
	my %goto_list;
	
	%state = (ref ($state_ref)) ?
		%$state_ref :
		read_state();
	%settings = (ref ($settings_ref)) ?
		%$settings_ref :
		read_settings();
	%goto_list = (ref ($goto_ref)) ?
		%$goto_ref :
		read_goto();
	
	return print_goto(
		WWW_GOTO_PATH(),
		\%state,
		\%settings,
		\%goto_list,
		0, # password OK
	);
}

# ONG the frame + attachment & stuff. NOT update state file.
sub ong {
	(
		my $ID, my $ongtime, my $timer, my $update, my $print,
		my $settings_ref, my $default_ref, my $data_ref, my $goto_ref
	) = @_;
	my @files;
	my $cfrt;
	my $intf;
	my $frame;
	my $frame_data_path;
	my $write_data;
	my $in_path;
	my $out_path;
	my $r;
	my %settings;
	my %default;
	my %frame_data;
	my %frame_full_data;
	my %goto_list;
	
	if ($ongtime eq '') {
		$ongtime = time();
	}
	
	if ($ID eq 'i') {
		$intf = 1;
	}
	elsif ($ID eq 'c') {
		$cfrt = 1;
	}
	else {
		$frame = int($ID);
	}
	
	if ($intf) {
		@files = (
			'intf-00.gif',
			'intf-00_04.gif',
			'intf-00_08.gif',
			'intf-00_10.gif',
			'intf-01.gif',
			'intf-01_.gif',
			'intf-02.gif',
			'intf-02_.gif',
			'intf-04.gif',
			'intf-04_.gif',
			'intf-08.gif',
			'intf-08_.gif',
			'intf-10.gif',
			'intf-10_.gif',
			'intf-20.gif',
			'intf-20_.gif',
			'intf-kw.gif',
			'intf-ll.gif',
			'intf-pp.gif',
			'intf-tr.gif',
		);
	}
	else {
		%settings = (ref ($settings_ref)) ?
			%$settings_ref :
			read_settings();
		%default = (ref ($default_ref)) ? %$default_ref : read_default();
		$frame_data_path = $cfrt ?
			DATA_NOACCESS_PATH() :
			join_path(PATH_SEPARATOR(), DATA_PATH(), $frame);
		%frame_data = (ref ($data_ref)) ?
			%$data_ref :
			read_frame_data($frame_data_path);
		%frame_full_data = merge_settings(\%default, \%frame_data);
		@files = (get_frame_file($frame, \%frame_full_data, \%settings), );
		unless ($cfrt) {
			%goto_list = (ref ($goto_ref)) ?
				%$goto_ref :
				read_goto();
			for (my $i=0; ;$i+=1) {
				my %file_data = read_attachment($i);
				if ($file_data{'frame'} eq '') {
					last;
				}
				if (int($file_data{'frame'}) != $frame) {
					next;
				}
				if ($file_data{'content'} ne '') {
					next;
				}
				unshift @files, $file_data{'filename'};
			}
			if (
				(!$update) ||
				($frame_full_data{'ongtime'} eq '')
			) {
				$frame_data     {'ongtime'} = $ongtime;
				$frame_full_data{'ongtime'} = $ongtime;
				$write_data = 1;
			}
			if (
				($timer ne '') && (
					(!$update) ||
					($frame_full_data{'timer'} eq '')
				)
			) {
				$frame_data{'timer'} = int($timer);
				$write_data = 1;
			}
			if ($write_data) {
				$r = write_frame_data($frame_data_path, \%frame_data);
				unless ($r) {
					print STDERR "fail writing $frame_data_path\n";
					if ($print) {
						print "write frame data fail\n";
					}
					return $r;
				}
			}
			$goto_list{'title-'  .$frame} = $frame_full_data{'title'};
			$goto_list{'ongtime-'.$frame} = $frame_full_data{'ongtime'};
			$r = write_goto('', \%goto_list);
			unless ($r) {
				print STDERR "fail writing ".DATA_LIST_PATH()."\n";
				if ($print) {
					print "write GOTO list fail\n";
				}
				return $r;
			}
		}
	}
	foreach my $file (@files) {
		$in_path  = join_path(PATH_SEPARATOR(), DATA_PATH(), $file);
		$out_path = join_path(PATH_SEPARATOR(), WWW_PATH() , $file);
		if ($print) {
			print $in_path.' -> '.$out_path;
		}
		$r = copy_encoded($in_path, $out_path);
		if ($print) {
			print (($r) ? " OK\n" : " FAIL\n");
		}
		unless ($r) {
			print STDERR "fail copy $in_path $out_path\n";
			return $r
		}
	}
	
	return 1;
}


sub get_frame_file {
	(my $frame, my $frame_data, my $settings) = @_;
	my $file;
	my $pattern;
	
	if ($frame_data->{'frame'} ne '') {
		$file = $frame_data->{'frame'};
	}
	else {
		$pattern = validate_filename($settings->{'frame'}, '%d.%ext');
		$file = sprintf(
			$pattern,
			int($frame), $frame_data->{'ext'}
		);
	}
	return validate_filename($file);
}

sub get_page_file {
	(my $frame, my $frame_data, my $settings) = @_;
	my $file;
	my $pattern;
	
	if ($frame == 0) {
		return 'index.htm';
	}
	if ($frame_data->{'page'} ne '') {
		$file = $frame_data->{'page'};
	}
	else {
		$pattern = validate_filename($settings->{'frame'}, '%d.%ext');
		$file = sprintf(
			$pattern,
			int($frame), 'htm'
		);
	}
	return validate_filename($file);
}

sub validate_filename {
	(my $filename, my $fallback) = @_;
	if ($fallback eq '') {
		$fallback = '';
	}
	
	# TODO: more checks
	
	if ($filename =~ /^\./) {
		return $fallback;
	}
	if (index($filename, PATH_SEPARATOR()) >= 0) {
		return $fallback;
	}
	return $filename;
}

sub validate_frame_data {
	(my $data_in) = @_;
	my %data = %$data_in;
	
	if ($data{'ongtime'} ne '') {
		$data{'ongtime'} = int($data{'ongtime'});
	}
	if ($data{'timer'} ne '') {
		$data{'timer'} = int($data{'timer'});
	}
	if ($data{'width'} ne '') {
		$data{'width'} = int($data{'width'});
	}
	if ($data{'height'} ne '') {
		$data{'height'} = int($data{'height'});
	}
	if ($data{'page'} ne '') {
		$data{'page'} = validate_filename($data{'page'});
	}
	if ($data{'frame'} ne '') {
		$data{'frame'} = validate_filename($data{'frame'});
	}
	
	return %data;
}

sub validate_settings {
	(my $data_in) = @_;
	my %data = %$data_in;
	
	if ($data{'ongtime'} ne '') {
		$data{'ongtime'} = int($data{'ongtime'});
	}
	if ($data{'dynamicongtime'} ne '') {
		$data{'dynamicongtime'} = int($data{'dynamicongtime'});
	}
	if ($data{'firstongtime'} ne '') {
		$data{'firstongtime'} = int($data{'firstongtime'});
	}
	if ($data{'last'} ne '') {
		$data{'last'} = int($data{'last'});
	}
	$data{'frame'} = validate_filename($data{'frame'}, '%d.%s');
	
	return %data;
}

sub validate_state {
	(my $data_in) = @_;
	my %data = %$data_in;
	
	if ($data{'state'} ne '') {
		$data{'state'} = int($data{'state'});
	}
	if ($data{'last'} ne '') {
		$data{'last'} = int($data{'last'});
	}
	if ($data{'nextong'} ne '') {
		$data{'nextong'} = int($data{'nextong'});
	}
	
	return %data;
}

sub validate_words_list {
	(my $data_in, my $not_list) = @_;
	my %data = %$data_in;
	
	if ($data{'ongtime'} ne '') {
		$data{'ongtime'} = int($data{'ongtime'});
	}
	
	if ($not_list) {
		my $id_list = '';
		foreach my $ID (split(/\r?\n/, $data{'content'})) {
			$ID = validate_filename($ID);
			if ($ID ne '') {
				$id_list .= $ID."\n";
			}
		}
		$data{'content'} = $id_list;
	}
	else {
		my @id_list;
		foreach my $ID (@{$data{'content'}}) {
			
			$ID = validate_filename($ID);
			if ($ID ne '') {
				push @id_list, $ID;
			}
		}
		$data{'content'} = [@id_list];
	}
	
	return %data;
}

sub validate_words {
	(my $data_in) = @_;
	my %data = %$data_in;
	
	if ($data{'posttime'} ne '') {
		$data{'posttime'} = int($data{'posttime'});
	}
	if ($data{'edittime'} ne '') {
		$data{'edittime'} = int($data{'edittime'});
	}
	
	return %data;
}

sub validate_story {
	(my $data_in) = @_;
	my %data = %$data_in;
	
	if ($data{'id'} ne '') {
		$data{'id'} = int($data{'id'});
	}
	if ($data{'pass'} ne '') {
		$data{'pass'} = int($data{'pass'});
	}
	if ($data{'state'} ne '') {
		$data{'state'} = int($data{'state'});
	}
	
	return %data;
}

sub validate_goto {
	(my $data_in) = @_;
	my %data = %$data_in;
	
	foreach my $key (keys %data) {
		if ($key =~ /^ongtime-([0-9]+)$/) {
			my $new_key = 'ongtime-'.int($1);
			$data{$new_key} = int($data{$key});
			if ($new_key != $key) {
				delete $data{$key};
			}
		}
	}
	
	return %data;
}

sub validate_attachment {
	(my $data_in) = @_;
	my %data = %$data_in;
	
	if ($data{'frame'} ne '') {
		$data{'frame'} = int($data{'frame'});
	}
	$data{'filename'} = validate_filename($data{'filename'});
	
	return %data;
}

sub validate_coincidence {
	(my $data_in) = @_;
	my %data = %$data_in;
	
	if ($data{'server'} ne '') {
		$data{'server'} = int($data{'server'});
	}
	
	return %data;
}

sub read_frame_data {
	(my $f, my $default) = @_;
	my $file;
	my %data;
	
	if (ref ($f)) { # already open file
		$file = $f;
	}
	elsif ($f =~ /^[0-9]+$/) { # frame ID
		$file = join_path(PATH_SEPARATOR(), DATA_PATH(), int($&));
	}
	elsif ($f =~ /^(c(frt)?)|(noaccess)$/) { # CFRT (no access)
		$file = DATA_NOACCESS_PATH();
	}
	elsif ($f =~ /^d(efault)?$/) { # default
		$file = DATA_DEFAULT_PATH();
	}
	elsif ($f ne '') { # path
		$file = $f;
	}
	else {
		$file = DATA_DEFAULT_PATH();
	}
	
	%data = read_data_file($file);
	if (ref ($default)) {
		%data = merge_settings($default, \%data);
	}
	elsif ($default ne '') {
		my %default_data = read_data_file(DATA_DEFAULT_PATH());
		%data = merge_settings(\%default_data, \%data);
	}
	
	return validate_frame_data(\%data);
}

sub write_frame_data {
	(my $f, my $data) = @_;
	my $file;
	
	if (ref ($f)) { # already open file
		$file = $f;
	}
	elsif ($f =~ /^[0-9]+$/) { # frame ID
		$file = join_path(PATH_SEPARATOR(), DATA_PATH(), int($&));
	}
	elsif ($f =~ /^(c(frt)?)|(noaccess)$/) { # CFRT (no access)
		return 0; # forbidden
	}
	elsif ($f =~ /^d(efault)?$/) { # default
		return 0; # forbidden
	}
	elsif ($f ne '') { # path
		$file = $f;
	}
	else {
		return 0; # forbidden
	}
	
	my %_data = validate_frame_data($data);
	
	return write_data_file($file, \%_data);
}

sub read_default {
	return read_frame_data('default');
}

sub read_noaccess {
	(my $default) = @_;
	return read_frame_data('noaccess', $default);
}

sub read_settings {
	(my $f) = @_;
	my $file;
	my %data;
	
	if (ref ($f)) { # already open file
		$file = $f;
	}
	elsif ($f ne '') { # path
		$file = $f;
	}
	else {
		$file = DATA_SETTINGS_PATH();
	}
	
	%data = read_data_file($file);
	
	return validate_settings(\%data);
}

sub read_state {
	(my $f) = @_;
	my $file;
	my %data;
	
	if (ref ($f)) { # already open file
		$file = $f;
	}
	elsif ($f ne '') { # path
		$file = $f;
	}
	else {
		$file = DATA_STATE_PATH();
	}
	
	%data = read_data_file($file);
	
	return validate_state(\%data);
}

sub write_state {
	(my $f, my $data) = @_;
	my $file;
	
	if (ref ($f)) { # already open file
		$file = $f;
	}
	elsif ($f ne '') { # path
		$file = $f;
	}
	else {
		$file = PERL_DATA_STATE_PATH();
	}
	
	my %_data = validate_state($data);
	
	return write_data_file($file, \%_data);
}

sub read_words_list {
	(my $f, my $header_only, my $not_list) = @_;
	my $file;
	my %data;
	
	if (ref ($f)) { # already open file
		$file = $f;
	}
	elsif ($f =~ /^[0-9]+$/) { # frame ID
		$file = join_path(PATH_SEPARATOR(), DATA_WORDS_PATH(), int($&));
	}
	elsif ($f ne '') { # path
		$file = $f;
	}
	else { # which frame ???
		return ('posts' => 0);
	}
	
	%data = read_data_file(
		$file,
		'', # encoding
		0,  # no header
		$header_only,
		not $not_list # as list
	);
	
	return validate_words_list(\%data, $not_list);
}

sub write_words_list {
	(my $f, my $data) = @_;
	my $file;
	
	if (ref ($f)) { # already open file
		$file = $f;
	}
	elsif ($f =~ /^[0-9]+$/) { # frame ID
		$file = join_path(PATH_SEPARATOR(), DATA_WORDS_PATH(), int($&));
	}
	elsif ($f ne '') { # path
		$file = $f;
	}
	else { # which frame ???
		return 0;
	}
	
	my %_data = validate_words_list($data);
	
	return write_data_file(
		$file, # file 
		\%_data,
		'',  # encoding
		0,   # no header
		0,   # header only
		1    # as list
	);
}

sub read_words {
	(my $f, my $default) = @_;
	my $file;
	my %data;
	
	if (ref ($f)) { # already open file
		$file = $f;
	}
	elsif ($f =~ /^[0-9]+\.[0-9\.]+$/) { # post ID
		$file = join_path(PATH_SEPARATOR(), DATA_WORDS_PATH(), $&);
	}
	elsif ($f ne '') { # path
		$file = $f;
	}
	else { # which post ???
		return ();
	}
	
	%data = read_data_file($file);
	
	return validate_words(\%data);
}

sub write_words {
	(my $f, my $data) = @_;
	my $file;
	
	if (ref ($f)) { # already open file
		$file = $f;
	}
	elsif ($f =~ /^[0-9\.]+$/) { # post ID
		$file = join_path(PATH_SEPARATOR(), DATA_WORDS_PATH(), $&);
	}
	elsif ($f ne '') { # path
		$file = $f;
	}
	else { # which post ???
		return 0;
	}
	
	my %_data = validate_words($data);
	
	return write_data_file($file, \%_data);
}

sub read_story {
	(my $f) = @_;
	my $file;
	my %data;
	
	if (ref ($f)) { # already open file
		$file = $f;
	}
	elsif ($f =~ /^[0-9]+$/) { # story ID
		$file = DATA_STORY_PATH().int($&);
	}
	elsif ($f ne '') { # path
		$file = $f;
	}
	else {
		$file = DATA_STORY_PATH();
	}
	
	%data = read_data_file($file);
	
	return validate_story(\%data);
}

sub write_story {
	(my $f, my $data) = @_;
	my $file;
	
	if (ref ($f)) { # already open file
		$file = $f;
	}
	elsif ($f =~ /^[0-9]+$/) { # story ID
		$file = DATA_STORY_PATH().int($&);
	}
	elsif ($f ne '') { # path
		$file = $f;
	}
	else {
		$file = DATA_STORY_PATH();
	}
	
	my %_data = validate_story($data);
	
	return write_data_file($file, \%_data);
}

sub read_goto {
	(my $f) = @_;
	my $file;
	my %data;
	
	if (ref ($f)) { # already open file
		$file = $f;
	}
	elsif ($f ne '') { # path
		$file = $f;
	}
	else {
		$file = DATA_LIST_PATH();
	}
	
	%data = read_data_file($file);
	
	return validate_goto(\%data);
}

sub write_goto {
	(my $f, my $data) = @_;
	my $file;
	
	if (ref ($f)) { # already open file
		$file = $f;
	}
	elsif ($f ne '') { # path
		$file = $f;
	}
	else {
		$file = DATA_LIST_PATH();
	}
	
	my %_data = validate_goto($data);
	
	return write_data_file($file, \%_data);
}

sub read_attachment {
	(my $f, my $default) = @_;
	my $file;
	my %data;
	
	if (ref ($f)) { # already open file
		$file = $f;
	}
	elsif ($f =~ /^[0-9]+$/) { # attachment ID
		$file = DATA_ATTACH_PATH().int($&);
	}
	elsif ($f ne '') { # path
		$file = $f;
	}
	else {
		return ();
	}
	
	%data = read_data_file($file);
	
	return validate_attachment(\%data);
}

sub read_coincidence {
	(my $f) = @_;
	my $file;
	my %data;
	
	if (ref ($f)) { # already open file
		$file = $f;
	}
	elsif ($f ne '') { # path
		$file = $f;
	}
	else {
		$file = DATA_COIN_PATH();
	}
	
	%data = read_data_file($file);
	
	return validate_coincidence(\%data);
}

sub read_chat {
	(my $f) = @_;
	my $file;
	my %data;
	
	if (ref ($f)) { # already open file
		$file = $f;
	}
	elsif ($f =~ /^[0-9]+$/) { # chat ID
		$file = DATA_CHAT_PATH().int($&);
	}
	elsif ($f ne '') { # path
		$file = $f;
	}
	else {
		$file = DATA_CHAT_PATH();
	}
	
	return read_data_file($file);
	
	# no validation
}

sub write_chat {
	(my $f, my $data) = @_;
	my $file;
	
	if (ref ($f)) { # already open file
		$file = $f;
	}
	elsif ($f =~ /^[0-9]+$/) { # chat ID
		$file = DATA_CHAT_PATH().int($&);
	}
	elsif ($f ne '') { # path
		$file = $f;
	}
	else {
		$file = DATA_CHAT_PATH();
	}
	
	# no validation
	
	return write_data_file($file, $data);
}


1
