bicyclesonthemoon.info Git - ott/bsta/blob - bsta_lib.1.pm

   1 # bsta_lib.pm is generated from bsta_lib.1.pm
   2 #
   3 # Library of functions
   4 #
   5 # Copyright (C) 2016, 2017, 2019, 2020, 2022, 2023, 2024  Balthasar Szczepański
   6 #
   7 # This program is free software: you can redistribute it and/or modify
   8 # it under the terms of the GNU Affero General Public License as
   9 # published by the Free Software Foundation, either version 3 of the
  10 # License, or (at your option) any later version.
  11 #
  12 # This program is distributed in the hope that it will be useful,
  13 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 # GNU Affero General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU Affero General Public License
  18 # along with this program.  If not, see <http://www.gnu.org/licenses/>.
  19
  20 # TODO: FQ NBSP ?
  21 # TODO: DEBUG
  22 # TODO: BB & INFO indent
  23
  24 package bsta_lib;
  25
  26 use strict;
  27 #use warnings
  28
  29 use utf8;
  30 use Encode ('encode', 'decode');
  31 use Exporter;
  32 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
  33
  34 ###PERL_EXPORT_VERSION: our $VERSION = 'x.x.x';
  35 our @ISA         = qw(Exporter);
  36 our @EXPORT      = ();
  37 our @EXPORT_OK   = (
  38         'STATE', 'TEXT_MODE', 'INTF_STATE', 'CHAT_STATE', 'CHAT_ACTION',
  39         'failpage',
  40         'fail_method', 'fail_content_type', 'fail_open_file', 'fail_attachment', 'fail_500',
  41         'redirect',
  42         'get_remote_addr', 'get_id', 'get_frame', 'get_password',
  43         'merge_settings',
  44         'print_html_start', 'print_html_end',
  45         'print_html_head_start', 'print_html_head_end',
  46         'print_html_body_start', 'print_html_body_end',
  47         'print_viewer_page', 'print_goto',
  48         'write_index', 'write_static_viewer_page', 'write_static_goto',
  49         'get_frame_file', 'get_page_file',
  50         'read_frame_data', 'write_frame_data', 'read_default', 'read_noaccess',
  51         'read_state', 'write_state',
  52         'read_words_list', 'write_words_list', 'read_words', 'write_words',
  53         'read_story', 'write_story',
  54         'read_goto', 'write_goto',
  55         'read_chat', 'write_chat',
  56         'read_settings', 'read_attachment', 'read_coincidence',
  57         'ong',
  58         'eval_bb', 'bb_to_bbcode', 'bb_to_html'
  59 );
  60
  61 ###PERL_LIB: use lib /botm/lib/bsta
  62 use botm_common (
  63         'HTTP_STATUS',
  64         'url_query_decode', 'url_query_encode',
  65         'url_decode', 'url_encode',
  66         'html_entity_encode_dec',
  67         'merge_url',
  68         'read_header_env',
  69         'read_data_file', 'write_data_file',
  70         'join_path',
  71         'copy_encoded', 'open_encoded', '_x_encoded',
  72         'http_header_line', 'http_status',
  73         'http_header_status', 'http_header_allow', 'http_header_location'
  74 );
  75
  76 ###PERL_PATH_SEPARATOR:     PATH_SEPARATOR     = /
  77
  78 ###PERL_CGI_PATH:           CGI_PATH           = /bsta/
  79 ###PERL_CGI_ATTACH_PATH:    CGI_ATTACH_PATH    = /bsta/a
  80 ###PERL_CGI_2WORDS_PATH:    CGI_2WORDS_PATH    = /bsta/2words
  81 ###PERL_CGI_BBCODE_PATH:    CGI_BBCODE_PATH    = /bsta/b
  82 ###PERL_DATA_CHAT_PATH:     DATA_CHAT_PATH     = /botm/data/bsta/chat
  83 ###PERL_CGI_COIN_PATH:      CGI_COIN_PATH      = /bsta/coin
  84 ###PERL_CGI_CSS_PATH:       CGI_CSS_PATH       = /bsta/bsta.css
  85 ###PERL_CGI_FRAME_PATH:     CGI_FRAME_PATH     = /bsta/f
  86 ###PERL_CGI_GOTO_PATH:      CGI_GOTO_PATH      = /bsta/g
  87 ###PERL_CGI_INFO_PATH:      CGI_INFO_PATH      = /bsta/i
  88 ###PERL_CGI_LIST_PATH:      CGI_LIST_PATH      = /bsta/goto.htm
  89 ###PERL_CGI_LOGO_PATH:      CGI_LOGO_PATH      = /bsta/botmlogo.png
  90 ###PERL_CGI_TIMER_PATH:     CGI_TIMER_PATH     = /bsta/timer.js
  91 ###PERL_CGI_VIEWER_PATH:    CGI_VIEWER_PATH    = /bsta/v
  92 ###PERL_CGI_WORDS_PATH:     CGI_WORDS_PATH     = /bsta/w
  93
  94 ###PERL_DATA_PATH:          DATA_PATH          = /botm/data/bsta/
  95 ###PERL_DATA_ATTACH_PATH:   DATA_ATTACH_PATH   = /botm/data/bsta/a
  96 ###PERL_DATA_COIN_PATH:     DATA_COIN_PATH     = /botm/data/bsta/coincidence
  97 ###PERL_DATA_DEFAULT_PATH:  DATA_DEFAULT_PATH  = /botm/data/bsta/default
  98 ###PERL_DATA_LIST_PATH:     DATA_LIST_PATH     = /botm/data/bsta/list
  99 ###PERL_DATA_NOACCESS_PATH: DATA_NOACCESS_PATH = /botm/data/bsta/noaccess
 100 ###PERL_DATA_SETTINGS_PATH: DATA_SETTINGS_PATH = /botm/data/bsta/settings
 101 ###PERL_DATA_STATE_PATH:    DATA_STATE_PATH    = /botm/data/bsta/state
 102 ###PERL_DATA_STORY_PATH:    DATA_STORY_PATH    = /botm/data/bsta/story
 103 ###PERL_DATA_WORDS_PATH:    DATA_WORDS_PATH    = /botm/data/bsta/words/
 104
 105 ###PERL_WWW_PATH:           WWW_PATH           = /botm/www/
 106 ###PERL_WWW_GOTO_PATH:      WWW_GOTO_PATH      = /botm/www/1190/bsta/goto.htm
 107 ###PERL_WWW_INDEX_PATH:     WWW_INDEX_PATH     = /botm/www/1190/bsta/index.htm
 108
 109 ###PERL_SCHEME:             SCHEME             = http
 110 ###PERL_WEBSITE:            WEBSITE            = 1190.bicyclesonthemoon.info
 111 ###PERL_WEBSITE_NAME:       WEBSITE_NAME       = Bicycles on the Moon
 112 ###PERL_FAVICON_PATH:       FAVICON_PATH       = /img/favicon.png
 113
 114 ###PERL_COIN_DATE:          COIN_DATE          = 13-Nov-2016 22:15
 115 ###PERL_INTF_DATE:          INTF_DATE          = 28-Sep-2016 20:34
 116
 117 ###PERL_STORY_CREDITS:      STORY_CREDITS      = "BSTA" by Balthasar Szczepański
 118 ###PERL_INTF_CREDITS:       INTF_CREDITS       = Online interface © Balthasar Szczepański; AGPL 3 license
 119 ###PERL_SOURCE_URL:         SOURCE_URL         = http://bicyclesonthemoon.info/git-projects/?p=ott/bsta
 120
 121 ###PERL_COMMENT_PAGE_LENGTH:COMMENT_PAGE_LENGTH= 16
 122
 123 use constant STATE => {
 124         'inactive' => 0,
 125         'waiting'  => 1,
 126         'ready'    => 2,
 127         'end'      => 3,
 128 };
 129 use constant INTF_STATE => {
 130         'X'  => 0b000000,
 131         'x'  => 0b000000,
 132         '||' => 0b000001,
 133         '>>' => 0b000100,
 134         '>>|'=> 0b000101,
 135         '<<' => 0b001000,
 136         '|<<'=> 0b001001,
 137         '>'  => 0b010000,
 138         '>|' => 0b010001,
 139         'mask'=>0b111111,
 140         'mode'=>0b111110,
 141 };
 142 use constant TEXT_MODE => {
 143         'normal' => 0,
 144         'bb'     => 1,
 145         'info'   => 2,
 146         'words'  => 3
 147 };
 148 use constant CHAT_STATE => {
 149         'disconnected' => 0,
 150         'ready'        => 1,
 151         'active'       => 2,
 152 };
 153 use constant CHAT_ACTION => {
 154         'none'   => 0,
 155         'join'   => 1,
 156         'leave'  => 2,
 157         'nopost' => 3,
 158         'file'   => 4,
 159 };
 160
 161 use constant tags_bbcode => {
 162         'ht'     => '',
 163         '/ht'    => '',
 164         'fq'     => '[quote]',
 165         '/fq'    => '[/quote]',
 166         'tq'     => '[quote]',
 167         '/tq'    => '[/quote]',
 168         'quote'  => '[quote]',
 169         'quote=' => '[quote="',
 170         'quote/='=> '"]',
 171         '/quote' => '[/quote]',
 172         'ni'     => '[color=#0057AF]',
 173         '/ni'    => '[/color]',
 174         'br'     => '[color=#BB6622]',
 175         '/br'    => '[/color]',
 176         'po'     => '[color=#FF8800]',
 177         '/po'    => '[/color]',
 178         'url'    => '[url]',
 179         'url='   => '[url=',
 180         'url/='  => ']',
 181         '/url'   => '[/url]',
 182         'i'      => '[i]',
 183         '/i'     => '[/i]',
 184         'list'   => '[list]',
 185         'list='  => '[list=',
 186         'list/=' => ']',
 187         '/list'  => '[/list]',
 188         '*'      => '[*]',
 189         '/*'     => '[/*]',
 190         '?'      => '[unknown!]',
 191         '/?'     => '[/unknown!]',
 192 };
 193 use constant tags_html => {
 194         'ht'     => '',
 195         '/ht'    => '',
 196         'fq'     => '<div class="fq">',
 197         '/fq'    => '</div>',
 198         'tq'     => '<div class="tq">',
 199         '/tq'    => '</div>',
 200         'quote'  => '<div class="opomba"><div class="opomba_text">',
 201         'quote=' => '<div class="opomba"><div class="opomba_info"><b>',
 202         'quote/='=> '</b> wrote:</div><div class="opomba_text">',
 203         '/quote' => '</div></div>',
 204         'ni'     => '<span class="ni">',
 205         '/ni'    => '</span>',
 206         'br'     => '<span class="br">',
 207         '/br'    => '</span>',
 208         'po'     => '<span class="po">',
 209         '/po'    => '</span>',
 210         'url'    => '<a href="#">',#think: how to add selfincluding?
 211         'url='   => '<a href="',
 212         'url/='  => '">',
 213         '/url'   => '</a>',
 214         'i'      => '<i>',
 215         '/i'     => '</i>',
 216         'list'   => '<ul>',
 217         'list='  => '<ol style="list-style-type: ',
 218         'list=1' => 'decimal',
 219         'list=A' => 'upper-alpha',
 220         'list=a' => 'lower-alpha',
 221         'list=I' => 'upper-roman',
 222         'list=i' => 'lower-roman',
 223         'list/=' => '">',
 224         '/list'  => '</ul>',
 225         '/list=' => '</ol>',
 226         '*'      => '<li>',
 227         '/*'     => '</li>',
 228         '?'      => '[unknown!]',
 229         '/?'     => '[/unknown!]',
 230 };
 231
 232
 233 # Function to return an error page
 234 # arguments: 1 - header fields, 2 - page title, 3 - error message, 4 method
 235 sub failpage {
 236         (my $header, my $title, my $message, my $method, my $hyperlink) = @_;
 237
 238         if (ref($header)) {
 239                 foreach my $header_name (keys %$header) {
 240                         print http_header_line($header_name, $header->{$header_name});
 241                 }
 242         }
 243         elsif($header ne '') {
 244                 print $header;
 245         }
 246         if($method eq 'HEAD') {
 247                 print "\n";
 248                 return;
 249         }
 250         my $_title     = html_entity_encode_dec($title    , 1);
 251         my $_message   = html_entity_encode_dec($message  , 1);
 252         my $_hyperlink = html_entity_encode_dec($hyperlink, 1);
 253
 254         print "Content-type: text/html; charset=UTF-8\n\n";
 255
 256         print '<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "">'."\n";
 257         print ' <html lang="en">'."\n";
 258         print '  <head>'."\n";
 259         print '   <meta http-equiv="Content-type" content="text/html; charset=UTF-8">'."\n";
 260         if ($title ne '') {
 261                 print '   <title>'.$_title.'</title>'."\n";
 262         }
 263         print '  </head>'."\n";
 264         print ' <body>'."\n";
 265         if ($title ne '') {
 266                 print '  <h1>'.$_title.'</h1>'."\n";
 267         }
 268         if (($message ne '') || ($hyperlink ne '')) {
 269                 print "  <p>\n";
 270                 if ($message ne '') {
 271                         print '   '.$_message.($hyperlink ne '' ? '<br>' : '')."\n";
 272                 }
 273                 if ($hyperlink ne '') {
 274                         print '   <a href="'.$_hyperlink.'">'.$_hyperlink."</a>\n";
 275                 }
 276                 print "  </p>\n";
 277         }
 278         print ' </body>'."\n";
 279         print '</html>'."\n";
 280 }
 281
 282 sub fail_method {
 283         (my $method, my $allowed) = @_;
 284
 285         my $status = http_status(HTTP_STATUS->{'method_not_allowed'});
 286         my $header =
 287                 http_header_line('status', $status) .
 288                 http_header_allow($allowed);
 289
 290         return failpage(
 291                 $header,
 292                 $status,
 293                 "The interface does not support the $method method.",
 294                 $method
 295         );
 296 }
 297
 298 sub fail_content_type
 299 {
 300         (my $method, my $content_type) = @_;
 301
 302         my $status = http_status(HTTP_STATUS->{'unsupported_media_type'});
 303         my $header = http_header_line('status', $status);
 304
 305         return failpage(
 306                 $header,
 307                 $status,
 308                 "Unsupported Content-type: $content_type.",
 309                 $method
 310         );
 311 }
 312
 313 sub fail_open_file
 314 {
 315         (my $method, my $type, my $path) = @_;
 316
 317         my $status = http_status(HTTP_STATUS->{'not_found'});
 318         my $header = http_header_line('status', $status);
 319
 320         return failpage(
 321                 $header,
 322                 $status,
 323                         "Can't open ".
 324                         ($type ne '' ? $type : 'file').
 325                         ($path ne '' ? ': "'.$path.'"' : '').
 326                         '.',
 327                 $method
 328         );
 329 }
 330
 331 sub fail_attachment
 332 {
 333         (my $method, my $ID) = @_;
 334
 335         my $status = http_status(HTTP_STATUS->{'not_found'});
 336         my $header = http_header_line('status', $status);
 337
 338         return failpage(
 339                 $header,
 340                 $status,
 341                 "Attachment $ID not found.",
 342                 $method
 343         );
 344 }
 345
 346 sub fail_500
 347 {
 348         (my $method, my $text) = @_;
 349
 350         my $status = http_status(HTTP_STATUS->{'internal_server_error'});
 351         my $header = http_header_line('status', $status);
 352
 353         return failpage(
 354                 $header,
 355                 $status,
 356                 $text,
 357                 $method
 358         );
 359 }
 360
 361 sub redirect
 362 {
 363         (my $method, my $uri, my $code) = @_;
 364         my $header;
 365         my $status;
 366         if ($code eq '') {
 367                 $code = HTTP_STATUS->{'found'};
 368         }
 369         # https://insanecoding.blogspot.com/2014/02/http-308-incompetence-expected.html
 370         # 301 Moved Permanently
 371         # 302 Found
 372         # 303 See Other
 373         # 307 Temporary Redirect
 374         # 308 Permanent Redirect
 375         $status = http_status($code);
 376         $header = http_header_line('status', $status);
 377         $header .= http_header_location($uri);
 378
 379         return failpage(
 380                 $header,
 381                 $status,
 382                 '',
 383                 $method,
 384                 $uri
 385         );
 386 }
 387
 388
 389 # function to obtain address of remote agent
 390 sub get_remote_addr {
 391         if ($ENV{'HTTP_X_FORWARDED_FOR'} =~ /^.+$/) {
 392                 return $&;
 393         }
 394         elsif ($ENV{'REMOTE_ADDR'} =~ /^.+$/) {
 395                 return $&;
 396         }
 397         else {
 398                 return '0.0.0.0';
 399         }
 400 }
 401
 402 # functions to get ID/number etc.
 403 sub get_id {
 404         (my $cgi, my $default, my $cgi_name) = @_;
 405                 if ($default eq '') {
 406                 $default = 0;
 407         }
 408         if ($cgi_name eq '') {
 409                 $cgi_name = 'i';
 410         }
 411
 412         if ($cgi->{$cgi_name} =~ /^.+$/) {
 413                 return int($&);
 414         }
 415         elsif ($ENV{'PATH_INFO'} =~ /^\/(.+)$/) {
 416                 return int($1);
 417         }
 418         else {
 419                 return int($default);
 420         }
 421 }
 422
 423 # function to obtain frame number
 424 sub get_frame {
 425         (my $cgi, my $default) = @_;
 426         return get_id($cgi, $default, 'f');
 427 }
 428
 429 # function to obtain password
 430 sub get_password {
 431         (my $cgi) = @_;
 432
 433         if ($cgi->{'p'} =~ /^.+$/) {
 434                 return $&;
 435         }
 436         else {
 437                 return '';
 438         }
 439 }
 440
 441
 442 sub merge_settings {
 443                 my %final_settings;
 444
 445         foreach my $settings (@_) {
 446                 foreach my $ind (keys %$settings) {
 447                         $final_settings{$ind} = $settings->{$ind};
 448                 }
 449         }
 450         return %final_settings;
 451 }
 452
 453
 454 # BB code stuff
 455 # different & simpler implementation than in post library
 456 # to consider:
 457 # a BBcode library?
 458
 459 #analyse bbcode text to build tag tree
 460 #TODO make [/*] optional!
 461 sub bbtree {
 462         (my $bb, my $printdebug) = @_;
 463         my %bbtree;
 464         my $ind;
 465         my $tag;
 466         my $tag_name;
 467         my $tag_value;
 468         my $tag_end;
 469         my $level=0;
 470         my $pre_text;
 471         my $debug;
 472
 473         $ind="_";
 474         $level=0;
 475         $bbtree{"_.name" }  = "ht";
 476         $bbtree{"_.value" } = '';
 477         $bbtree{"_.type"  } = "tag";
 478         $bbtree{"_.count" } = 0;
 479         $bbtree{"_.closed"} = 0;
 480         $debug .= debug($printdebug,
 481                 "\n".
 482                 "<!--GENERATING BBCODE TREE:\n".
 483                 '[_]automatic tag: [ht]'."\n"
 484         );
 485
 486         while ($bb ne '') {
 487                 my $new_ind = $ind.'.'.$bbtree{$ind.'.count'};
 488
 489                 if($bb =~ m/\[(\/?)([A-Za-z]+|\*)(=([^\[\]]*))?\]/g) {
 490                         $pre_text = $`;
 491                         $tag = $&;
 492                         $tag_end = $1;
 493                         $tag_name = lc($2);
 494                         $tag_value = $4;
 495                         $bb = $';
 496                         if ($tag_value =~ /^"(.*)"$/) {
 497                                 $tag_value = $1;
 498                         }
 499
 500                         if ($pre_text ne '') {
 501                                 $debug .= debug($printdebug, "[$new_ind]text: $pre_text\n");
 502                                 $bbtree{$new_ind.'.type' } = 'text';
 503                                 $bbtree{$new_ind.'.value'} = $pre_text;
 504                                 $bbtree{    $ind.'.count'}+= 1;
 505                                 $new_ind = $ind.'.'.$bbtree{$ind.'.count'};
 506                         }
 507
 508                         if($tag_name =~ /^(fq|tq|quote|br|ni|po|url|i|list|\*)$/) {
 509                                 if ($tag_end ne '') {
 510                                         if (
 511                                                 ($tag_name ne $bbtree{$ind.'.name'}) ||
 512                                                 ($level <= 0)
 513                                         ) {
 514                                                 $debug .= debug($printdebug, "[$new_ind]text: $tag\n");
 515                                                 $bbtree{$new_ind.'.type' } = 'text';
 516                                                 $bbtree{$new_ind.'.value'} = $tag;
 517                                                 $bbtree{    $ind.'.count'}+= 1;
 518                                                 # $new_ind = $ind.'.'.$bbtree{$ind.'.count'};
 519                                         }
 520                                         else {
 521                                                 $debug .= debug($printdebug, "[$new_ind]tag: $tag\n");
 522                                                 $bbtree{$new_ind.'.type'  } = 'tag';
 523                                                 $bbtree{$new_ind.'.name'  } = '/'.$tag_name;
 524                                                 $bbtree{$new_ind.'.value' } = $tag_value;
 525                                                 $bbtree{    $ind.'.count' }+= 1;
 526                                                 $bbtree{    $ind.'.closed'} = 1;
 527                                                 $level -= 1;
 528                                                 $ind =~ s/\.[0-9]+$//;
 529                                                 # $new_ind = $ind.'.'.$bbtree{$ind.'.count'};
 530                                         }
 531                                 }
 532                                 else
 533                                 {
 534                                         $debug .= debug($printdebug, "[$new_ind]tag: $tag\n");
 535                                         $bbtree{$new_ind.'.type'  } = 'tag';
 536                                         $bbtree{$new_ind.'.name'  } = $tag_name;
 537                                         $bbtree{$new_ind.'.value' } = $tag_value;
 538                                         $bbtree{$new_ind.'.count' } = 0;
 539                                         $bbtree{$new_ind.'.closed'} = 0;
 540                                         $bbtree{    $ind.'.count' }+= 1;
 541                                         $level += 1;
 542                                         $ind = $new_ind;
 543                                         # $new_ind = $ind.'.'.$bbtree{$ind.'.count'};
 544                                 }
 545                         }
 546                         else {
 547                                 $debug .= debug($printdebug, "[$new_ind]text: $tag\n");
 548                                 $bbtree{$new_ind.'.type' } = 'text';
 549                                 $bbtree{$new_ind.'.value'} = $tag;
 550                                 $bbtree{    $ind.'.count'}+= 1;
 551                                 # $new_ind = $ind.'.'.$bbtree{$ind.'.count'};
 552                         }
 553                 }
 554                 else {
 555                         $debug .= debug($printdebug, "[$new_ind]text: $bb\n");
 556                         $bbtree{$new_ind.'.type' } = 'text';
 557                         $bbtree{$new_ind.'.value'} = $bb;
 558                         $bbtree{    $ind.'.count'}+= 1;
 559                         # $new_ind = $ind.'.'.$bbtree{$ind.'.count'};
 560                         $bb = '';
 561                 }
 562         }
 563         my $final_ind = '_.'.$bbtree{"_.count"};
 564         $debug .= debug($printdebug, "[$final_ind]automatic tag: [/ht]\n -->\n");
 565         $bbtree{$final_ind.'.type' } = "tag";
 566         $bbtree{$final_ind.'.name' } = '/ht';
 567         $bbtree{         '_.count' }+= 1;
 568         $bbtree{         '_.closed'} = 1;
 569
 570         return ($debug, %bbtree);
 571 }
 572
 573 #convert tag tree to final text
 574 sub convtree {
 575         (my $printdebug, my $debug, my $lang, my $bbtree) = @_;
 576         my $out;
 577         my $ind;
 578         my $indd;
 579         my $level = 0;
 580         my $tags = ($lang eq 'html') ? tags_html : tags_bbcode;
 581         my $escape = ($lang eq 'html');
 582
 583         # $debug .= debug($printdebug, "\n****\n");
 584         # foreach my $iiii (keys %tags) {
 585                 # $debug .= debug($printdebug, $iiii.'='.$tags->{$iiii}."\n");
 586         # }
 587         # $debug .= debug($printdebug, "****\n");
 588
 589         $level = 0;
 590         $ind = '_';
 591         $out = '';
 592         $debug .= debug($printdebug, "\n<!--PROCESSING BBCODE TREE:\n");
 593
 594         while ($level >= 0) {
 595                 my $goto_next = '';
 596                 $debug .= debug($printdebug, "[$level:$ind:".int($bbtree->{$ind.'.count'})."]");
 597                 #normal text
 598                 if ($bbtree->{$ind.'.type'} eq 'text') {
 599                         my $text = $bbtree->{$ind.'.value'};
 600                         $debug .= debug($printdebug, "text: ".$text);
 601                         $out .= $escape ? html_encode_line($text) : $text;
 602
 603                         $goto_next = 'tx';
 604                 }
 605                 #tag
 606                 elsif ($bbtree->{$ind.'.type'} eq 'tag') {
 607                         my $name = $bbtree->{$ind.'.name'};
 608                         #endtag
 609                         if ($name =~ /^\//) {
 610                                 $debug .= debug($printdebug, "tag: [$name]");
 611                                 $indd = $ind;
 612                                 $indd =~ s/\.([0-9]+)$//;
 613                                 if (exists($tags->{$name.'='}) && ($bbtree->{$indd.'.value'} ne '')) {
 614                                         $out .= $tags->{$name.'='};
 615                                 }
 616                                 elsif (exists($tags->{$name})) {
 617                                         $out .= $tags->{$name};
 618                                 }
 619                                 else {
 620                                         $out .= $tags->{'/?'};
 621                                         $debug .= debug($printdebug, "[unknown!]");
 622                                 }
 623
 624                                 $ind =~ s/\.([0-9]+)$//;
 625                                 $level -= 1;
 626                                 $debug .= debug($printdebug, "[<]");
 627                                 if ($level > 0) {
 628                                         $goto_next = 'nd';
 629                                 }
 630                                 else {
 631                                         # time to end this
 632                                         $level = -1;
 633                                 }
 634                         }
 635                         #starttag
 636                         else {
 637                                 my $value = $bbtree->{$ind.'.value'};
 638                                 if($bbtree->{$ind.'.closed'} ne '') {
 639                                         $debug .= debug($printdebug, "tag: [$name]");
 640
 641                                         if (exists($tags->{$name.'='}) && ($value ne '')) {
 642                                                 if (exists($tags->{$name.'='.$value})) {
 643                                                         $out .=
 644                                                                 $tags->{$name.'='} .
 645                                                                 $tags->{$name.'='.$value} .
 646                                                                 $tags->{$name.'/='};
 647                                                 }
 648                                                 else {
 649                                                         $out .=
 650                                                                 $tags->{$name.'='} .
 651                                                                 ($escape ? html_entity_encode_dec($value, 1) : $value) .
 652                                                                 $tags->{$name.'/='};
 653                                                 }
 654                                         }
 655                                         elsif (exists($tags->{$name})) {
 656                                                 $out .= $tags->{$name};
 657                                         }
 658                                         else {
 659                                                 $out .= $out.$tags->{'?'};
 660                                                 $debug .= debug($printdebug, "[unknown!]");
 661                                         }
 662                                 }
 663                                 else {
 664                                         $debug .= debug($printdebug, "unclosed tag: [$name]");
 665                                         my $text = $name . (($value ne '') ? ('='.$value) : '');
 666                                         $out .= '['.($escape ? html_encode_line($text) : $text).']';
 667                                 }
 668                                 if ($bbtree->{$ind.'.count'} > 0) {
 669                                         $ind = $ind.'.0';
 670                                         $level += 1;
 671                                         $debug .= debug($printdebug, "[>]");
 672                                 }
 673                                 else {
 674                                         $goto_next = 'st';
 675                                 }
 676                         }
 677                 }
 678                 # what is this
 679                 else {
 680                         $debug .= debug($printdebug, "unknown thing: ".$bbtree->{$ind.'.type'});
 681                         #should not occur with a correct bbtree
 682                         #unless unimplemented
 683                         $ind =~ s/\.([0-9]+)$//;
 684                         $level -= 1;
 685                         $debug .= debug($printdebug, "[<ui]");
 686                         if ($level > 0) {
 687                                 $goto_next = 'un';
 688                         }
 689                         else {
 690                                 # time to end this
 691                                 $level = -1;
 692                         }
 693                 }
 694                 if ($goto_next ne '') {
 695                         {do{
 696                                 $ind =~ s/\.([0-9]+)$//;
 697                                 my $i = int($1) + 1;
 698                                 if (($i < $bbtree->{$ind.'.count'}) and ($1 ne '')){
 699                                         # goto next
 700                                         $ind = $ind.'.'.$i;
 701                                         last;
 702                                 }
 703                                 else {
 704                                         # step out
 705                                         # should not occur with a correct bbtree
 706                                         $debug .= debug($printdebug, "[<$goto_next]");
 707                                         $level -= 1;
 708                                 }
 709                         } while ($level >= 0);}
 710                 }
 711
 712                 $debug .= debug($printdebug, "[>$level:$ind]\n");
 713         }
 714
 715         $debug .= debug($printdebug, "-->\n");
 716         return ($debug, $out);
 717 }
 718
 719 #bbcode to html, TBD
 720 sub bb_to_html {
 721         (my $bb, my $printdebug) = @_;
 722         my $ht;
 723         my %bbtree;
 724         my $debug;
 725
 726         ($debug, %bbtree) = bbtree($bb, $printdebug);
 727         ($debug, $ht) = convtree ($printdebug, $debug, 'html', \%bbtree);
 728
 729         return $ht;
 730 }
 731
 732 #bbcode to bb, TBD
 733 sub bb_to_bbcode {
 734         (my $bb, my $printdebug) = @_;
 735         my $ht;
 736         my %bbtree;
 737         my $debug;
 738
 739         ($debug, %bbtree) = bbtree($bb, $printdebug);
 740         ($debug, $ht) = convtree ($printdebug, $debug, 'bb', \%bbtree);
 741
 742         return $ht;
 743 }
 744
 745 sub eval_bb {
 746         (my $bb, my $full_url, my $password) = @_;
 747         my $value;
 748         my $before;
 749         my $after;
 750
 751         my $base_url = $full_url ?
 752                 {'scheme' => SCHEME(), 'host' => WEBSITE()} :
 753                 {'path' => ''};
 754
 755         while ($bb =~ m/###([^#;]*);/g) {
 756                 $value = $1;
 757                 $before = $`;
 758                 $after = $';
 759
 760                 if ($value =~ /^att&([0-9]+)$/) {
 761                         $value = merge_url(
 762                                 $base_url,
 763                                 {'path' => CGI_ATTACH_PATH()},
 764                                 {'path' => int($1)}
 765                         )
 766                 }
 767                 elsif ($value =~ /^vw&([0-9]+)$/) {
 768                         $value = merge_url(
 769                                 $base_url,
 770                                 {'path' => CGI_VIEWER_PATH()},
 771                                 {'path' => int($1)}
 772                         )
 773                 }
 774                 elsif ($value =~ /^fr&([0-9]+)$/) {
 775                         $value = merge_url(
 776                                 $base_url,
 777                                 {'path' => CGI_FRAME_PATH()},
 778                                 {'path' => int($1)}
 779                         )
 780                 }
 781                 else {
 782                         $value = '';
 783                 }
 784                 if (($value ne '') && ($password ne '')) {
 785                         $value = merge_url(
 786                                 $value,
 787                                 {'query' => {'p' => $password}}
 788                         );
 789                 }
 790                 $bb = $before . $value . $after;
 791         }
 792         return $bb;
 793 }
 794
 795
 796 sub html_encode_line {
 797         (my $text, my $non_ascii, my $all) = @_;
 798         my $html;
 799         my $ind;
 800
 801         $text =~ s/\r\n/\n/gs;
 802         $text =~ s/\r/\n/gs;
 803
 804         while ($text ne '') {
 805                 $ind = index($text, "\n");
 806                 if ($ind >= 0) {
 807                         $html .= html_entity_encode_dec(substr($text, 0, $ind), $non_ascii, $all)."<br>\n";
 808                         $text = substr($text, $ind+1);
 809                 }
 810                 else
 811                 {
 812                         $html .= html_entity_encode_dec($text, 1);
 813                         $text = '';
 814                 }
 815         }
 816         return $html;
 817 }
 818
 819 sub debug {
 820         (my $print, my $text) = @_;
 821
 822         if ($print) {
 823                 print $text;
 824         }
 825
 826         return $text;
 827 }
 828
 829
 830 sub print_html_start {
 831         (my $fh) = @_;
 832         print $fh '<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "">'."\n";
 833         print $fh '<html lang="en">'."\n";
 834 }
 835
 836 sub print_html_end {
 837         (my $fh) = @_;
 838         print $fh '</html>'."\n";
 839 }
 840
 841 sub print_html_head_start {
 842         (my $fh) = @_;
 843         print $fh ' <head>'."\n";
 844         print $fh '  <meta http-equiv="Content-type" content="text/html; charset=UTF-8">'."\n";
 845         print $fh '  <link rel="icon" type="image/png" href="'.html_entity_encode_dec(FAVICON_PATH(),1).'">'."\n";
 846         print $fh '  <link rel="stylesheet" href="'.html_entity_encode_dec(CGI_CSS_PATH(),1).'">'."\n";
 847 }
 848
 849 sub print_html_head_end {
 850         (my $fh) = @_;
 851         print $fh ' </head>'."\n";
 852 }
 853
 854 sub print_html_body_start {
 855         (my $fh) = @_;
 856         print $fh ' <body>'."\n";
 857         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";
 858         print $fh '  <div id="all">'."\n";
 859 }
 860
 861 sub print_html_body_end {
 862         (my $fh, my $hide_credits) = @_;
 863         print $fh '  </div>'."\n";
 864         unless ($hide_credits) {
 865                 print $fh '  <p>'."\n";
 866                 print $fh '   '.html_entity_encode_dec(STORY_CREDITS(),1).'<br>'."\n";
 867                 print $fh '   '.html_entity_encode_dec(INTF_CREDITS(),1).'<br>'."\n";
 868                 print $fh '   <a href="'.html_entity_encode_dec(SOURCE_URL(),1).'" class="cz">source code</a>'."\n";
 869                 print $fh '  </p>'."\n";
 870         }
 871         print $fh '  <a href="/" class="cz">'.html_entity_encode_dec(WEBSITE(),1).'</a>'."\n";
 872         print $fh ' </body>'."\n";
 873 }
 874
 875 sub print_html_data {
 876         (my $fh, my $data) = @_;
 877
 878         foreach my $key (keys %$data) {
 879                 unless ($key eq 'content') {
 880                         my $val = $data->{$key};
 881                         $val =~ s/(\r)?\n/\n /gs; # does the space make sense in HTML anyway?
 882                         print $fh html_encode_line("$key: $val\n", 1);
 883                 }
 884         }
 885         print $fh html_encode_line("\n".$data->{'content'});
 886 }
 887
 888 sub print_goto {
 889         (
 890                 my $file,
 891                 my $state,
 892                 my $settings,
 893                 my $goto_list,
 894                 my $password_ok,
 895         ) = @_;
 896
 897         my $fh;
 898         my $last_frame;
 899         my $ong_state;
 900         my $password_query;
 901
 902         $last_frame = int($state->{'last'});
 903         $ong_state  = int($state->{'state'});
 904         $password_query = url_query_encode({'p', $settings->{'password'}});
 905
 906         my $_title        = html_entity_encode_dec($settings->{'story'}, 1);
 907         my $_website_name = html_entity_encode_dec(WEBSITE_NAME()    , 1);
 908         my $_base_url     = html_entity_encode_dec(CGI_PATH()        , 1);
 909
 910         if (ref($file)) {
 911                 $fh=$file;
 912                 unless (seek($fh, 0, 0)) {
 913                         #don't actually fail here
 914                 }
 915         }
 916         else {
 917                 unless (open_encoded($fh, ">:encoding(UTF-8)", $file)) {
 918                         return 0;
 919                 }
 920         }
 921
 922         print_html_start($fh);
 923         print_html_head_start($fh);
 924
 925         print $fh '  <title>GOTO &bull; '.$_title.' &bull; '.$_website_name.'</title>'."\n";
 926
 927         print_html_head_end($fh);
 928         print_html_body_start($fh);
 929
 930         print $fh '   <div id="inst" class="ins">'."\n";
 931
 932         print $fh '    <div id="title">'."\n";
 933         print $fh '     <h1 id="titletext">'.$_title.'</h1>'."\n";
 934         print $fh '    </div>'."\n";
 935
 936         print $fh '   </div>'."\n";
 937         print $fh '   <div id="insb" class="ins">'."\n";
 938
 939         print $fh '    <div id="chat">'."\n";
 940
 941         for (my $frame = 0; ; $frame += 1) {
 942                 unless (
 943                         $password_ok || (
 944                                 ($frame <= $last_frame) &&
 945                                 ($ong_state >= STATE->{'waiting'})
 946                         )
 947                 ) {
 948                         last;
 949                 }
 950                 my $title;
 951                 my $ongtime;
 952                 my @time_tab;
 953                 my $time_text;
 954                 my $timer_color;
 955                 my $frame_text;
 956                 my $viewer_url;
 957
 958                 $ongtime = $goto_list->{'ongtime-'.$frame};
 959                 $title   = $goto_list->{'title-'  .$frame};
 960                 if (($ongtime eq '') && ($title eq '')) {
 961                         my %frame_data = read_frame_data($frame);
 962                         $ongtime = $frame_data{'ongtime'};
 963                         $title   = $frame_data{'title'};
 964                         unless (keys %frame_data) {
 965                                 last;
 966                         }
 967                 }
 968
 969                 if ($ongtime ne '') {
 970                         @time_tab = gmtime($ongtime);
 971                         $time_text = sprintf(
 972                                 '%02d.%02d.%02d %02d:%02d',
 973                                 $time_tab[3],
 974                                 $time_tab[4]+1,
 975                                 $time_tab[5]%100,
 976                                 $time_tab[2],
 977                                 $time_tab[1]
 978                         );
 979                 }
 980                 else {
 981                         $time_text = (($frame <= $last_frame) && ($ong_state >= STATE->{'waiting'})) ?
 982                                 'EE.EE.EE EE:EE' : '--.--.-- --:--';
 983                 }
 984                 if ($title eq '') {
 985                         $title = '_';
 986                 }
 987                 $timer_color = (($frame > $last_frame) || ($ong_state < STATE->{'waiting'})) ?
 988                         'cz' : (
 989                                 (($frame == $last_frame) && ($ong_state < STATE->{'ready'})) ?
 990                                         'ni' : 'br'
 991                         );
 992                 $frame_text = sprintf('%03d',$frame);
 993                 $viewer_url = merge_url(
 994                         {'path' => CGI_VIEWER_PATH()},
 995                         {'path' => $frame}
 996                 ); # TODO: consider static here?
 997                 if ($password_ok) {
 998                         $viewer_url = merge_url($viewer_url, {'query' => $password_query, 'append_query' => 1, 'preserve_fragment' => 1});
 999                 }
1000
1001                 my $_viewer_url = html_entity_encode_dec($viewer_url, 1);
1002                 my $_title      = html_entity_encode_dec($title     , 1);
1003
1004                 print $fh '     <span class="'.$timer_color.'">'.$frame_text.'</span> '.$time_text.' <a href="'.$_viewer_url.'">'.$_title.'</a><br>'."\n";
1005         }
1006         print $fh '    </div>'."\n";
1007
1008         print $fh '    <div id="underlinks">'."\n";
1009         print $fh '     <a href="'.$_base_url.'">BSTA</a>'."\n";
1010         print $fh '    </div>'."\n";
1011
1012         print $fh '   </div>'."\n";
1013
1014         print_html_body_end($fh, $ong_state == STATE->{'inactive'});
1015         print_html_end($fh);
1016
1017         unless (ref($file)) {
1018                 close ($fh);
1019         }
1020         else {
1021                 truncate ($fh , tell($fh));
1022         }
1023
1024         return 1;
1025 }
1026
1027 sub print_viewer_page {
1028         (
1029                 my $file,
1030                 my $context,
1031                 my $state,
1032                 my $settings,
1033                 my $frame_data,
1034                 my $prev_frame_data,
1035                 my $next_frame_data,
1036                 my $words_data,
1037         ) = @_;
1038         my $fh;
1039
1040         my $launch      = $context->{'launch'};
1041         my $access      = $context->{'access'};
1042         my $password_ok = $context->{'password_ok'};
1043         my $static      = $context->{'static'};
1044
1045         my $goto           = int($context->{'goto'});
1046         my $frame          = int($context->{'frame'});
1047         my $text_mode      = int($context->{'text_mode'});
1048         my $timer_unlocked = int($context->{'timer_unlocked'});
1049         my $timer          = int($context->{'timer'});
1050         # my $words_page     = int($context->{'words_page'});
1051
1052         my $prev_frame = $frame - 1;
1053         my $next_frame = $frame + 1;
1054
1055         my $story = $settings->{'story'};
1056         my $title = $frame_data->{'title'};
1057         my $command = ($frame_data->{'command'} ne '') ?
1058                 $frame_data->{'command'} :
1059                 $next_frame_data->{'title'};
1060
1061         my $last_frame = int($state->{'last'});
1062         my $ong_state  = int($state->{'state'});
1063
1064         my $width  = int($frame_data->{'width'});
1065         my $height = int($frame_data->{'height'});
1066         my $frame_type = $frame_data->{'frametype'};
1067
1068         my $timer_color_h = (($timer_unlocked >= 1) || ($ong_state >= STATE->{'ready'})) ? 'br' : 'ni';
1069         my $timer_color_m = (($timer_unlocked >= 2) || ($ong_state >= STATE->{'ready'})) ? 'br' : 'ni';
1070         my $timer_color_s = (($timer_unlocked >= 3) || ($ong_state >= STATE->{'ready'})) ? 'br' : 'ni';
1071
1072         my $timer_h;
1073         my $timer_m;
1074         my $timer_s;
1075         if (
1076                 ($timer > 0) ||
1077                 (($timer >= 0) && ($frame == 0))
1078         ) {
1079                 $timer_s = sprintf('%02d', $timer % 60);
1080                 $timer_h = int($timer / 60);
1081                 $timer_m = sprintf('%02d', $timer_h % 60);
1082                 $timer_h = sprintf('%02d', $timer_h / 60);
1083         }
1084         elsif (($timer >= -15) && ($ong_state >= STATE->{'ready'})) {
1085                 $timer_h = '00';
1086                 $timer_m = '00';
1087                 $timer_s = 'NG';
1088         }
1089         else {
1090                 $timer_h = 'EE';
1091                 $timer_m = 'EE';
1092                 $timer_s = 'EE';
1093         }
1094
1095         my $words_posts = int($words_data->{'posts'});
1096         my $words_link_text = 'Words'.(($words_posts > 0) ? "[$words_posts]" : '');
1097
1098         my $prev_available = (($frame > 0) && $access);
1099         my $next_available = ($launch || $password_ok || ($next_frame <= $last_frame));
1100         my $prefetch_prev = (
1101                 $password_ok ||
1102                 ($prev_frame < $last_frame) || (  # avoid unseen trigger!
1103                         ($prev_frame <= $last_frame) &&
1104                         ($ong_state >= STATE->{'ready'})
1105                 )
1106         );
1107         my $prefetch_next  = (
1108                 $password_ok ||
1109                 ($next_frame < $last_frame) || (  # avoid unseen trigger!
1110                         ($next_frame <= $last_frame) &&
1111                         ($ong_state >= STATE->{'ready'})
1112                 )
1113         );
1114         my $show_timer = (
1115                 (
1116                         $access && $launch
1117                 ) || (
1118                         ($frame == $last_frame) && (
1119                                 ($ong_state == STATE->{'waiting'}) ||
1120                                 ($ong_state == STATE->{'ready'})
1121                         )
1122                 )
1123         );
1124         my $show_command = (
1125                 $launch ||
1126                 $password_ok ||
1127                 (!$access) ||
1128                 ($frame < $last_frame) || (
1129                         ($ong_state >= STATE->{'ready'}) &&
1130                         $context->{'show_command'}
1131                 )
1132         );
1133         my $show_command_link = ($next_available || (!$access));
1134         my $show_command_cursor = ((!$next_available) || ($command eq ''));
1135         my $show_words = ($password_ok || ($access && !$launch));
1136
1137         my $frame_indirect = !(
1138                 (!$access) || (
1139                         ($frame <= $last_frame) &&
1140                         ($ong_state > STATE->{'inactive'})
1141                 )
1142         );
1143         my $prevframe_indirect = !($prev_frame <= $last_frame);
1144         my $nextframe_indirect = !($next_frame <= $last_frame);
1145
1146         my $password_query;
1147
1148         my $base_url   = CGI_PATH();
1149         my $timer_url  = CGI_TIMER_PATH();
1150         my $viewer_full_url = merge_url(
1151                 {'scheme' => SCHEME(), 'host' => WEBSITE()},
1152                 {'path' => CGI_VIEWER_PATH()},
1153                 {'path' => $frame}
1154         );
1155         my $viewer_url = merge_url(
1156                 {'path' => CGI_VIEWER_PATH()},
1157                 {'path' => $frame}
1158         );
1159         my $viewer_0_url = merge_url(
1160                 {'path' => CGI_VIEWER_PATH()},
1161                 {'path' => 0}
1162         );
1163         my $viewer_prev_url = merge_url(
1164                 {'path' => CGI_VIEWER_PATH()},
1165                 {'path' => $prev_frame}
1166         );
1167         my $viewer_next_url = merge_url(
1168                 {'path' => CGI_VIEWER_PATH()},
1169                 {'path' => $next_frame}
1170         );
1171         my $viewer_last_url = merge_url(
1172                 {'path' => CGI_VIEWER_PATH()},
1173                 {'path' => ($static ? -1 : $last_frame)}
1174         );
1175         my $goto_url = ($goto) ?
1176                 CGI_GOTO_PATH() :
1177                 merge_url(
1178                         {'path' => $viewer_url},
1179                         {
1180                                 'query' => {
1181                                         'g' => 1,
1182                                         'b' => $text_mode
1183                                 },
1184                                 'fragment' => 'goto'
1185                         }
1186                 );
1187
1188         unless ($password_ok) {
1189                 my $page_file;
1190                 $viewer_0_url = $base_url;
1191                 if ($prev_frame == 0) {
1192                         $viewer_prev_url = $viewer_0_url;
1193                 }
1194                 else {
1195                         $page_file = get_page_file($prev_frame, $prev_frame_data, $settings);
1196                         if (_x_encoded('-f',
1197                                 join_path(PATH_SEPARATOR(), WWW_PATH() , $page_file)
1198                         )) {
1199                                 $viewer_prev_url = merge_url(
1200                                         {'path' => $base_url},
1201                                         {'path' => $page_file}
1202                                 );
1203                         }
1204                 }
1205                 if ($next_frame < $last_frame) {
1206                         $page_file = get_page_file($next_frame, $next_frame_data, $settings);
1207                         if (_x_encoded('-f',
1208                                 join_path(PATH_SEPARATOR(), WWW_PATH() , $page_file)
1209                         )) {
1210                                 $viewer_next_url = merge_url(
1211                                         {'path' => $base_url},
1212                                         {'path' => $page_file}
1213                                 );
1214                         }
1215                 }
1216                 if (
1217                         $goto &&
1218                         (_x_encoded('-f',WWW_GOTO_PATH()))
1219                 ) {
1220                         $goto_url = CGI_LIST_PATH();
1221                 }
1222         }
1223         my $bbcode_url = ($text_mode == TEXT_MODE->{'bb'}) ?
1224                 merge_url(
1225                         {'path' => CGI_BBCODE_PATH()},
1226                         {'path' => $frame}
1227                 ) :
1228                 merge_url (
1229                         $viewer_url,
1230                         {
1231                                 'query'=>{
1232                                 'b' => TEXT_MODE->{'bb'}
1233                                 },
1234                                 'fragment'=>'insb'
1235                         }
1236                 );
1237         my $info_url = ($text_mode == TEXT_MODE->{'info'}) ?
1238                 merge_url(
1239                         {'path' => CGI_INFO_PATH()},
1240                         {'path' => $frame}
1241                 ) :
1242                 merge_url (
1243                         $viewer_url,
1244                         {
1245                                 'query'=>{
1246                                 'b' => TEXT_MODE->{'info'}
1247                                 },
1248                                 'fragment'=>'insb'
1249                         }
1250                 );
1251         my $words_url = merge_url (
1252                 $viewer_url,
1253                 {
1254                         'query'=>{
1255                         'b' => TEXT_MODE->{'words'}
1256                         },
1257                         'fragment'=>'insw'
1258                 }
1259         );
1260         my $frame_file;
1261         my $frame_url;
1262         my $frame_prev_url;
1263         my $frame_next_url;
1264         my $frame_normal_url;
1265         my $frame_full_url;
1266         $frame_file = get_frame_file($frame, $frame_data, $settings);
1267         $frame_normal_url = merge_url(
1268                         {'path' => CGI_PATH()},
1269                         {'path' => $frame_file}
1270                 );
1271         $frame_url = $frame_indirect ?
1272                 merge_url(
1273                         {'path' => CGI_FRAME_PATH()},
1274                         {'path' => $frame}
1275                 ) :
1276                 $frame_normal_url;
1277         $frame_full_url = merge_url(
1278                 {'scheme' => SCHEME(), 'host' => WEBSITE()},
1279                 {'path' => $frame_normal_url}
1280         );
1281         if ($prevframe_indirect) {
1282                 $frame_prev_url = merge_url(
1283                         {'path' => CGI_FRAME_PATH()},
1284                         {'path' => $prev_frame}
1285                 );
1286         }
1287         else {
1288                 $frame_prev_url = merge_url(
1289                         {'path' => CGI_PATH()},
1290                         {'path' => get_frame_file($prev_frame, $prev_frame_data, $settings)}
1291                 );
1292         }
1293         if ($nextframe_indirect) {
1294                 $frame_next_url = merge_url(
1295                         {'path' => CGI_FRAME_PATH()},
1296                         {'path' => $next_frame}
1297                 );
1298         }
1299         else {
1300                 $frame_next_url = merge_url(
1301                         {'path' => CGI_PATH()},
1302                         {'path' => get_frame_file($next_frame, $next_frame_data, $settings)}
1303                 );
1304         }
1305
1306         if ($password_ok) {
1307                 $password_query = url_query_encode({'p', $settings->{'password'}});
1308                 $goto_url        = merge_url($goto_url       , {'query' => $password_query, 'append_query' => 1, 'preserve_fragment' => 1});
1309                 $info_url        = merge_url($info_url       , {'query' => $password_query, 'append_query' => 1, 'preserve_fragment' => 1});
1310                 $words_url       = merge_url($words_url      , {'query' => $password_query, 'append_query' => 1, 'preserve_fragment' => 1});
1311                 $bbcode_url      = merge_url($bbcode_url     , {'query' => $password_query, 'append_query' => 1, 'preserve_fragment' => 1});
1312                 $viewer_url      = merge_url($viewer_url     , {'query' => $password_query, 'append_query' => 1, 'preserve_fragment' => 1});
1313                 $viewer_0_url    = merge_url($viewer_0_url   , {'query' => $password_query, 'append_query' => 1, 'preserve_fragment' => 1});
1314                 $viewer_prev_url = merge_url($viewer_prev_url, {'query' => $password_query, 'append_query' => 1, 'preserve_fragment' => 1});
1315                 $viewer_next_url = merge_url($viewer_next_url, {'query' => $password_query, 'append_query' => 1, 'preserve_fragment' => 1});
1316                 $viewer_last_url = merge_url($viewer_last_url, {'query' => $password_query, 'append_query' => 1, 'preserve_fragment' => 1});
1317                 if ($frame_indirect) {
1318                         $frame_url     = merge_url($frame_url      , {'query' => $password_query, 'append_query' => 1, 'preserve_fragment' => 1});
1319                 }
1320                 if ($prevframe_indirect) {
1321                         $frame_prev_url= merge_url($frame_prev_url , {'query' => $password_query, 'append_query' => 1, 'preserve_fragment' => 1});
1322                 }
1323                 if ($nextframe_indirect) {
1324                         $frame_next_url= merge_url($frame_next_url , {'query' => $password_query, 'append_query' => 1, 'preserve_fragment' => 1});
1325                 }
1326         }
1327         my $_password = $password_ok ? html_entity_encode_dec($settings->{'password'}, 1) : '';
1328         my $_action_url      = html_entity_encode_dec(CGI_VIEWER_PATH(), 1);
1329         my $_base_url        = html_entity_encode_dec($base_url        , 1);
1330         my $_goto_url        = html_entity_encode_dec($goto_url        , 1);
1331         my $_info_url        = html_entity_encode_dec($info_url        , 1);
1332         my $_words_url       = html_entity_encode_dec($words_url       , 1);
1333         my $_bbcode_url      = html_entity_encode_dec($bbcode_url      , 1);
1334         my $_timer_url       = html_entity_encode_dec($timer_url       , 1);
1335         my $_viewer_full_url = html_entity_encode_dec($viewer_full_url , 1);
1336         my $_viewer_url      = html_entity_encode_dec($viewer_url      , 1);
1337         my $_viewer_0_url    = html_entity_encode_dec($viewer_0_url    , 1);
1338         my $_viewer_prev_url = html_entity_encode_dec($viewer_prev_url , 1);
1339         my $_viewer_next_url = html_entity_encode_dec($viewer_next_url , 1);
1340         my $_viewer_last_url = html_entity_encode_dec($viewer_last_url , 1);
1341         my $_frame_url       = html_entity_encode_dec($frame_url       , 1);
1342         my $_frame_prev_url  = html_entity_encode_dec($frame_prev_url  , 1);
1343         my $_frame_next_url  = html_entity_encode_dec($frame_next_url  , 1);
1344         my $_frame_full_url  = html_entity_encode_dec($frame_full_url  , 1);
1345
1346         my $_story      = html_entity_encode_dec($story     , 1);
1347         my $_title      = html_entity_encode_dec($title     , 1);
1348         my $_command    = html_entity_encode_dec($command   , 1);
1349         my $_frame_type = html_entity_encode_dec($frame_type, 1);
1350
1351         my $_website_name = html_entity_encode_dec(WEBSITE_NAME(), 1);
1352
1353         if ($text_mode == TEXT_MODE->{'info'}) {
1354                 if ($show_command) {
1355                         $frame_data->{'command'} = $command;
1356                 }
1357                 if ($access) {
1358                         $frame_data->{'frame'} = $frame_file;
1359                 }
1360                 if ($frame_data->{'page'} eq '') {
1361                         unless (($access) && ($frame < $last_frame)) {
1362                                 $frame_data->{'page'} = '';
1363                         }
1364                         else {
1365                                 $frame_data->{'page'} = get_page_file($frame, $frame_data, $settings);
1366                         }
1367                 }
1368         }
1369
1370         # everything determined, now start generating
1371
1372         if (ref($file)) {
1373                 $fh=$file;
1374                 unless (seek($fh, 0, 0)) {
1375                         #don't actually fail here
1376                 }
1377         }
1378         else {
1379                 unless (open_encoded($fh, ">:encoding(UTF-8)", $file)) {
1380                         return 0;
1381                 }
1382         }
1383
1384         print_html_start($fh);
1385         print_html_head_start($fh);
1386
1387         print $fh '  <title>'.$_title;
1388         if ($story ne $title) {
1389                 print $fh ' &bull; '.$_story;
1390         }
1391         print $fh ' &bull; '.$_website_name.'</title>'."\n";
1392         print $fh '  <link rel="index" href="'.$_goto_url.'">'."\n";
1393         print $fh '  <link rel="start" href="'.$_viewer_0_url.'">'."\n";
1394         if ($prev_available) {
1395                 print $fh '  <link rel="prev" href="'.$_viewer_prev_url.'">'."\n";
1396                 if ($prefetch_prev) {
1397                         print $fh '  <link rel="prefetch" href="'.$_viewer_prev_url.'">'."\n";
1398                         print $fh '  <link rel="prefetch" href="'.$_frame_prev_url.'">'."\n";
1399                 }
1400         }
1401         if ($next_available) {
1402                 print $fh '  <link rel="next" href="'.$_viewer_next_url.'">'."\n";
1403                 if ($prefetch_next) {
1404                         print $fh '  <link rel="prefetch" href="'.$_viewer_next_url.'">'."\n";
1405                         print $fh '  <link rel="prefetch" href="'.$_frame_next_url.'">'."\n";
1406                 }
1407         }
1408         if ($show_timer) {
1409                 print $fh '  <script src="'.$_timer_url.'"></script>'."\n";
1410         }
1411
1412         print_html_head_end($fh);
1413         print_html_body_start($fh);
1414
1415         print $fh '   <div id="inst" class="ins">'."\n";
1416
1417         print $fh '    <div id="title">'."\n";
1418         print $fh '     <h1 id="titletext">'.$_title.'</h1>'."\n";
1419         print $fh '    </div>'."\n";
1420
1421         print $fh '   </div>'."\n";
1422         print $fh '   <div id="framespace">'."\n";
1423
1424         print $fh '    <img src="'.$_frame_url.'" id="frame" class="'.$_frame_type.'" alt="'.$frame.'" title="'.$_title.'" width="'.$width.'" height="'.$height.'">'."\n";
1425
1426         print $fh '   </div>'."\n";
1427         print $fh '   <div id="insb" class="ins">'."\n";
1428
1429         if ($text_mode == TEXT_MODE->{'info'}) {
1430                 print $fh '    <div id="chat">'."\n";
1431
1432                 print_html_data($fh, $frame_data);
1433
1434                 print $fh '    </div>'."\n";
1435         }
1436         elsif ($text_mode == TEXT_MODE->{'bb'}) {
1437                 print $fh '    <div id="chat">'."\n";
1438
1439                 print $fh '[quote][center][size=200]'.$_title.'[/size]<br>'."\n";
1440                 print $fh '[url='.$_viewer_full_url.'][img]'.$_frame_full_url.'[/img][/url][/center]<br>'."\n";
1441                 print $fh html_encode_line(
1442                         bb_to_bbcode(
1443                                 eval_bb(
1444                                         $frame_data->{'content'},
1445                                         1
1446                                 )
1447                         )
1448                 );
1449                 print $fh '[/quote]'."\n";
1450
1451                 print $fh '    </div>'."\n";
1452         }
1453         elsif ($frame_data->{'content'} ne '') {
1454                 print $fh '    <div id="undertext">'."\n";
1455                 print $fh bb_to_html(
1456                         eval_bb(
1457                                 $frame_data->{'content'},
1458                                 0,
1459                                 $password_ok ? $settings->{'password'} : ''
1460                         )
1461                 )."\n";
1462                 print $fh '    </div>'."\n";
1463         }
1464
1465         print $fh '    <div id="command">'."\n";
1466
1467         if ($show_timer) {
1468                 print $fh '     <span id="timer">';
1469                 print $fh '[<span id="ongh" class="hv '.$timer_color_h.'">'.$timer_h.'</span>';
1470                 print $fh ':<span id="ongm" class="hv '.$timer_color_m.'">'.$timer_m.'</span>';
1471                 print $fh ':<span id="ongs" class="hv '.$timer_color_s.'">'.$timer_s.'</span>]';
1472                 print $fh '</span><br>'."\n";
1473         }
1474         print $fh '     &gt;';
1475         if ($show_command_link) {
1476                 print $fh '<a href="'.($access ? $_viewer_next_url : $_viewer_last_url).'">';
1477         }
1478         if ($show_command) {
1479                 print $fh $_command;
1480         }
1481         if ($show_command_cursor) {
1482                 print $fh '<span class="inp">_</span>';
1483         }
1484         if ($show_command_link) {
1485                 print $fh '</a>';
1486         }
1487         print $fh "<br>\n";
1488         print $fh "    </div>\n";
1489
1490         print $fh '    <div id="underlinks">'."\n     ";
1491
1492         unless (($frame == 0) && $static) {
1493                 print $fh '<a href="'.$_base_url.'">Once again</a> | ';
1494         }
1495         if ($prev_available) {
1496                 print $fh '<a href="'.$_viewer_prev_url.'">Before</a> | ';
1497         }
1498         unless ($frame == $last_frame) {
1499                 print $fh '<a href="'.$_viewer_last_url.'">Now</a> | ';
1500         }
1501         print $fh '<a href="'.$_goto_url.'">GOTO</a>'."\n";
1502         print $fh '     <span style="float: right;">'."\n      ";
1503         if (
1504                 ($text_mode == TEXT_MODE->{'normal'})
1505                 # && (!$goto)
1506         ){
1507                 if ($show_words) {
1508                         print $fh '<a href="'.$_words_url.'">'.$words_link_text.'</a> | ';
1509                 }
1510         }
1511         else {
1512                 print $fh '<a href="'.$_viewer_url.'">Without</a> | ';
1513         }
1514         print $fh '<a href="'.$_info_url.'">Info</a> | ';
1515         print $fh '<a href="'.$_bbcode_url.'">BB</a>';
1516         print $fh "\n     </span>\n";
1517
1518         print $fh "    </div>\n";
1519
1520         if ($goto) {
1521                 print $fh '    <div class="underlinks" id="goto">'."\n";
1522                 print $fh '     <form class="goto" method="get" action="'.$_action_url.'">'."\n";
1523                 print $fh '      GO TO:'."\n";
1524                 print $fh '      <input class="intx" type="number" size="4" name="f"'.(
1525                         ($goto > 1) ?
1526                                 ('value="'.$frame.'"') :
1527                                 ''
1528                         ).'>'."\n";
1529                 print $fh '      <input class="inbt" type="submit" value="GO">'."\n";
1530                 if ($password_ok) {
1531                         print $fh '      <input type="hidden" name="p" value="'.$_password.'">'."\n";
1532                 }
1533                 print $fh '      <input type="hidden" name="g" value="2">'."\n";
1534                 print $fh '     </form>'."\n";
1535                 print $fh "    </div>\n";
1536         }
1537
1538         print $fh "   </div>\n";
1539
1540         if (($text_mode == TEXT_MODE->{'words'}) && $show_words) {
1541                 print_comments($fh, $context, $settings, $words_data);
1542         }
1543
1544         print_html_body_end($fh, $ong_state == STATE->{'inactive'});
1545         print_html_end($fh);
1546
1547
1548         unless (ref($file)) {
1549                 close ($fh);
1550         }
1551         else {
1552                 truncate ($fh , tell($fh));
1553         }
1554
1555         return 1;
1556 }
1557
1558 sub print_comments {
1559         (my $fh, my $context, my $settings, my $words_data) = @_;
1560
1561         my $password_ok = $context->{'password_ok'};
1562         my $frame = int($context->{'frame'});
1563         my $page = int($context->{'words_page'});
1564         my $post_count = int($words_data->{'posts'});
1565         my $id_start = $page * COMMENT_PAGE_LENGTH();
1566         my $id_stop = $id_start + COMMENT_PAGE_LENGTH();
1567         my $older = ($page > 0) ? ($page-1) : '';
1568         my $newer;
1569         my $password_query;
1570         if ($id_stop >= $post_count) {
1571                         $id_stop = $post_count;
1572         }
1573         else {
1574                 $newer = $page+1;
1575         }
1576         my $links;
1577
1578         my $words_url = merge_url(
1579                 {'path' => CGI_VIEWER_PATH()},
1580                 {
1581                         'path' => $frame,
1582                         'query' => {'b' => TEXT_MODE->{'words'}},
1583                 }
1584         );
1585         my $older_url = merge_url(
1586                 $words_url,
1587                 {
1588                         'query' => {'i' => $page-1},
1589                         'fragment' => 'insw',
1590                         'append_query' => 1
1591                 }
1592         );
1593         my $newer_url = merge_url(
1594                 $words_url,
1595                 {
1596                         'query' => {'i' => $page+1},
1597                         'fragment' => 'insw',
1598                         'append_query' => 1
1599                 }
1600         );
1601
1602         if ($password_ok) {
1603                 $password_query = url_query_encode({'p', $settings->{'password'}});
1604                 $older_url = merge_url($older_url, {'query' => $password_query, 'append_query' => 1, 'preserve_fragment' => 1});
1605                 $newer_url = merge_url($older_url, {'query' => $password_query, 'append_query' => 1, 'preserve_fragment' => 1});
1606         }
1607
1608         my $_password = $password_ok ? html_entity_encode_dec($settings->{'password'}, 1) : '';
1609         my $_post_url = html_entity_encode_dec(CGI_WORDS_PATH(), 1);
1610         my $_older_url = html_entity_encode_dec($older_url, 1);
1611         my $_newer_url = html_entity_encode_dec($newer_url, 1);
1612
1613         if (($older ne '') || ($newer ne '')) {
1614                 $links .= '    <div class="underlinks">'."\n";
1615                 $links .= '     ';
1616                 if ($older ne '') {
1617                         $links .= '<a href="'.$_older_url.'">Older</a>'
1618                 }
1619                 if (($older ne '') && ($newer ne '')) {
1620                         $links .= ' | ';
1621                 }
1622                 if ($newer ne '') {
1623                         $links .= '<a href="'.$_newer_url.'">Newer</a>';
1624                 }
1625                 $links .= "\n";
1626                 $links .= '    </div>'."\n";
1627         }
1628
1629         print $fh '   <div class="space"></div>'."\n";
1630         print $fh '   <div id="insw" class="ins">'."\n";
1631
1632         print $fh '    <div class="title" id="wordstitle">'."\n";
1633         print $fh '     <h1 class="titletext" id="wordstitletext">Words</h1>'."\n";
1634         print $fh '    </div>'."\n";
1635
1636         if ($links ne '') {
1637                 print $fh $links;
1638         }
1639
1640         print $fh '    <div class="undertext" id="words">'."\n";
1641
1642         if ($post_count > 0) {
1643                 for (my $i=$id_start; $i<$id_stop; ++$i) {
1644                         my $ID = $words_data->{'content'}->[$i];
1645                         my %post_data = read_words($ID);
1646
1647                         my $post_time = int($post_data{'posttime'});
1648                         my $edit_time = int($post_data{'edittime'});
1649
1650                         my $post_time_text;
1651                         my $edit_time_text;
1652
1653                         if ($post_time != 0) {
1654                                 my @time_tab = gmtime($post_time);
1655                                 $post_time_text = sprintf(
1656                                         '%04d.%02d.%02d %02d:%02d:%02d UTC',
1657                                         $time_tab[5]+1900,
1658                                         $time_tab[4]+1,
1659                                         $time_tab[3],
1660                                         $time_tab[2],
1661                                         $time_tab[1],
1662                                         $time_tab[0]
1663                                 );
1664                         }
1665                         if (($edit_time !=0) && ($edit_time != $post_time)) {
1666                                 my @time_tab = gmtime($edit_time);
1667                                 $edit_time_text = sprintf(
1668                                         '%04d.%02d.%02d %02d:%02d UTC',
1669                                         $time_tab[5]+1900,
1670                                         $time_tab[4]+1,
1671                                         $time_tab[3],
1672                                         $time_tab[2],
1673                                         $time_tab[1]
1674                                 );
1675                         }
1676                         my $quote_url = merge_url(
1677                                 {'path' => CGI_WORDS_PATH()},
1678                                 {
1679                                         'query' => {
1680                                                 'f' => $frame,
1681                                                 'quote' => $ID,
1682                                                 'p' => ($password_ok ? $settings->{'password'} : '')
1683                                         }
1684                                 }
1685                         );
1686                         my $edit_url = merge_url(
1687                                 {'path' => CGI_WORDS_PATH()},
1688                                 {
1689                                         'query' => {
1690                                                 'f' => $frame,
1691                                                 'edit' => $ID,
1692                                                 'key' => $post_data{'key'},
1693                                                 'username' => $post_data{'name'},
1694                                                 'p' => ($password_ok ? $settings->{'password'} : '')
1695                                         }
1696                                 }
1697                         );
1698                         my $remove_url = merge_url(
1699                                 {'path' => CGI_WORDS_PATH()},
1700                                 {
1701                                         'query' => {
1702                                                 'f' => $frame,
1703                                                 'remove' => $ID,
1704                                                 'key' => $post_data{'key'},
1705                                                 'username' => $post_data{'name'},
1706                                                 'p' => ($password_ok ? $settings->{'password'} : '')
1707                                         }
1708                                 }
1709                         );
1710
1711                         my $_ID         = html_entity_encode_dec($ID, 1);
1712                         my $_name       = html_entity_encode_dec($post_data{'name'}, 1);
1713                         my $_quote_url  = html_entity_encode_dec($quote_url, 1);
1714                         my $_edit_url   = html_entity_encode_dec($edit_url, 1);
1715                         my $_remove_url = html_entity_encode_dec($remove_url, 1);
1716
1717                         print $fh '     <div id="'.$_ID.'"class="opomba">'."\n";
1718                         print $fh '      <div class="opomba_info">'."\n";
1719                         print $fh '       <a href="#'.$_ID.'" class="bi hu">'.$i.': '.$_name;
1720                         if ($post_time_text ne '') {
1721                                 print $fh ' &bull; '.$post_time_text;
1722                         }
1723                         if ($edit_time_text ne '') {
1724                                 print $fh ' &bull; '.$edit_time_text;
1725                         }
1726                         print $fh '</a>'."\n";
1727                         print $fh '       <div class="pr">'."\n";
1728                         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";
1729                         print $fh '       </div>'."\n";
1730                         print $fh '      </div>'."\n";
1731                         print $fh '      <div class="opomba_text">'."\n";
1732                   print $fh bb_to_html(
1733                                 eval_bb(
1734                                         $post_data{'content'},
1735                                         0,
1736                                         $password_ok ? $settings->{'password'} : ''
1737                                 )
1738                         )."\n";
1739                         print $fh '      </div>'."\n";
1740                         print $fh '     </div>'."\n";
1741                         print $fh '     <br>'."\n";
1742                 }
1743         }
1744
1745         print $fh '     <form method="post" action="'.$_post_url.'">'."\n";
1746         print $fh '      <b>Your words:</b>'."\n";
1747         print $fh '      <textarea class="inta" name="words" rows="4"></textarea>'."\n";
1748         print $fh '      <table cellpadding="0" cellspacing="0" border="0"><tr>'."\n";
1749         print $fh '       <td><b>Your name: </b></td>'."\n";
1750         print $fh '       <td><input class="intx" type="text" name="username" value=""></td>'."\n";
1751         print $fh '       <td></td>'."\n";
1752         print $fh '      </tr><tr>'."\n";
1753         print $fh '       <td><b>Optional password: </b></td>'."\n";
1754         print $fh '       <td><input class="intx" type="password" name="password" value=""></td>'."\n";
1755         print $fh '       <td>(if you want to edit later)</td>'."\n";
1756         print $fh '      </tr><tr>'."\n";
1757         print $fh '       <td><b>Leave this empty: </b></td>'."\n";
1758         print $fh '       <td><input class="intx" type="text" name="password2" value=""></td>'."\n";
1759         print $fh '       <td>'."\n";
1760         print $fh '        <input class="inbt" type="submit" name="post" value="Send">'."\n";
1761         print $fh '        <input class="inbt" type="submit" name="preview" value="Preview">'."\n";
1762         print $fh '       </td>'."\n";
1763         print $fh '      </tr></table>'."\n";
1764         print $fh '      <input type="hidden" name="f" value="'.$frame.'">'."\n";
1765         if ($password_ok) {
1766                 print $fh '      <input type="hidden" name="p" value="'.$_password.'">'."\n";
1767         }
1768         print $fh '     </form>'."\n";
1769         print $fh '    </div>'."\n";
1770
1771         if ($links ne '') {
1772                 print $fh $links;
1773         }
1774
1775         print $fh '   </div>'."\n";
1776 }
1777
1778 sub write_index {
1779         (
1780                 my $state,
1781                 my $settings,
1782                 my $pass,
1783                 my $mode,
1784                 my $pause
1785         ) = @_;
1786         my $fh;
1787         my $r = 1;
1788         my $ong_state = int($state->{'state'});
1789
1790         unless (open_encoded($fh, ">:encoding(UTF-8)", WWW_INDEX_PATH())) {
1791                 return 0;
1792         }
1793
1794         # normal running story
1795         if ($ong_state > STATE->{'inactive'}) {
1796                 my %default        = read_default();
1797                 my %frame_data     = read_frame_data(0, \%default);
1798                 my %next_frame_data= read_frame_data(1, \%default);
1799                 my %words_data     = read_words_list(
1800                         0, # frame ID
1801                         1,  # header only
1802                 );
1803
1804                 $r = print_viewer_page(
1805                         $fh,
1806                         {
1807                                 'launch'         => 0,
1808                                 'frame'          => 0,
1809                                 'access'         => 1,
1810                                 'password_ok'    => 0,
1811                                 'timer_unlocked' => 3, # not relevant
1812                                 'timer'          => 0, # not relevant
1813                                 'static'         => 1,
1814                                 'show_command'   => 1,
1815                                 'text_mode'      => TEXT_MODE->{'normal'},
1816                                 'words_page'     => 0, # not relevant
1817                                 'goto'           => 0
1818                         },
1819                         $state,
1820                         $settings,
1821                         \%frame_data,
1822                         \%default, # prev
1823                         \%next_frame_data,
1824                         \%words_data
1825                 );
1826         }
1827         # no conditions met, pretend a normal Apache2 index
1828         elsif ($pass != 1) {
1829                 my $index_of = CGI_PATH;
1830                 $index_of =~ s/\/$//g;
1831
1832                 my $_index_of     = html_entity_encode_dec($index_of  , 1);
1833                 my $_2words_date  = html_entity_encode_dec(INTF_DATE(), 1);
1834                 my $_coin_date    = html_entity_encode_dec(COIN_DATE(), 1);
1835                 my $_website      = html_entity_encode_dec(WEBSITE()  , 1);
1836
1837                 print_html_start ($fh);
1838                 print $fh ' <head>'."\n";
1839                 print $fh '  <meta http-equiv="Content-type" content="text/html; charset=UTF-8">'."\n";
1840                 print $fh '  <title>Index of '.$_index_of.'</title>'."\n";
1841                 print $fh ' </head>'."\n";
1842                 print $fh ' <body>'."\n";
1843                 print $fh '  <h1>Index of '.$_index_of.'</h1>'."\n";
1844                 print $fh '  <table>'."\n";
1845                 print $fh '   <tr>'."\n";
1846                 print $fh '    <th><img src="/icons/blank.gif" alt="[ICO]"></th>'."\n";
1847                 print $fh '    <th><a href="?C=N;O=D">Name</a></th>'."\n";
1848                 print $fh '    <th><a href="?C=M;O=A">Last modified</a></th>'."\n";
1849                 print $fh '    <th><a href="?C=S;O=A">Size</a></th>'."\n";
1850                 print $fh '    <th><a href="?C=D;O=A">Description</a></th>'."\n";
1851                 print $fh '   </tr><tr>'."\n";
1852                 print $fh '    <th colspan="5"><hr></th>'."\n";
1853                 print $fh '   </tr><tr>'."\n";
1854                 print $fh '    <td valign="top"><img src="/icons/back.gif" alt="[DIR]"></td>'."\n";
1855                 print $fh '    <td><a href="/">Parent Directory</a></td>'."\n";
1856                 print $fh '    <td>&nbsp;</td>'."\n";
1857                 print $fh '    <td align="right">  - </td>'."\n";
1858                 print $fh '    <td>&nbsp;</td>'."\n";
1859                 print $fh '   </tr><tr>'."\n";
1860                 print $fh '    <td valign="top"><img src="/icons/folder.gif" alt="[DIR]"></td>'."\n";
1861                 print $fh '    <td><a href="2words/">2words/</a></td>'."\n";
1862                 print $fh '    <td align="right">'.$_2words_date.'  </td>'."\n";
1863                 print $fh '    <td align="right">  - </td><td>&nbsp;</td>'."\n";
1864                 print $fh '   </tr><tr>'."\n";
1865                 print $fh '    <td valign="top"><img src="/icons/folder.gif" alt="[DIR]"></td>'."\n";
1866                 print $fh '    <td><a href="coin/">coin/</a></td>'."\n";
1867                 print $fh '    <td align="right">'.$_coin_date.'  </td>'."\n";
1868                 print $fh '    <td align="right">  - </td><td> Coincidence </td>'."\n";
1869                 print $fh '   </tr><tr>'."\n";
1870                 print $fh '    <th colspan="5"><hr></th>'."\n";
1871                 print $fh '   </tr>'."\n";
1872                 print $fh '  </table>'."\n";
1873                 print $fh '  <address>Apache/2.2.22 (Debian) Server at '.$_website.' Port 80</address>'."\n";
1874                 print $fh '  </body>'."\n";
1875                 print_html_end ($fh);
1876         }
1877         # the launch index
1878         else {
1879                 my %default        = read_default();
1880                 my %frame_data     = read_frame_data(0, \%default);
1881                 my %next_frame_data= read_frame_data(1, \%default);
1882                 my %coin_data      = read_coincidence();
1883
1884                 if (($mode == INTF_STATE->{'>'}) && $pause) {
1885                         $r = print_viewer_page(
1886                                 $fh,
1887                                 {
1888                                         'launch'         => 1,
1889                                         'frame'          => 0,
1890                                         'access'         => 1,
1891                                         'password_ok'    => 0,
1892                                         'timer_unlocked' => 3,
1893                                         'timer'          => 0,
1894                                         'static'         => 1,
1895                                         'show_command'   => 1,
1896                                         'text_mode'      => TEXT_MODE->{'normal'},
1897                                         'words_page'     => 0, # not relevant
1898                                         'goto'           => 0
1899                                 },
1900                                 $state,
1901                                 $settings,
1902                                 \%frame_data,
1903                                 \%default, # prev
1904                                 \%next_frame_data,
1905                                 {'posts' => 0} # words_data
1906                         );
1907                         return $r;
1908                 }
1909
1910                 my $index_of = CGI_PATH;
1911                 $index_of =~ s/\/$//g;
1912                 my $title;
1913                 my $frame_file;
1914                 my $undertext = '';
1915                 my $show_parent_dir = 0;
1916                 my $show_yb = 0;
1917                 my $show_folders = 0;
1918                 my $timer = '';
1919                 my $timer_color = 'ni';
1920                 if ($mode == INTF_STATE->{'>'}) {
1921                         $title = $settings->{'story'}; # $frame_data{'title'} ?
1922                         $frame_file = 'intf-tr.gif';
1923                         $undertext = '...';
1924                         $timer = '--';
1925                 }
1926                 elsif ($mode == INTF_STATE->{'<<'}) {
1927                         $title = 'Index of';
1928                         $frame_file = 'intf-ll.gif';
1929                         $show_parent_dir = 1;
1930                         $show_yb = 1;
1931                         $timer = 'EE';
1932                         $timer_color = 'br';
1933                 }
1934                 elsif ($mode == INTF_STATE->{'>>'}) {
1935                         $title = 'Index of';
1936                         $frame_file = 'intf-pp.gif';
1937                         $show_parent_dir = 1;
1938                         $show_yb = 1;
1939                         $timer = 'EE';
1940                 }
1941                 else
1942                 {
1943                         $title = 'Index of '.$index_of;
1944                         $frame_file = 'intf-kw.gif';
1945                         $show_parent_dir = 1;
1946                         $show_folders = 1;
1947                 }
1948                 my $frame_url = merge_url(
1949                         {'path' => CGI_PATH()},
1950                         {'path' => $frame_file}
1951                 );
1952                 my $coin_server = $coin_data{'server'};
1953
1954                 my $_title        = html_entity_encode_dec($title           , 1);
1955                 my $_website_name = html_entity_encode_dec(WEBSITE_NAME()   , 1);
1956                 my $_frame_url    = html_entity_encode_dec($frame_url       , 1);
1957                 my $_undertext    = html_entity_encode_dec($undertext       , 1);
1958                 my $_2words_date  = html_entity_encode_dec(INTF_DATE()      , 1);
1959                 my $_coin_date    = html_entity_encode_dec(COIN_DATE()      , 1);
1960                 my $_coin_server  = html_entity_encode_dec($coin_server     , 1);
1961                 my $_2words_url   = html_entity_encode_dec(CGI_2WORDS_PATH(), 1);
1962                 my $_coin_url     = html_entity_encode_dec(CGI_COIN_PATH()  , 1);
1963
1964                 print_html_start($fh);
1965                 print_html_head_start($fh);
1966
1967                 print $fh '  <title>'.$_title.' &bull; '.$_website_name.'</title>'."\n";
1968
1969                 print_html_head_end($fh);
1970                 print_html_body_start($fh);
1971
1972                 print $fh '   <div id="inst" class="ins">'."\n";
1973
1974                 print $fh '    <div id="title">'."\n";
1975                 print $fh '     <h1 id="titletext">'.$_title.'</h1>'."\n";
1976                 print $fh '    </div>'."\n";
1977
1978                 print $fh '   </div>'."\n";
1979                 print $fh '   <div id="framespace">'."\n";
1980
1981                 print $fh '    <img src="'.$_frame_url.'" id="frame" alt="0">'."\n"; # title="'.$_title.'"
1982
1983                 print $fh '   </div>'."\n";
1984                 print $fh '   <div id="insb" class="ins">'."\n";
1985
1986                 print $fh '    <div id="undertext">'."\n";
1987
1988                 if ($show_parent_dir) {
1989                         print $fh '     <img src="/icons/back.gif" alt="[DIR]"> <a href="..">Parent Directory</a><br>'."\n";
1990                 }
1991                 if ($show_folders) {
1992                         print $fh '     <img src="/icons/folder.gif" alt="[DIR]"> <a href="'.$_2words_url.'">2words/</a> '.$_2words_date.' - <br>'."\n";
1993                         print $fh '     <img src="/icons/folder.gif" alt="[DIR]"> <a href="'.$_coin_url.'">coin/</a> '.$_coin_date.' - '.$_coin_server."\n";
1994                 }
1995                 elsif ($show_yb) {
1996                         print $fh '     <img src="/icons/folder.gif" alt="[DIR]"> <a href="'.$_2words_url.'">yyyyb/</a>'."\n";
1997                 }
1998                 if ($undertext ne '') {
1999                         print $fh '     '.$_undertext."\n";
2000                 }
2001
2002                 print $fh '    </div>'."\n";
2003
2004                 if ($timer ne '') {
2005                         print $fh '    <div id="command">'."\n";
2006
2007                         print $fh '     [<span id="ongh" class="'.$timer_color.'">'.$timer.'</span>';
2008                         print $fh      ':<span id="ongm" class="'.$timer_color.'">'.$timer.'</span>';
2009                         print $fh      ':<span id="ongs" class="'.$timer_color.'">'.$timer.'</span>]<br>'."\n";
2010
2011                         if ($undertext ne '') {
2012                                 print $fh '&gt;<a href="'.$_2words_url.'">'.$_undertext.'</a><span class="inp">_</span>'."\n";
2013                         }
2014                         print $fh "    </div>\n";
2015                 }
2016
2017                 print $fh "   </div>\n";
2018
2019                 print_html_body_end($fh, $ong_state == STATE->{'inactive'});
2020                 print_html_end($fh);
2021         }
2022         close ($fh);
2023         return $r
2024 }
2025
2026 sub write_static_viewer_page {
2027         (
2028                 my $frame,
2029                 my $state_ref,
2030                 my $settings_ref,
2031                 my $default_ref,
2032                 my $frame_data_ref,
2033                 my $prev_frame_data_ref,
2034                 my $next_frame_data_ref,
2035                 my $words_data_ref
2036         ) = @_;
2037
2038         my %state;
2039         my %settings;
2040         my %default;
2041         my %frame_data;
2042         my %prev_frame_data;
2043         my %next_frame_data;
2044         my %words_data;
2045
2046         my $file;
2047
2048         $frame = int($frame);
2049         my $prev_frame = $frame -1;
2050         my $next_frame = $frame +1;
2051
2052         %state = (ref ($state_ref)) ?
2053                 %$state_ref :
2054                 read_state();
2055         my $ong_state = int($state{'state'});
2056         my $last_frame = int($state{'last'});
2057
2058         unless ($ong_state > STATE->{'inactive'}) {
2059                 return 0;
2060         }
2061         unless (
2062                 ($frame >= 0) && (
2063                         ($frame < $last_frame) || (
2064                                 ($frame <= $last_frame) &&
2065                                 ($ong_state >= STATE->{'end'})
2066                         )
2067                 )
2068         ) {
2069                 return 0;
2070         }
2071
2072         %settings = (ref ($settings_ref)) ?
2073                 %$settings_ref :
2074                 read_settings();
2075         %default = (ref ($default_ref)) ?
2076                 %$default_ref :
2077                 read_default();
2078
2079         %frame_data = (ref ($frame_data_ref)) ?
2080                 %$frame_data_ref :
2081                 read_frame_data($frame);
2082
2083         %prev_frame_data = (ref ($prev_frame_data_ref)) ?
2084                 %$prev_frame_data_ref : (
2085                         ($prev_frame >= 0) ?
2086                         read_frame_data($prev_frame) :
2087                         %default
2088                 );
2089
2090         %next_frame_data = (ref ($next_frame_data_ref)) ?
2091                 %$next_frame_data_ref :
2092                 read_frame_data($next_frame);
2093
2094         %words_data = (ref ($words_data_ref)) ?
2095                 %$words_data_ref :
2096                 read_words_list(
2097                         $frame, # frame ID
2098                         1,  # header only
2099                 );
2100
2101         %frame_data      = merge_settings(\%default, \%frame_data);
2102         %prev_frame_data = merge_settings(\%default, \%prev_frame_data);
2103         %next_frame_data = merge_settings(\%default, \%next_frame_data);
2104
2105         $file = get_page_file($frame, \%frame_data, \%settings);
2106         $file = join_path(PATH_SEPARATOR(), WWW_PATH(), $file);
2107
2108         return print_viewer_page(
2109                 $file,
2110                 {
2111                         'launch'        => 0,
2112                         'frame'         => $frame,
2113                         'access'        => 1,
2114                         'password_ok'   => 0,
2115                         'timer_unlocked'=> 3, # not relevant
2116                         'timer'         => 0, # not relevant
2117                         'static'        => 1,
2118                         'show_command'  => 1,
2119                         'text_mode'     => TEXT_MODE->{'normal'},
2120                         'words_page'    => 0, # not relevant
2121                         'goto'          => 0
2122                 },
2123                 \%state,
2124                 \%settings,
2125                 \%frame_data,
2126                 \%prev_frame_data,
2127                 \%next_frame_data,
2128                 \%words_data
2129         );
2130 }
2131
2132 sub write_static_goto {
2133         (my $state_ref, my $settings_ref, my $goto_ref) = @_;
2134         my %state;
2135         my %settings;
2136         my %goto_list;
2137
2138         %state = (ref ($state_ref)) ?
2139                 %$state_ref :
2140                 read_state();
2141         %settings = (ref ($settings_ref)) ?
2142                 %$settings_ref :
2143                 read_settings();
2144         %goto_list = (ref ($goto_ref)) ?
2145                 %$goto_ref :
2146                 read_goto();
2147
2148         return print_goto(
2149                 WWW_GOTO_PATH(),
2150                 \%state,
2151                 \%settings,
2152                 \%goto_list,
2153                 0, # password OK
2154         );
2155 }
2156
2157 # ONG the frame + attachment & stuff. NOT update state file.
2158 sub ong {
2159         (
2160                 my $ID, my $ongtime, my $timer, my $update, my $print,
2161                 my $settings_ref, my $default_ref, my $data_ref, my $goto_ref
2162         ) = @_;
2163         my @files;
2164         my $cfrt;
2165         my $intf;
2166         my $frame;
2167         my $frame_data_path;
2168         my $write_data;
2169         my $in_path;
2170         my $out_path;
2171         my $r;
2172         my %settings;
2173         my %default;
2174         my %frame_data;
2175         my %frame_full_data;
2176         my %goto_list;
2177
2178         if ($ongtime eq '') {
2179                 $ongtime = time();
2180         }
2181
2182         if ($ID eq 'i') {
2183                 $intf = 1;
2184         }
2185         elsif ($ID eq 'c') {
2186                 $cfrt = 1;
2187         }
2188         else {
2189                 $frame = int($ID);
2190         }
2191
2192         if ($intf) {
2193                 @files = (
2194                         'intf-00.gif',
2195                         'intf-00_04.gif',
2196                         'intf-00_08.gif',
2197                         'intf-00_10.gif',
2198                         'intf-01.gif',
2199                         'intf-01_.gif',
2200                         'intf-02.gif',
2201                         'intf-02_.gif',
2202                         'intf-04.gif',
2203                         'intf-04_.gif',
2204                         'intf-08.gif',
2205                         'intf-08_.gif',
2206                         'intf-10.gif',
2207                         'intf-10_.gif',
2208                         'intf-20.gif',
2209                         'intf-20_.gif',
2210                         'intf-kw.gif',
2211                         'intf-ll.gif',
2212                         'intf-pp.gif',
2213                         'intf-tr.gif',
2214                 );
2215         }
2216         else {
2217                 %settings = (ref ($settings_ref)) ?
2218                         %$settings_ref :
2219                         read_settings();
2220                 %default = (ref ($default_ref)) ? %$default_ref : read_default();
2221                 $frame_data_path = $cfrt ?
2222                         DATA_NOACCESS_PATH() :
2223                         join_path(PATH_SEPARATOR(), DATA_PATH(), $frame);
2224                 %frame_data = (ref ($data_ref)) ?
2225                         %$data_ref :
2226                         read_frame_data($frame_data_path);
2227                 %frame_full_data = merge_settings(\%default, \%frame_data);
2228                 @files = (get_frame_file($frame, \%frame_full_data, \%settings), );
2229                 unless ($cfrt) {
2230                         %goto_list = (ref ($goto_ref)) ?
2231                                 %$goto_ref :
2232                                 read_goto();
2233                         for (my $i=0; ;$i+=1) {
2234                                 my %file_data = read_attachment($i);
2235                                 if ($file_data{'frame'} eq '') {
2236                                         last;
2237                                 }
2238                                 if (int($file_data{'frame'}) != $frame) {
2239                                         next;
2240                                 }
2241                                 if ($file_data{'content'} ne '') {
2242                                         next;
2243                                 }
2244                                 unshift @files, $file_data{'filename'};
2245                         }
2246                         if (
2247                                 (!$update) ||
2248                                 ($frame_full_data{'ongtime'} eq '')
2249                         ) {
2250                                 $frame_data     {'ongtime'} = $ongtime;
2251                                 $frame_full_data{'ongtime'} = $ongtime;
2252                                 $write_data = 1;
2253                         }
2254                         if (
2255                                 ($timer ne '') && (
2256                                         (!$update) ||
2257                                         ($frame_full_data{'timer'} eq '')
2258                                 )
2259                         ) {
2260                                 $frame_data{'timer'} = int($timer);
2261                                 $write_data = 1;
2262                         }
2263                         if ($write_data) {
2264                                 $r = write_frame_data($frame_data_path, \%frame_data);
2265                                 unless ($r) {
2266                                         print STDERR "fail writing $frame_data_path\n";
2267                                         if ($print) {
2268                                                 print "write frame data fail\n";
2269                                         }
2270                                         return $r;
2271                                 }
2272                         }
2273                         $goto_list{'title-'  .$frame} = $frame_full_data{'title'};
2274                         $goto_list{'ongtime-'.$frame} = $frame_full_data{'ongtime'};
2275                         $r = write_goto('', \%goto_list);
2276                         unless ($r) {
2277                                 print STDERR "fail writing ".DATA_LIST_PATH()."\n";
2278                                 if ($print) {
2279                                         print "write GOTO list fail\n";
2280                                 }
2281                                 return $r;
2282                         }
2283                 }
2284         }
2285         foreach my $file (@files) {
2286                 $in_path  = join_path(PATH_SEPARATOR(), DATA_PATH(), $file);
2287                 $out_path = join_path(PATH_SEPARATOR(), WWW_PATH() , $file);
2288                 if ($print) {
2289                         print $in_path.' -> '.$out_path;
2290                 }
2291                 $r = copy_encoded($in_path, $out_path);
2292                 if ($print) {
2293                         print (($r) ? " OK\n" : " FAIL\n");
2294                 }
2295                 unless ($r) {
2296                         print STDERR "fail copy $in_path $out_path\n";
2297                         return $r
2298                 }
2299         }
2300
2301         return 1;
2302 }
2303
2304
2305 sub get_frame_file {
2306         (my $frame, my $frame_data, my $settings) = @_;
2307         my $file;
2308         my $pattern;
2309
2310         if ($frame_data->{'frame'} ne '') {
2311                 $file = $frame_data->{'frame'};
2312         }
2313         else {
2314                 $pattern = validate_filename($settings->{'frame'}, '%d.%ext');
2315                 $file = sprintf(
2316                         $pattern,
2317                         int($frame), $frame_data->{'ext'}
2318                 );
2319         }
2320         return validate_filename($file);
2321 }
2322
2323 sub get_page_file {
2324         (my $frame, my $frame_data, my $settings) = @_;
2325         my $file;
2326         my $pattern;
2327
2328         if ($frame == 0) {
2329                 return 'index.htm';
2330         }
2331         if ($frame_data->{'page'} ne '') {
2332                 $file = $frame_data->{'page'};
2333         }
2334         else {
2335                 $pattern = validate_filename($settings->{'frame'}, '%d.%ext');
2336                 $file = sprintf(
2337                         $pattern,
2338                         int($frame), 'htm'
2339                 );
2340         }
2341         return validate_filename($file);
2342 }
2343
2344 sub validate_filename {
2345         (my $filename, my $fallback) = @_;
2346         if ($fallback eq '') {
2347                 $fallback = '';
2348         }
2349
2350         # TODO: more checks
2351
2352         if ($filename =~ /^\./) {
2353                 return $fallback;
2354         }
2355         if (index($filename, PATH_SEPARATOR()) >= 0) {
2356                 return $fallback;
2357         }
2358         return $filename;
2359 }
2360
2361 sub validate_frame_data {
2362         (my $data_in) = @_;
2363         my %data = %$data_in;
2364
2365         if ($data{'ongtime'} ne '') {
2366                 $data{'ongtime'} = int($data{'ongtime'});
2367         }
2368         if ($data{'timer'} ne '') {
2369                 $data{'timer'} = int($data{'timer'});
2370         }
2371         if ($data{'width'} ne '') {
2372                 $data{'width'} = int($data{'width'});
2373         }
2374         if ($data{'height'} ne '') {
2375                 $data{'height'} = int($data{'height'});
2376         }
2377         if ($data{'page'} ne '') {
2378                 $data{'page'} = validate_filename($data{'page'});
2379         }
2380         if ($data{'frame'} ne '') {
2381                 $data{'frame'} = validate_filename($data{'frame'});
2382         }
2383
2384         return %data;
2385 }
2386
2387 sub validate_settings {
2388         (my $data_in) = @_;
2389         my %data = %$data_in;
2390
2391         if ($data{'ongtime'} ne '') {
2392                 $data{'ongtime'} = int($data{'ongtime'});
2393         }
2394         if ($data{'dynamicongtime'} ne '') {
2395                 $data{'dynamicongtime'} = int($data{'dynamicongtime'});
2396         }
2397         if ($data{'firstongtime'} ne '') {
2398                 $data{'firstongtime'} = int($data{'firstongtime'});
2399         }
2400         if ($data{'last'} ne '') {
2401                 $data{'last'} = int($data{'last'});
2402         }
2403         $data{'frame'} = validate_filename($data{'frame'}, '%d.%s');
2404
2405         return %data;
2406 }
2407
2408 sub validate_state {
2409         (my $data_in) = @_;
2410         my %data = %$data_in;
2411
2412         if ($data{'state'} ne '') {
2413                 $data{'state'} = int($data{'state'});
2414         }
2415         if ($data{'last'} ne '') {
2416                 $data{'last'} = int($data{'last'});
2417         }
2418         if ($data{'nextong'} ne '') {
2419                 $data{'nextong'} = int($data{'nextong'});
2420         }
2421
2422         return %data;
2423 }
2424
2425 sub validate_words_list {
2426         (my $data_in, my $not_list) = @_;
2427         my %data = %$data_in;
2428
2429         if ($data{'ongtime'} ne '') {
2430                 $data{'ongtime'} = int($data{'ongtime'});
2431         }
2432
2433         if ($not_list) {
2434                 my $id_list = '';
2435                 foreach my $ID (split(/\r?\n/, $data{'content'})) {
2436                         $ID = validate_filename($ID);
2437                         if ($ID ne '') {
2438                                 $id_list .= $ID."\n";
2439                         }
2440                 }
2441                 $data{'content'} = $id_list;
2442         }
2443         else {
2444                 my @id_list;
2445                 foreach my $ID (@{$data{'content'}}) {
2446
2447                         $ID = validate_filename($ID);
2448                         if ($ID ne '') {
2449                                 push @id_list, $ID;
2450                         }
2451                 }
2452                 $data{'content'} = [@id_list];
2453         }
2454
2455         return %data;
2456 }
2457
2458 sub validate_words {
2459         (my $data_in) = @_;
2460         my %data = %$data_in;
2461
2462         if ($data{'posttime'} ne '') {
2463                 $data{'posttime'} = int($data{'posttime'});
2464         }
2465         if ($data{'edittime'} ne '') {
2466                 $data{'edittime'} = int($data{'edittime'});
2467         }
2468
2469         return %data;
2470 }
2471
2472 sub validate_story {
2473         (my $data_in) = @_;
2474         my %data = %$data_in;
2475
2476         if ($data{'id'} ne '') {
2477                 $data{'id'} = int($data{'id'});
2478         }
2479         if ($data{'pass'} ne '') {
2480                 $data{'pass'} = int($data{'pass'});
2481         }
2482         if ($data{'state'} ne '') {
2483                 $data{'state'} = int($data{'state'});
2484         }
2485
2486         return %data;
2487 }
2488
2489 sub validate_goto {
2490         (my $data_in) = @_;
2491         my %data = %$data_in;
2492
2493         foreach my $key (keys %data) {
2494                 if ($key =~ /^ongtime-([0-9]+)$/) {
2495                         my $new_key = 'ongtime-'.int($1);
2496                         $data{$new_key} = int($data{$key});
2497                         if ($new_key != $key) {
2498                                 delete $data{$key};
2499                         }
2500                 }
2501         }
2502
2503         return %data;
2504 }
2505
2506 sub validate_attachment {
2507         (my $data_in) = @_;
2508         my %data = %$data_in;
2509
2510         if ($data{'frame'} ne '') {
2511                 $data{'frame'} = int($data{'frame'});
2512         }
2513         $data{'filename'} = validate_filename($data{'filename'});
2514
2515         return %data;
2516 }
2517
2518 sub validate_coincidence {
2519         (my $data_in) = @_;
2520         my %data = %$data_in;
2521
2522         if ($data{'server'} ne '') {
2523                 $data{'server'} = int($data{'server'});
2524         }
2525
2526         return %data;
2527 }
2528
2529 sub read_frame_data {
2530         (my $f, my $default) = @_;
2531         my $file;
2532         my %data;
2533
2534         if (ref ($f)) { # already open file
2535                 $file = $f;
2536         }
2537         elsif ($f =~ /^[0-9]+$/) { # frame ID
2538                 $file = join_path(PATH_SEPARATOR(), DATA_PATH(), int($&));
2539         }
2540         elsif ($f =~ /^(c(frt)?)|(noaccess)$/) { # CFRT (no access)
2541                 $file = DATA_NOACCESS_PATH();
2542         }
2543         elsif ($f =~ /^d(efault)?$/) { # default
2544                 $file = DATA_DEFAULT_PATH();
2545         }
2546         elsif ($f ne '') { # path
2547                 $file = $f;
2548         }
2549         else {
2550                 $file = DATA_DEFAULT_PATH();
2551         }
2552
2553         %data = read_data_file($file);
2554         if (ref ($default)) {
2555                 %data = merge_settings($default, \%data);
2556         }
2557         elsif ($default ne '') {
2558                 my %default_data = read_data_file(DATA_DEFAULT_PATH());
2559                 %data = merge_settings(\%default_data, \%data);
2560         }
2561
2562         return validate_frame_data(\%data);
2563 }
2564
2565 sub write_frame_data {
2566         (my $f, my $data) = @_;
2567         my $file;
2568
2569         if (ref ($f)) { # already open file
2570                 $file = $f;
2571         }
2572         elsif ($f =~ /^[0-9]+$/) { # frame ID
2573                 $file = join_path(PATH_SEPARATOR(), DATA_PATH(), int($&));
2574         }
2575         elsif ($f =~ /^(c(frt)?)|(noaccess)$/) { # CFRT (no access)
2576                 return 0; # forbidden
2577         }
2578         elsif ($f =~ /^d(efault)?$/) { # default
2579                 return 0; # forbidden
2580         }
2581         elsif ($f ne '') { # path
2582                 $file = $f;
2583         }
2584         else {
2585                 return 0; # forbidden
2586         }
2587
2588         my %_data = validate_frame_data($data);
2589
2590         return write_data_file($file, \%_data);
2591 }
2592
2593 sub read_default {
2594         return read_frame_data('default');
2595 }
2596
2597 sub read_noaccess {
2598         (my $default) = @_;
2599         return read_frame_data('noaccess', $default);
2600 }
2601
2602 sub read_settings {
2603         (my $f) = @_;
2604         my $file;
2605         my %data;
2606
2607         if (ref ($f)) { # already open file
2608                 $file = $f;
2609         }
2610         elsif ($f ne '') { # path
2611                 $file = $f;
2612         }
2613         else {
2614                 $file = DATA_SETTINGS_PATH();
2615         }
2616
2617         %data = read_data_file($file);
2618
2619         return validate_settings(\%data);
2620 }
2621
2622 sub read_state {
2623         (my $f) = @_;
2624         my $file;
2625         my %data;
2626
2627         if (ref ($f)) { # already open file
2628                 $file = $f;
2629         }
2630         elsif ($f ne '') { # path
2631                 $file = $f;
2632         }
2633         else {
2634                 $file = DATA_STATE_PATH();
2635         }
2636
2637         %data = read_data_file($file);
2638
2639         return validate_state(\%data);
2640 }
2641
2642 sub write_state {
2643         (my $f, my $data) = @_;
2644         my $file;
2645
2646         if (ref ($f)) { # already open file
2647                 $file = $f;
2648         }
2649         elsif ($f ne '') { # path
2650                 $file = $f;
2651         }
2652         else {
2653                 $file = PERL_DATA_STATE_PATH();
2654         }
2655
2656         my %_data = validate_state($data);
2657
2658         return write_data_file($file, \%_data);
2659 }
2660
2661 sub read_words_list {
2662         (my $f, my $header_only, my $not_list) = @_;
2663         my $file;
2664         my %data;
2665
2666         if (ref ($f)) { # already open file
2667                 $file = $f;
2668         }
2669         elsif ($f =~ /^[0-9]+$/) { # frame ID
2670                 $file = join_path(PATH_SEPARATOR(), DATA_WORDS_PATH(), int($&));
2671         }
2672         elsif ($f ne '') { # path
2673                 $file = $f;
2674         }
2675         else { # which frame ???
2676                 return ('posts' => 0);
2677         }
2678
2679         %data = read_data_file(
2680                 $file,
2681                 '', # encoding
2682                 0,  # no header
2683                 $header_only,
2684                 not $not_list # as list
2685         );
2686
2687         return validate_words_list(\%data, $not_list);
2688 }
2689
2690 sub write_words_list {
2691         (my $f, my $data) = @_;
2692         my $file;
2693
2694         if (ref ($f)) { # already open file
2695                 $file = $f;
2696         }
2697         elsif ($f =~ /^[0-9]+$/) { # frame ID
2698                 $file = join_path(PATH_SEPARATOR(), DATA_WORDS_PATH(), int($&));
2699         }
2700         elsif ($f ne '') { # path
2701                 $file = $f;
2702         }
2703         else { # which frame ???
2704                 return 0;
2705         }
2706
2707         my %_data = validate_words_list($data);
2708
2709         return write_data_file(
2710                 $file, # file
2711                 \%_data,
2712                 '',  # encoding
2713                 0,   # no header
2714                 0,   # header only
2715                 1    # as list
2716         );
2717 }
2718
2719 sub read_words {
2720         (my $f, my $default) = @_;
2721         my $file;
2722         my %data;
2723
2724         if (ref ($f)) { # already open file
2725                 $file = $f;
2726         }
2727         elsif ($f =~ /^[0-9]+\.[0-9\.]+$/) { # post ID
2728                 $file = join_path(PATH_SEPARATOR(), DATA_WORDS_PATH(), $&);
2729         }
2730         elsif ($f ne '') { # path
2731                 $file = $f;
2732         }
2733         else { # which post ???
2734                 return ();
2735         }
2736
2737         %data = read_data_file($file);
2738
2739         return validate_words(\%data);
2740 }
2741
2742 sub write_words {
2743         (my $f, my $data) = @_;
2744         my $file;
2745
2746         if (ref ($f)) { # already open file
2747                 $file = $f;
2748         }
2749         elsif ($f =~ /^[0-9\.]+$/) { # post ID
2750                 $file = join_path(PATH_SEPARATOR(), DATA_WORDS_PATH(), $&);
2751         }
2752         elsif ($f ne '') { # path
2753                 $file = $f;
2754         }
2755         else { # which post ???
2756                 return 0;
2757         }
2758
2759         my %_data = validate_words($data);
2760
2761         return write_data_file($file, \%_data);
2762 }
2763
2764 sub read_story {
2765         (my $f) = @_;
2766         my $file;
2767         my %data;
2768
2769         if (ref ($f)) { # already open file
2770                 $file = $f;
2771         }
2772         elsif ($f =~ /^[0-9]+$/) { # story ID
2773                 $file = DATA_STORY_PATH().int($&);
2774         }
2775         elsif ($f ne '') { # path
2776                 $file = $f;
2777         }
2778         else {
2779                 $file = DATA_STORY_PATH();
2780         }
2781
2782         %data = read_data_file($file);
2783
2784         return validate_story(\%data);
2785 }
2786
2787 sub write_story {
2788         (my $f, my $data) = @_;
2789         my $file;
2790
2791         if (ref ($f)) { # already open file
2792                 $file = $f;
2793         }
2794         elsif ($f =~ /^[0-9]+$/) { # story ID
2795                 $file = DATA_STORY_PATH().int($&);
2796         }
2797         elsif ($f ne '') { # path
2798                 $file = $f;
2799         }
2800         else {
2801                 $file = DATA_STORY_PATH();
2802         }
2803
2804         my %_data = validate_story($data);
2805
2806         return write_data_file($file, \%_data);
2807 }
2808
2809 sub read_goto {
2810         (my $f) = @_;
2811         my $file;
2812         my %data;
2813
2814         if (ref ($f)) { # already open file
2815                 $file = $f;
2816         }
2817         elsif ($f ne '') { # path
2818                 $file = $f;
2819         }
2820         else {
2821                 $file = DATA_LIST_PATH();
2822         }
2823
2824         %data = read_data_file($file);
2825
2826         return validate_goto(\%data);
2827 }
2828
2829 sub write_goto {
2830         (my $f, my $data) = @_;
2831         my $file;
2832
2833         if (ref ($f)) { # already open file
2834                 $file = $f;
2835         }
2836         elsif ($f ne '') { # path
2837                 $file = $f;
2838         }
2839         else {
2840                 $file = DATA_LIST_PATH();
2841         }
2842
2843         my %_data = validate_goto($data);
2844
2845         return write_data_file($file, \%_data);
2846 }
2847
2848 sub read_attachment {
2849         (my $f, my $default) = @_;
2850         my $file;
2851         my %data;
2852
2853         if (ref ($f)) { # already open file
2854                 $file = $f;
2855         }
2856         elsif ($f =~ /^[0-9]+$/) { # attachment ID
2857                 $file = DATA_ATTACH_PATH().int($&);
2858         }
2859         elsif ($f ne '') { # path
2860                 $file = $f;
2861         }
2862         else {
2863                 return ();
2864         }
2865
2866         %data = read_data_file($file);
2867
2868         return validate_attachment(\%data);
2869 }
2870
2871 sub read_coincidence {
2872         (my $f) = @_;
2873         my $file;
2874         my %data;
2875
2876         if (ref ($f)) { # already open file
2877                 $file = $f;
2878         }
2879         elsif ($f ne '') { # path
2880                 $file = $f;
2881         }
2882         else {
2883                 $file = DATA_COIN_PATH();
2884         }
2885
2886         %data = read_data_file($file);
2887
2888         return validate_coincidence(\%data);
2889 }
2890
2891 sub read_chat {
2892         (my $f) = @_;
2893         my $file;
2894         my %data;
2895
2896         if (ref ($f)) { # already open file
2897                 $file = $f;
2898         }
2899         elsif ($f =~ /^[0-9]+$/) { # chat ID
2900                 $file = DATA_CHAT_PATH().int($&);
2901         }
2902         elsif ($f ne '') { # path
2903                 $file = $f;
2904         }
2905         else {
2906                 $file = DATA_CHAT_PATH();
2907         }
2908
2909         return read_data_file($file);
2910
2911         # no validation
2912 }
2913
2914 sub write_chat {
2915         (my $f, my $data) = @_;
2916         my $file;
2917
2918         if (ref ($f)) { # already open file
2919                 $file = $f;
2920         }
2921         elsif ($f =~ /^[0-9]+$/) { # chat ID
2922                 $file = DATA_CHAT_PATH().int($&);
2923         }
2924         elsif ($f ne '') { # path
2925                 $file = $f;
2926         }
2927         else {
2928                 $file = DATA_CHAT_PATH();
2929         }
2930
2931         # no validation
2932
2933         return write_data_file($file, $data);
2934 }
2935
2936
2937 1