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