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