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