#
# Library of functions
#
-# Copyright (C) 2016, 2017, 2019, 2020, 2022, 2023 Balthasar Szczepański
+# 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
# 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);
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',
- 'bb2ht', 'bb2bb'
+ '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 (
- 'html_entity_encode_dec'
+ '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
-# 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' => '◊',
-};
+###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
+ '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 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 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 tagsht => {
+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">',
'/?' => '[/unknown!]',
};
-use constant HTML_START =>
- '<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "">'."\n".
- '<html lang="en">'."\n";
-use constant HTML_END =>
- '</html>'."\n";
-use constant HTML_HEAD_START =>
- '<head>'."\n".
- '<meta http-equiv="Content-type" content="text/html; charset=UTF-8">'."\n";
-use constant HTML_HEAD_END =>
- '</head>'."\n";
-use constant HTML_BODY_START =>
- '<body>'."\n".
- '<a href="/"><img id="botmlogo" src="'.html_entity_encode_dec(CGI_LOGO_PATH).'" alt="'.html_entity_encode_dec(WEBSITE).'"></a>'."\n".
- '<div id="all">'."\n";
-use constant HTML_BODY_END =>
- '</div>'."\n".
- '<a href="/" class="cz">'.html_entity_encode_dec(WEBSITE).'</a>'."\n".
- '</body></html>'."\n";
-
# 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 ''){
+ (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"><head>'."\n";
- print '<meta http-equiv="Content-type" content="text/html; charset=UTF-8">'."\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>'.html_entity_encode_dec($title, 1).'</title>'."\n";
+ print ' <title>'.$_title.'</title>'."\n";
}
- print '</head><body>'."\n";
+ print ' </head>'."\n";
+ print ' <body>'."\n";
if ($title ne '') {
- print '<h1>'.html_entity_encode_dec($title, 1).'</h1>'."\n";
+ print ' <h1>'.$_title.'</h1>'."\n";
}
- if ($message ne '') {
- print '<p>'.html_entity_encode_dec($message, 1).'</p>'."\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></html>'."\n";
+ print ' </body>'."\n";
+ print '</html>'."\n";
}
sub fail_method {
(my $method, my $allowed) = @_;
- my $header = "Status: 405 Method Not Allowed\n";
- if ($allowed ne '') {
- $header .= "Allow: $allowed\n";
- }
+ my $status = http_status(HTTP_STATUS->{'method_not_allowed'});
+ my $header =
+ http_header_line('status', $status) .
+ http_header_allow($allowed);
+
return failpage(
$header,
- "405 Method Not Allowed",
+ $status,
"The interface does not support the $method method.",
$method
);
sub fail_content_type
{
- (my $content_type, my $method) = @_;
+ (my $method, my $content_type) = @_;
+
+ my $status = http_status(HTTP_STATUS->{'unsupported_media_type'});
+ my $header = http_header_line('status', $status);
return failpage(
- "Status: 415 Unsupported Media Type\n",
- "415 Unsupported Media Type",
+ $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);
-# TO REMOVE
-# function to encode entities, decimal,
-sub entityencode {
- (my $t, my $all) = @_;
- if ($all) {
- $t =~ s/(.)/sprintf('\&#%02hu;',ord($1))/eg;
- }
- else {
- $t =~ s/([\"=><\&])/sprintf('&#%02hu;',ord($1))/eg;
- }
- return $t;
+ return failpage(
+ $header,
+ $status,
+ "Attachment $ID not found.",
+ $method
+ );
}
-# TO REMOVE
-# function to get values of http header fields. Returns a hash. names of header
-# fields are lowercase
-sub gethttpheader {
- (my $env) = @_;
+sub fail_500
+{
+ (my $method, my $text) = @_;
- my %http;
+ my $status = http_status(HTTP_STATUS->{'internal_server_error'});
+ my $header = http_header_line('status', $status);
- foreach my $ind (keys %$env) {
- my $name = '';
- my $value= '';
-
- if ($ind =~ /^HTTP_([A-Z0-9_]+)$/) {
- $name=$1;
- }
- elsif ($ind =~ /^(CONTENT_[A-Z0-9_]+)$/) {
- $name=$1;
- }
- else{
- next;
- }
- $name =~ s/_/-/g;
- $name = lc($name);
- if ($$env{$ind} =~ /^([\x20-\x7e]*)$/) {
- $value=$1;
- }
- else {
- next;
- }
- $http{$name}=$value;
- }
- return %http;
+ return failpage(
+ $header,
+ $status,
+ $text,
+ $method
+ );
}
-# 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 {
- my $arg;
- my $val;
- my %cgi;
- my $i = $_[0];
- $i =~ s/[\r\n]//g;
- my @s = split('&',$i);
- foreach my $l ( @s) {
- ($arg,$val)=split('=',$l);
- $cgi{$arg}=urldecode($val);
+sub redirect
+{
+ (my $method, my $uri, my $code) = @_;
+ my $header;
+ my $status;
+ if ($code eq '') {
+ $code = HTTP_STATUS->{'found'};
}
- return %cgi;
+ # 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
+ );
}
-# TO REMOVE
-# Function for decoding URL-encoded text
-sub urldecode {
- my $t = $_[0];
- $t =~ s/\+/ /g;
- $t =~ s/%([a-fA-F0-9]{2})/chr(hex($1))/eg;
- return $t;
-}
-# 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) = @_;
- my $datafile;
- my %data;
- my $eoh=0;
-
- # check if $datapath is actually a path or maybe a filehandle
- # filehandles are references.
- if(ref($datapath)) {
- $datafile=$datapath;
- unless (seek($datafile, 0, 0)) {
- return %data;
- }
- }
- else {
- unless (open ($datafile, "<", $datapath)) {
- return %data;
- }
+# function to obtain address of remote agent
+sub get_remote_addr {
+ if ($ENV{'HTTP_X_FORWARDED_FOR'} =~ /^.+$/) {
+ return $&;
}
-
- # The name of header field in previous line. Required for header fields that
- # occupy multiple lines.
- my $lastname='';
-
- while (defined(my $line = <$datafile>)) {
- my $name='';
- my $value='';
-
- if ($eoh){
- unless($line eq'') {
- $data{'content'} = $data{'content'}.$line;
- }
- next;
- }
-
- $line =~ s/[\n]$//g;
-
- # Empty line - end of header.
- if ($line eq ''){
- $eoh=1;
- }
- # Line starts with whitespace. It's a continuation of the previous line.
- # Concatenate the field value, separated by newline.
- elsif($line =~ /^[ \t](.*)$/){
- if($lastname ne '') {
- $data{$lastname}.="\n".$1;
- }
- }
- # Line starts with a name followed by colon/equal sign. Save the value
- elsif ($line =~ /^([^:=]+)((:[ \t])|=)(.*)$/) {
- $name = lc($1);
- $value = $4;
-
- $data{$name}=$value;
-
- $lastname = $name;
- }
+ elsif ($ENV{'REMOTE_ADDR'} =~ /^.+$/) {
+ return $&;
}
-
- # If argument was a path the file must be closed.
- unless (ref($datapath)) {
- close ($datafile);
+ else {
+ return '0.0.0.0';
}
-
- return %data;
}
-# 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) = @_;
- my $headerfile;
-
- if(ref($headerpath)) {
- $headerfile=$headerpath;
- unless (seek($headerfile, 0, 0)) {
- return 0;
- }
+# functions to get ID/number etc.
+sub get_id {
+ (my $cgi, my $default, my $cgi_name) = @_;
+ if ($default eq '') {
+ $default = 0;
}
- else {
- unless (open ($headerfile, ">", $headerpath)) {
- return 0;
- }
+ if ($cgi_name eq '') {
+ $cgi_name = 'i';
}
- foreach my $ind (keys %header) {
- unless($ind eq 'content') {
- my $headname = $ind;
- my $headval = $header{$ind};
- $headval =~ s/\r//g;
- $headval =~ s/\n/\n /g;
- print $headerfile "$headname: $headval\n";
- }
+ if ($cgi->{$cgi_name} =~ /^.+$/) {
+ return int($&);
}
- print $headerfile "\n".$header{'content'};
-
- unless (ref($headerpath)) {
- close ($headerfile);
+ elsif ($ENV{'PATH_INFO'} =~ /^\/(.+)$/) {
+ return int($1);
}
else {
- truncate ($headerfile , tell($headerfile));
+ return int($default);
}
-
- return 1;
}
-# TO REMOVE
-# the function to print data to stdout (see readdatafile() description)
-#
-# On success returns 1.
-#
-sub printdatafile {
- (my %header) = @_;
+# 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) = @_;
- foreach my $ind (keys %header) {
- unless($ind eq 'content') {
- my $headname = $ind;
- my $headval = $header{$ind};
- $headval =~ s/\r//g;
- $headval =~ s/\n/\n /g;
- print "$headname: $headval\n";
- }
+ if ($cgi->{'p'} =~ /^.+$/) {
+ return $&;
+ }
+ else {
+ return '';
}
- print "\n".$header{'content'};
-
- return 1;
}
-# TO REMOVE ???
-# the function to print data to stdout as html (see readdatafile() description)
-#
-# On success returns 1.
-#
-sub printdatafileht {
- (my %header) = @_;
+
+sub merge_settings {
+ my %final_settings;
- foreach my $ind (keys %header) {
- unless($ind eq 'content') {
- my $headname = $ind;
- my $headval = $header{$ind};
- $headval =~ s/\r//g;
- $headval =~ s/\n/\n /g;
- print linehtml("$headname: $headval\n");
+ foreach my $settings (@_) {
+ foreach my $ind (keys %$settings) {
+ $final_settings{$ind} = $settings->{$ind};
}
}
- print linehtml("\n".$header{'content'});
-
- return 1;
+ return %final_settings;
}
-# TO REMOVE
-sub urlencode {
- (my $t, my $all) = @_;
- if ($all) {
- $t =~ s/(.)/sprintf('%%%02hX',ord($1))/eg;
- }
- else {
- $t =~ s/([^0-9A-Za-z.~\-_])/sprintf('%%%02hX',ord($1))/eg;
- }
- return $t;
-}
+# 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!
+#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 $tag_name;
+ my $tag_value;
+ my $tag_end;
my $level=0;
- my $pretext;
+ my $pre_text;
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");
+ $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 '') {
- 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));
+ 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 ($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 ($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($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;
+ 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, '['.$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;
+ $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, '['.$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;
+ $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 = $ind.'.'.($bbtree{$ind.'.e'}-1);
+ $ind = $new_ind;
+ # $new_ind = $ind.'.'.$bbtree{$ind.'.count'};
}
}
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;
+ $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, '['.$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, "[$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 = '';
}
}
- $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;
+ 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 $ht;
+ (my $printdebug, my $debug, my $lang, my $bbtree) = @_;
+ my $out;
my $ind;
my $indd;
- my $level=0;
- my $tagsr = ($lang eq 'html') ? tagsht : tagsbb;
- my %tags = %$tagsr;
+ 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, $iiii.'='.$tags->{$iiii}."\n");
# }
# $debug .= debug($printdebug, "****\n");
- $level=0;
- $ind='_';
- $ht='';
+ $level = 0;
+ $ind = '_';
+ $out = '';
$debug .= debug($printdebug, "\n<!--PROCESSING BBCODE TREE:\n");
- while ($level >=0) {
- $debug .= debug($printdebug, "[$level:$ind:".int($bbtree{$ind.'.e'})."]");
+ while ($level >= 0) {
+ my $goto_next = '';
+ $debug .= debug($printdebug, "[$level:$ind:".int($bbtree->{$ind.'.count'})."]");
#normal text
- if($bbtree{$ind.'.t'} eq 'tx') {
- $debug .= debug($printdebug, "text: ".$bbtree{$ind.'.v'});
- $ht = $ht.($escape?(linehtml($bbtree{$ind.'.v'})):($bbtree{$ind.'.v'}));
+ if ($bbtree->{$ind.'.type'} eq 'text') {
+ my $text = $bbtree->{$ind.'.value'};
+ $debug .= debug($printdebug, "text: ".$text);
+ $out .= $escape ? html_encode_line($text) : $text;
- {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);}
+ $goto_next = 'tx';
}
#tag
- elsif($bbtree{$ind.'.t'} eq 'tg') {
+ elsif ($bbtree->{$ind.'.type'} eq 'tag') {
+ my $name = $bbtree->{$ind.'.name'};
#endtag
- if($bbtree{$ind.'.n'} =~ /^\//) {
- $debug .= debug($printdebug, "tag: [".$bbtree{$ind.'.n'}."]");
+ if ($name =~ /^\//) {
+ $debug .= debug($printdebug, "tag: [$name]");
$indd = $ind;
$indd =~ s/\.([0-9]+)$//;
- if (exists($tags{$bbtree{$ind.'.n'}.'='}) && ($bbtree{$indd.'.v'} ne '')) {
- $ht = $ht.$tags{$bbtree{$ind.'.n'}.'='};
+ if (exists($tags->{$name.'='}) && ($bbtree->{$indd.'.value'} ne '')) {
+ $out .= $tags->{$name.'='};
}
- elsif (exists($tags{$bbtree{$ind.'.n'}})) {
- $ht = $ht.$tags{$bbtree{$ind.'.n'}};
+ elsif (exists($tags->{$name})) {
+ $out .= $tags->{$name};
}
else {
- $ht = $ht.$tags{'/?'};
+ $out .= $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);}
+ if ($level > 0) {
+ $goto_next = 'nd';
}
else {
# time to end this
}
#starttag
else {
- if($bbtree{$ind.'.c'} ne '') {
- $debug .= debug($printdebug, "tag: [".$bbtree{$ind.'.n'}."]");
+ my $value = $bbtree->{$ind.'.value'};
+ if($bbtree->{$ind.'.closed'} ne '') {
+ $debug .= debug($printdebug, "tag: [$name]");
- 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'}.'/='};
+ if (exists($tags->{$name.'='}) && ($value ne '')) {
+ if (exists($tags->{$name.'='.$value})) {
+ $out .=
+ $tags->{$name.'='} .
+ $tags->{$name.'='.$value} .
+ $tags->{$name.'/='};
}
else {
- $ht = $ht.$tags{$bbtree{$ind.'.n'}.'='}.($escape?entityencode($bbtree{$ind.'.v'}):$bbtree{$ind.'.v'}).$tags{$bbtree{$ind.'.n'}.'/='};
+ $out .=
+ $tags->{$name.'='} .
+ ($escape ? html_entity_encode_dec($value, 1) : $value) .
+ $tags->{$name.'/='};
}
}
- elsif (exists($tags{$bbtree{$ind.'.n'}})) {
- $ht = $ht.$tags{$bbtree{$ind.'.n'}};
+ elsif (exists($tags->{$name})) {
+ $out .= $tags->{$name};
}
else {
- $ht = $ht.$tags{'?'};
+ $out .= $out.$tags->{'?'};
$debug .= debug($printdebug, "[unknown!]");
}
}
else {
- $debug .= debug($printdebug, "unclosed tag: [".$bbtree{$ind.'.n'}."]");
- $ht = $ht.'['.($escape?linehtml($bbtree{$ind.'.n'}):$bbtree{$ind.'.n'}).']';
+ $debug .= debug($printdebug, "unclosed tag: [$name]");
+ my $text = $name . (($value ne '') ? ('='.$value) : '');
+ $out .= '['.($escape ? html_encode_line($text) : $text).']';
}
- if($bbtree{$ind.'.e'}>0) {
+ if ($bbtree->{$ind.'.count'} > 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);}
+ $goto_next = 'st';
}
}
}
- #what is this
+ # what is this
else {
- $debug .= debug($printdebug, "unknown thing: ".$bbtree{$ind.'.t'});
+ $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) {
- {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);}
+ 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, $ht);
+ return ($debug, $out);
}
#bbcode to html, TBD
-sub bb2ht {
+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);
+ ($debug, %bbtree) = bbtree($bb, $printdebug);
+ ($debug, $ht) = convtree ($printdebug, $debug, 'html', \%bbtree);
return $ht;
-
- # $level=0;
- # $ind='_';
- # $ht='';
- # $debug .= debug($printdebug, "\n<!--PROCESSING BBCODE TREE:\n");
-
- # while ($level >=0) {
- # $debug .= debug($printdebug, "[$level:$ind:".int($bbtree{$ind.'.e'})."]");
- # if($bbtree{$ind.'.t'} eq 'tx') {
- # $debug .= debug($printdebug, "text: ".$bbtree{$ind.'.v'});
- # $ht = $ht.linehtml($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);}
- # }
- # elsif($bbtree{$ind.'.t'} eq 'tg') {
- # if($bbtree{$ind.'.n'} =~ /^\//) {
- # $debug .= debug($printdebug, "tag: [".$bbtree{$ind.'.n'}."]");
- # if($bbtree{$ind.'.n'} eq '/ht') {
- # #
- # }
- # elsif ($bbtree{$ind.'.n'} =~ /^\/(fq|tq)$/) {
- # $ht = $ht.'</div>';
- # }
- # elsif ($bbtree{$ind.'.n'} =~ /^\/(br|ni|po)$/) {
- # $ht = $ht.'</span>';
- # }
- # elsif ($bbtree{$ind.'.n'} eq '/url') {
- # $ht = $ht.'</a>';
- # }
- # elsif ($bbtree{$ind.'.n'} eq '/i') {
- # $ht = $ht.'</i>';
- # }
- # else { #unimpl.
- # $ht = $ht.'['.linehtml($bbtree{$ind.'.n'}).']';
- # $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;
- # }
- # }
- # else {
- # if($bbtree{$ind.'.c'} ne '') {
- # if($bbtree{$ind.'.n'} eq 'ht') {
- # #
- # }
- # elsif($bbtree{$ind.'.n'} eq 'fq') {
- # $ht = $ht.'<div class="fq">';
- # }
- # elsif($bbtree{$ind.'.n'} eq 'tq') {
- # $ht = $ht.'<div class="tq">';
- # }
- # elsif($bbtree{$ind.'.n'} eq 'br') {
- # $ht = $ht.'<span class="br">';
- # }
- # elsif($bbtree{$ind.'.n'} eq 'ni') {
- # $ht = $ht.'<span class="ni">';
- # }
- # elsif($bbtree{$ind.'.n'} eq 'po') {
- # $ht = $ht.'<span class="po">';
- # }
- # elsif($bbtree{$ind.'.n'} eq 'i') {
- # $ht = $ht.'<i>';
- # }
- # elsif($bbtree{$ind.'.n'} eq 'url') {
- # $ht = $ht.'<a href="'.entityencode($bbtree{$ind.'.v'}).'">';
- # }
- # else { #unimpl.
- # $ht = $ht.'['.linehtml($bbtree{$ind.'.n'}).(($bbtree{$ind.'.v'} ne '' )?entityencode($bbtree{$ind.'.v'}):'').']';
- # $debug .= debug($printdebug, "[unknown!]");
- # }
- # }
- # else {
- # $debug .= debug($printdebug, "unclosed tag: [".$bbtree{$ind.'.n'}."]");
- # $ht = $ht.'['.linehtml($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);}
- # }
- # }
- # }
- # 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");
- # # print $debug;
-
-
-
}
#bbcode to bb, TBD
-sub bb2bb {
+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);
+ ($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;
- # $level=0;
- # $ind='_';
- # $ht='';
- # $debug .= debug($printdebug, "\n<!--PROCESSING BBCODE TREE:\n");
-
- # while ($level >=0) {
- # $debug .= debug($printdebug, "[$level:$ind:".int($bbtree{$ind.'.e'})."]");
- # if($bbtree{$ind.'.t'} eq 'tx') {
- # $debug .= debug($printdebug, "text: ".$bbtree{$ind.'.v'});
- # $ht = $ht.$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);}
- # }
- # elsif($bbtree{$ind.'.t'} eq 'tg') {
- # if($bbtree{$ind.'.n'} =~ /^\//) {
- # $debug .= debug($printdebug, "tag: [".$bbtree{$ind.'.n'}."]");
- # if($bbtree{$ind.'.n'} eq '/ht') {
- # #
- # }
- # elsif ($bbtree{$ind.'.n'} =~ /^\/(fq|tq)$/) {
- # $ht = $ht.'[/quote]';
- # }
- # elsif ($bbtree{$ind.'.n'} =~ /^\/(br|ni|po)$/) {
- # $ht = $ht.'[/color]';
- # }
- # elsif ($bbtree{$ind.'.n'} eq '/url') {
- # $ht = $ht.'[/url]';
- # }
- # elsif ($bbtree{$ind.'.n'} eq '/i') {
- # $ht = $ht.'[/i]';
- # }
- # else { #unimpl.
- # $ht = $ht.'['.$bbtree{$ind.'.n'}.']';
- # $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;
- # }
- # }
- # else {
- # if($bbtree{$ind.'.c'} ne '') {
- # $debug .= debug($printdebug, "tag: [".$bbtree{$ind.'.n'}."]");
- # if($bbtree{$ind.'.n'} eq 'ht') {
- # #
- # }
- # elsif($bbtree{$ind.'.n'} =~ /^(fq|tq)$/) {
- # $ht = $ht.'[quote]';
- # }
- # elsif($bbtree{$ind.'.n'} eq 'br') {
- # $ht = $ht.'[color=#BB6622]';
- # }
- # elsif($bbtree{$ind.'.n'} eq 'po') {
- # $ht = $ht.'[color=#FF8800]';
- # }
- # elsif($bbtree{$ind.'.n'} eq 'ni') {
- # $ht = $ht.'[color=#0057AF]';
- # }
- # elsif($bbtree{$ind.'.n'} eq 'url') {
- # $ht = $ht.'[url='.$bbtree{$ind.'.v'}.']';
- # }
- # elsif($bbtree{$ind.'.n'} eq 'i') {
- # $ht = $ht.'[i]';
- # }
- # else { #unimpl.
- # $ht = $ht.'['.$bbtree{$ind.'.n'}.(($bbtree{$ind.'.v'} ne '' )?($bbtree{$ind.'.v'}):'').']';
- # $debug .= debug($printdebug, "[unknown!]");
- # }
- # }
- # else {
- # $debug .= debug($printdebug, "unclosed tag: [".$bbtree{$ind.'.n'}."]");
- # $ht = $ht.'['.$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);}
- # }
- # }
- # }
- # 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");
- # # print $debug;
-
-
+ 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 linehtml {
- (my $ht) = @_;
- my $esc;
+
+sub html_encode_line {
+ (my $text, my $non_ascii, my $all) = @_;
+ my $html;
my $ind;
- $ht =~ s/\r\n/\n/g;
- $ht =~ s/\r/\n/g;
+ $text =~ s/\r\n/\n/gs;
+ $text =~ s/\r/\n/gs;
- while ($ht ne '') {
- $ind = index($ht,"\n");
- if($ind>=0){
- $esc = $esc.entityencode(substr($ht,0,$ind))."<br>\n";
- $ht=substr($ht,$ind+1);
+ 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
{
- $esc = $esc.entityencode($ht);
- $ht = '';
+ $html .= html_entity_encode_dec($text, 1);
+ $text = '';
}
}
- return $esc;
+ return $html;
}
-# TO REMOVE ???
sub debug {
(my $print, my $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 • '.$_title.' • '.$_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,
+ 'b' => $text_mode
+ },
+ '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 ' • '.$_story;
+ }
+ print $fh ' • '.$_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 ' >';
+ 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,
+ }
+ }
+ );
+ my $edit_url = merge_url(
+ {'path' => CGI_WORDS_PATH()},
+ {
+ 'query' => {
+ 'f' => $frame,
+ 'edit' => $ID,
+ 'key' => $post_data{'key'},
+ 'username' => $post_data{'name'},
+ }
+ }
+ );
+ my $remove_url = merge_url(
+ {'path' => CGI_WORDS_PATH()},
+ {
+ 'query' => {
+ 'f' => $frame,
+ 'remove' => $ID,
+ 'key' => $post_data{'key'},
+ 'username' => $post_data{'name'},
+ }
+ }
+ );
+ if ($password_ok) {
+ $quote_url = merge_url($quote_url , {'query' => $password_query, 'append_query' => 1, 'preserve_fragment' => 1});
+ $edit_url = merge_url($edit_url , {'query' => $password_query, 'append_query' => 1, 'preserve_fragment' => 1});
+ $remove_url = merge_url($remove_url, {'query' => $password_query, 'append_query' => 1, 'preserve_fragment' => 1});
+ }
+
+ 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 ' • '.$post_time_text;
+ }
+ if ($edit_time_text ne '') {
+ print $fh ' • '.$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> </td>'."\n";
+ print $fh ' <td align="right"> - </td>'."\n";
+ print $fh ' <td> </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> </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.' • '.$_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 '><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
bicyclesonthemoon.info / projects / ott / bsta / blobdiff