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',
  49         'write_index',
  50         'ong',
  51
  52         'readdatafile', 'writedatafile', 'printdatafile', # TO REMOVE
  53         'entityencode', # TO REMOVE
  54         'printdatafileht', # TO REMOVE ???
  55         'gethttpheader', 'getcgi', # TO REMOVE
  56         'urldecode', # TO REMOVE
  57         'urlencode', # TO REMOVE
  58         'linehtml', # TO REMOVE
  59         'bb2ht', 'bb2bb' # TO REMOVE
  60 );
  61
  62 ###PERL_LIB: use lib /botm/lib/bsta
  63 use botm_common (
  64         'url_query_decode', 'url_query_encode',
  65         'url_decode', 'url_encode',
  66         'html_entity_encode_dec',
  67         'merge_url',
  68         'read_header_env',
  69         'read_data_file', 'write_data_file',
  70         'join_path'
  71 );
  72 use File::Copy;
  73
  74 ###PERL_PATH_SEPARATOR:     PATH_SEPARATOR     = /
  75
  76 ###PERL_CGI_PATH:           CGI_PATH           = /bsta/
  77 ###PERL_CGI_2WORDS_PATH:    CGI_2WORDS_PATH    = /bsta/2words
  78 ###PERL_CGI_BBCODE_PATH:    CGI_BBCODE_PATH    = /bsta/b
  79 ###PERL_CGI_COIN_PATH:      CGI_COIN_PATH      = /bsta/coin
  80 ###PERL_CGI_CSS_PATH:       CGI_CSS_PATH       = /bsta/bsta.css
  81 ###PERL_CGI_FRAME_PATH:     CGI_FRAME_PATH     = /bsta/f
  82 ###PERL_CGI_GOTO_PATH:      CGI_GOTO_PATH      = /bsta/g
  83 ###PERL_CGI_INFO_PATH:      CGI_INFO_PATH      = /bsta/i
  84 ###PERL_CGI_LOGO_PATH:      CGI_LOGO_PATH      = /bsta/botmlogo.png
  85 ###PERL_CGI_TIMER_PATH:     CGI_TIMER_PATH     = /bsta/timer.js
  86 ###PERL_CGI_VIEWER_PATH:    CGI_VIEWER_PATH    = /bsta/v
  87
  88 ###PERL_DATA_PATH:          DATA_PATH          = /botm/data/bsta/
  89 ###PERL_DATA_ATTACH_PATH:   DATA_ATTACH_PATH   = /botm/data/bsta/a
  90 ###PERL_DATA_COIN_PATH:     DATA_COIN_PATH     = /botm/data/bsta/coincidence
  91 ###PERL_DATA_DEFAULT_PATH:  DATA_DEFAULT_PATH  = /botm/data/bsta/default
  92 ###PERL_DATA_LIST_PATH:     DATA_LIST_PATH     = /botm/data/bsta/list
  93 ###PERL_DATA_NOACCESS_PATH: DATA_NOACCESS_PATH = /botm/data/bsta/noaccess
  94
  95 ###PERL_WWW_PATH:           WWW_PATH           = /botm/www/
  96 ###PERL_WWW_INDEX_PATH:     WWW_INDEX_PATH     = /botm/www/1190/bsta/index.htm
  97
  98 ###PERL_SCHEME:             SCHEME             = http
  99 ###PERL_WEBSITE:            WEBSITE            = 1190.bicyclesonthemoon.info
 100 ###PERL_WEBSITE_NAME:       WEBSITE_NAME       = Bicycles on the Moon
 101 ###PERL_FAVICON_PATH:       FAVICON_PATH       = /img/favicon.png
 102
 103 ###PERL_COIN_DATE:          COIN_DATE          = 13-Nov-2016 22:15
 104 ###PERL_INTF_DATE:          INTF_DATE          = 28-Sep-2016 20:34
 105
 106 use constant STATE => {
 107         'inactive' => 0,
 108         'waiting'  => 1,
 109         'ready'    => 2,
 110         'end'      => 3,
 111 };
 112 use constant INTF_STATE => {
 113         'X'  => 0b000000,
 114         'x'  => 0b000000,
 115         '||' => 0b000001,
 116         '>>' => 0b000100,
 117         '>>|'=> 0b000101,
 118         '<<' => 0b001000,
 119         '|<<'=> 0b001001,
 120         '>'  => 0b010000,
 121         '>|' => 0b010001,
 122         'mask'=>0b111111,
 123         'mode'=>0b111110,
 124 };
 125 use constant TEXT_MODE => {
 126         'normal' => 0,
 127         'bb'     => 1,
 128         'info'   => 2,
 129 };
 130 use constant CHAT_STATE => {
 131         'disconnected' => 0,
 132         'ready'        => 1,
 133         'active'       => 2,
 134 };
 135 use constant CHAT_ACTION => {
 136         'none'   => 0,
 137         'join'   => 1,
 138         'leave'  => 2,
 139         'nopost' => 3,
 140         'file'   => 4,
 141 };
 142
 143 use constant tags_bbcode => {
 144         'ht'    => '',
 145         '/ht'   => '',
 146         'fq'    => '[quote]',
 147         '/fq'   => '[/quote]',
 148         'tq'    => '[quote]',
 149         '/tq'   => '[/quote]',
 150         'ni'    => '[color=#0057AF]',
 151         '/ni'   => '[/color]',
 152         'br'    => '[color=#BB6622]',
 153         '/br'   => '[/color]',
 154         'po'    => '[color=#FF8800]',
 155         '/po'   => '[/color]',
 156         'url'   => '[url]',
 157         'url='  => '[url=',
 158         'url/=' => ']',
 159         '/url'  => '[/url]',
 160         'i'     => '[i]',
 161         '/i'    => '[/i]',
 162         'list'  => '[list]',
 163         'list=' => '[list=',
 164         'list/='=> ']',
 165         '/list' => '[/list]',
 166         '*'     => '[*]',
 167         '/*'    => '[/*]',
 168         '?'     => '[unknown!]',
 169         '/?'    => '[/unknown!]',
 170 };
 171 use constant tags_html => {
 172         'ht'     => '',
 173         '/ht'    => '',
 174         'fq'     => '<div class="fq">',
 175         '/fq'    => '</div>',
 176         'tq'     => '<div class="tq">',
 177         '/tq'    => '</div>',
 178         'ni'     => '<span class="ni">',
 179         '/ni'    => '</span>',
 180         'br'     => '<span class="br">',
 181         '/br'    => '</span>',
 182         'po'     => '<span class="po">',
 183         '/po'    => '</span>',
 184         'url'    => '<a href="#">',#think: how to add selfincluding?
 185         'url='   => '<a href="',
 186         'url/='  => '">',
 187         '/url'   => '</a>',
 188         'i'      => '<i>',
 189         '/i'     => '</i>',
 190         'list'   => '<ul>',
 191         'list='  => '<ol style="list-style-type: ',
 192         'list=1' => 'decimal',
 193         'list=A' => 'upper-alpha',
 194         'list=a' => 'lower-alpha',
 195         'list=I' => 'upper-roman',
 196         'list=i' => 'lower-roman',
 197         'list/=' => '">',
 198         '/list'  => '</ul>',
 199         '/list=' => '</ol>',
 200         '*'      => '<li>',
 201         '/*'     => '</li>',
 202         '?'      => '[unknown!]',
 203         '/?'     => '[/unknown!]',
 204 };
 205
 206
 207 # Function to return an error page
 208 # arguments: 1 - header fields, 2 - page title, 3 - error message, 4 method
 209 sub failpage {
 210         (my $header, my $title, my $message, my $method, my $hyperlink) = @_;
 211         if($header ne ''){
 212                 print $header;
 213         }
 214         if($method eq 'HEAD') {
 215                 print "\n";
 216                 return;
 217         }
 218         my $_title     = html_entity_encode_dec($title    , 1);
 219         my $_message   = html_entity_encode_dec($message  , 1);
 220         my $_hyperlink = html_entity_encode_dec($hyperlink, 1);
 221
 222         print "Content-type: text/html; charset=UTF-8\n\n";
 223
 224         print '<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "">'."\n";
 225         print ' <html lang="en">'."\n";
 226         print '  <head>'."\n";
 227         print '   <meta http-equiv="Content-type" content="text/html; charset=UTF-8">'."\n";
 228         if ($title ne '') {
 229                 print '   <title>'.$_title.'</title>'."\n";
 230         }
 231         print '  </head>'."\n";
 232         print ' <body>'."\n";
 233         if ($title ne '') {
 234                 print '  <h1>'.$_title.'</h1>'."\n";
 235         }
 236         if (($message ne '') || ($hyperlink ne '')) {
 237                 print "  <p>\n";
 238                 if ($message ne '') {
 239                         print '   '.$_message.($hyperlink ne '' ? '<br>' : '')."\n";
 240                 }
 241                 if ($hyperlink ne '') {
 242                         print '   <a href="'.$_hyperlink.'">'.$_hyperlink."</a>\n";
 243                 }
 244                 print "  </p>\n";
 245         }
 246         print ' </body>'."\n";
 247         print '</html>'."\n";
 248 }
 249
 250 sub fail_method {
 251         (my $method, my $allowed) = @_;
 252
 253         my $header = "Status: 405 Method Not Allowed\n";
 254         if ($allowed ne '') {
 255                 $header .= "Allow: $allowed\n";
 256         }
 257         return failpage(
 258                 $header,
 259                 "405 Method Not Allowed",
 260                 "The interface does not support the $method method.",
 261                 $method
 262         );
 263 }
 264
 265 sub fail_content_type
 266 {
 267         (my $method, my $content_type) = @_;
 268
 269         return failpage(
 270                 "Status: 415 Unsupported Media Type\n",
 271                 "415 Unsupported Media Type",
 272                 "Unsupported Content-type: $content_type.",
 273                 $method
 274         );
 275 }
 276
 277 sub fail_open_file
 278 {
 279         (my $method, my $type, my $path) = @_;
 280
 281         return failpage(
 282                 "Status: 404 Not Found\n",
 283                 "404 Not Found",
 284                         "Can't open ".
 285                         ($type ne '' ? $type : 'file').
 286                         ($path ne '' ? ': "'.$path.'"' : '').
 287                         '.',
 288                 $method
 289         );
 290 }
 291
 292 sub fail_attachment
 293 {
 294         (my $method, my $ID) = @_;
 295
 296         return failpage(
 297                 "Status: 404 Not Found\n",
 298                 "404 Not Found",
 299                 "Attachment $ID not found.",
 300                 $method
 301         );
 302 }
 303
 304 sub fail_500
 305 {
 306         (my $method, my $text) = @_;
 307         return failpage(
 308                 "Status: 500 Internal Server Error\n",
 309                 "500 Internal Server Error",
 310                 $text,
 311                 $method
 312         );
 313 }
 314
 315 sub redirect
 316 {
 317         (my $method, my $uri, my $code) = @_;
 318         my $status;
 319         if ($code eq '') {
 320                 $code = 302
 321         }
 322         $code = int($code);
 323         if ($code == 301) {
 324                 $status = '301 Moved Permanently';
 325         }
 326         elsif ($code == 302) {
 327                 $status = '302 Found';
 328         }
 329         elsif ($code == 303) {
 330                 $status = '303 See Other';
 331         }
 332         elsif ($code == 307) {
 333                 $status = '307 Temporary Redirect';
 334         }
 335         elsif ($code == 308) {
 336                 $status = '308 Permanent Redirect';
 337         }
 338         else{
 339                 $status = "$code Redirect";
 340         }
 341         return failpage(
 342                 "Status: $status\nLocation: $uri\n",
 343                 $status,
 344                 '',
 345                 $method,
 346                 $uri
 347         );
 348 }
 349
 350
 351 # function to obtain address of remote agent
 352 sub get_remote_addr {
 353         if ($ENV{'HTTP_X_FORWARDED_FOR'} =~ /^.+$/) {
 354                 return $&;
 355         }
 356         elsif ($ENV{'REMOTE_ADDR'} =~ /^.+$/) {
 357                 return $&;
 358         }
 359         else {
 360                 return '0.0.0.0';
 361         }
 362 }
 363
 364 # functions to get ID/number etc.
 365 sub get_id {
 366         (my $cgi, my $default, my $cgi_name) = @_;
 367                 if ($default eq '') {
 368                 $default = 0;
 369         }
 370         if ($cgi_name eq '') {
 371                 $cgi_name = 'i';
 372         }
 373
 374         if ($cgi->{$cgi_name} =~ /^.+$/) {
 375                 return int($&);
 376         }
 377         elsif ($ENV{'PATH_INFO'} =~ /^\/(.+)$/) {
 378                 return int($1);
 379         }
 380         else {
 381                 return int($default);
 382         }
 383 }
 384
 385 # function to obtain frame number
 386 sub get_frame {
 387         (my $cgi, my $default) = @_;
 388         return get_id($cgi, $default, 'f');
 389 }
 390
 391 # function to obtain password
 392 sub get_password {
 393         (my $cgi) = @_;
 394
 395         if ($cgi->{'p'} =~ /^.+$/) {
 396                 return $&;
 397         }
 398         else {
 399                 return '';
 400         }
 401 }
 402
 403
 404 sub merge_settings {
 405                 my %final_settings;
 406
 407         foreach my $settings (@_) {
 408                 foreach my $ind (keys %$settings) {
 409                         $final_settings{$ind} = $settings->{$ind};
 410                 }
 411         }
 412         return %final_settings;
 413 }
 414
 415 # TO REMOVE
 416 # function to encode entities, decimal,
 417 sub entityencode {
 418         (my $t, my $all) = @_;
 419         return html_entity_encode_dec($t, 1, $all);
 420 }
 421
 422 # TO REMOVE
 423 # function to get values of http header fields. Returns a hash. names of header
 424 # fields are lowercase
 425 sub gethttpheader {
 426         (my $env) = @_;
 427
 428         return read_header_env($env);
 429 }
 430
 431 # TO REMOVE
 432 # The function to get CGI parameters from string.
 433 # Format is: name=url_encoded_value&name=url_encoded_value& ... &name=url_encoded_value
 434 sub getcgi {
 435         return url_query_decode($_[0]);
 436 }
 437
 438 # TO REMOVE
 439 # Function for decoding URL-encoded text
 440 sub urldecode {
 441         return url_decode($_[0]);
 442 }
 443
 444 # TO REMOVE
 445 # Function to read data from datafiles.
 446 # Very similar to http header file reading. (function readheaderfile() in proxy
 447 # library)
 448 #
 449 # Differences:
 450 #
 451 # 1. After field name and colon there must be exactly one whitespace (space or
 452 # tab). Any other leading or trailing whitespace (but not the newline character
 453 # at the end of the line) is treated as part of the field value.
 454 #
 455 # 2. Instead of colon an equal sign can be used. The number of whitespaces after
 456 # it is then zero and not one.
 457 #
 458 # 3. When header field is split into multiple lines the next lines must start
 459 # with exactly one whitespace (tab or space) Any other leading or trailing
 460 # whitespace (but not the newline character at the end of the line) is treated
 461 # as part of the field value. the lines will be joined with a newline between
 462 # them.
 463 #
 464 # 4. When the same field name appears it replaces the previous one.
 465 #
 466 # 5. Line separator is LF and not CR LF. The CR character is treated as part of
 467 # the field value.
 468 #
 469 # 6. After the end of header (double newline) all next lines are treated as the
 470 # value of the "content" field.
 471 #
 472 # Returns a hash containing the values.
 473 # Names are case sensitive and are converted to lowercase
 474 #
 475 # Argument can be a path or a file handle. In case of a file handle it will just
 476 # read the file. In case of path it opens the file before reading and closes
 477 # after. On failure (file not open) returns empty hash.
 478 #
 479 sub readdatafile {
 480         (my $datapath) = @_;
 481
 482         return read_data_file($datapath);
 483 }
 484
 485 # TO REMOVE
 486 # the function to write data to datafiles (see readdatafile() description)
 487 #
 488 # First argument can be a path or a file handle. In case of a file handle it
 489 # will just write the file. In case of path it opens the file before writing and
 490 # closes after.
 491 #
 492 # On failure (file not open) returns 0.
 493 # On success returns 1.
 494 #
 495 sub writedatafile {
 496         (my $headerpath, my %header) = @_;
 497
 498         return write_data_file($headerpath, '', 0, \%header);
 499 }
 500
 501 # TO REMOVE
 502 # the function to print data to stdout (see readdatafile() description)
 503 #
 504 # On success returns 1.
 505 #
 506 sub printdatafile {
 507         (my %header) = @_;
 508
 509         return write_data_file(\*STDOUT, '', 0, \%header);
 510 }
 511
 512 # TO REMOVE
 513 # the function to print data to stdout as html (see readdatafile() description)
 514 #
 515 # On success returns 1.
 516 #
 517 sub printdatafileht {
 518         (my %header) = @_;
 519
 520         print_html_data(\*STDOUT, \%header);
 521         return 1;
 522 }
 523
 524 # TO REMOVE
 525 sub urlencode {
 526         (my $t, my $all) = @_;
 527         return url_encode($t, '', $all);
 528 }
 529
 530
 531 # BB code stuff
 532 # different & simpler implementation than in post library
 533 # to consider:
 534 # a BBcode library?
 535
 536 #analyse bbcode text to build tag tree
 537 #TODO make [/*] optional!
 538 sub bbtree {
 539         (my $bb, my $printdebug) = @_;
 540         my %bbtree;
 541         my $ind;
 542         my $tag;
 543         my $tag_name;
 544         my $tag_value;
 545         my $tag_end;
 546         my $level=0;
 547         my $pre_text;
 548         my $debug;
 549
 550         $ind="_";
 551         $level=0;
 552         $bbtree{"_.name" }  = "ht";
 553         $bbtree{"_.value" } = '';
 554         $bbtree{"_.type"  } = "tag";
 555         $bbtree{"_.count" } = 0;
 556         $bbtree{"_.closed"} = 0;
 557         $debug .= debug($printdebug,
 558                 "\n".
 559                 "<!--GENERATING BBCODE TREE:\n".
 560                 '[_]automatic tag: [ht]'."\n"
 561         );
 562
 563         while ($bb ne '') {
 564                 my $new_ind = $ind.'.'.$bbtree{$ind.'.count'};
 565
 566                 if($bb =~ m/\[(\/?)([a-z]+|\*)(=([^\[\]]*))?\]/g) {
 567                         $pre_text = $`;
 568                         $tag = $&;
 569                         $tag_end = $1;
 570                         $tag_name = $2;
 571                         $tag_value = $4;
 572                         $bb = $';
 573
 574                         if ($pre_text ne '') {
 575                                 $debug .= debug($printdebug, "[$new_ind]text: $pre_text\n");
 576                                 $bbtree{$new_ind.'.type' } = 'text';
 577                                 $bbtree{$new_ind.'.value'} = $pre_text;
 578                                 $bbtree{    $ind.'.count'}+= 1;
 579                                 $new_ind = $ind.'.'.$bbtree{$ind.'.count'};
 580                         }
 581
 582                         if($tag_name =~ /^(fq|tq|br|ni|po|url|i|list|\*)$/) {
 583                                 if ($tag_end ne '') {
 584                                         if (
 585                                                 ($tag_name ne $bbtree{$ind.'.name'}) ||
 586                                                 ($level <= 0)
 587                                         ) {
 588                                                 $debug .= debug($printdebug, "[$new_ind]text: $tag\n");
 589                                                 $bbtree{$new_ind.'.type' } = 'text';
 590                                                 $bbtree{$new_ind.'.value'} = $tag;
 591                                                 $bbtree{    $ind.'.count'}+= 1;
 592                                                 # $new_ind = $ind.'.'.$bbtree{$ind.'.count'};
 593                                         }
 594                                         else {
 595                                                 $debug .= debug($printdebug, "[$new_ind]tag: $tag\n");
 596                                                 $bbtree{$new_ind.'.type'  } = 'tag';
 597                                                 $bbtree{$new_ind.'.name'  } = '/'.$tag_name;
 598                                                 $bbtree{$new_ind.'.value' } = $tag_value;
 599                                                 $bbtree{    $ind.'.count' }+= 1;
 600                                                 $bbtree{    $ind.'.closed'} = 1;
 601                                                 $level -= 1;
 602                                                 $ind =~ s/\.[0-9]+$//;
 603                                                 # $new_ind = $ind.'.'.$bbtree{$ind.'.count'};
 604                                         }
 605                                 }
 606                                 else
 607                                 {
 608                                         $debug .= debug($printdebug, "[$new_ind]tag: $tag\n");
 609                                         $bbtree{$new_ind.'.type'  } = 'tag';
 610                                         $bbtree{$new_ind.'.name'  } = $tag_name;
 611                                         $bbtree{$new_ind.'.value' } = $tag_value;
 612                                         $bbtree{$new_ind.'.count' } = 0;
 613                                         $bbtree{$new_ind.'.closed'} = 0;
 614                                         $bbtree{    $ind.'.count' }+= 1;
 615                                         $level += 1;
 616                                         $ind = $new_ind;
 617                                         # $new_ind = $ind.'.'.$bbtree{$ind.'.count'};
 618                                 }
 619                         }
 620                         else {
 621                                 $debug .= debug($printdebug, "[$new_ind]text: $tag\n");
 622                                 $bbtree{$new_ind.'.type' } = 'text';
 623                                 $bbtree{$new_ind.'.value'} = $tag;
 624                                 $bbtree{    $ind.'.count'}+= 1;
 625                                 # $new_ind = $ind.'.'.$bbtree{$ind.'.count'};
 626                         }
 627                 }
 628                 else {
 629                         $debug .= debug($printdebug, "[$new_ind]text: $bb\n");
 630                         $bbtree{$new_ind.'.type' } = 'text';
 631                         $bbtree{$new_ind.'.value'} = $bb;
 632                         $bbtree{    $ind.'.count'}+= 1;
 633                         # $new_ind = $ind.'.'.$bbtree{$ind.'.count'};
 634                         $bb = '';
 635                 }
 636         }
 637         my $final_ind = '_.'.$bbtree{"_.count"};
 638         $debug .= debug($printdebug, "[$final_ind]automatic tag: [/ht]\n -->\n");
 639         $bbtree{$final_ind.'.type' } = "tag";
 640         $bbtree{$final_ind.'.name' } = '/ht';
 641         $bbtree{         '_.count' }+= 1;
 642         $bbtree{         '_.closed'} = 1;
 643
 644         return ($debug, %bbtree);
 645 }
 646
 647 #convert tag tree to final text
 648 sub convtree {
 649         (my $printdebug, my $debug, my $lang, my $bbtree) = @_;
 650         my $out;
 651         my $ind;
 652         my $indd;
 653         my $level = 0;
 654         my $tags = ($lang eq 'html') ? tags_html : tags_bbcode;
 655         my $escape = ($lang eq 'html');
 656
 657         # $debug .= debug($printdebug, "\n****\n");
 658         # foreach my $iiii (keys %tags) {
 659                 # $debug .= debug($printdebug, $iiii.'='.$tags->{$iiii}."\n");
 660         # }
 661         # $debug .= debug($printdebug, "****\n");
 662
 663         $level = 0;
 664         $ind = '_';
 665         $out = '';
 666         $debug .= debug($printdebug, "\n<!--PROCESSING BBCODE TREE:\n");
 667
 668         while ($level >= 0) {
 669                 my $goto_next = '';
 670                 $debug .= debug($printdebug, "[$level:$ind:".int($bbtree->{$ind.'.count'})."]");
 671                 #normal text
 672                 if ($bbtree->{$ind.'.type'} eq 'text') {
 673                         my $text = $bbtree->{$ind.'.value'};
 674                         $debug .= debug($printdebug, "text: ".$text);
 675                         $out .= $escape ? html_encode_line($text) : $text;
 676
 677                         $goto_next = 'tx';
 678                 }
 679                 #tag
 680                 elsif ($bbtree->{$ind.'.type'} eq 'tag') {
 681                         my $name = $bbtree->{$ind.'.name'};
 682                         #endtag
 683                         if ($name =~ /^\//) {
 684                                 $debug .= debug($printdebug, "tag: [$name]");
 685                                 $indd = $ind;
 686                                 $indd =~ s/\.([0-9]+)$//;
 687                                 if (exists($tags->{$name.'='}) && ($bbtree->{$indd.'.value'} ne '')) {
 688                                         $out .= $tags->{$name.'='};
 689                                 }
 690                                 elsif (exists($tags->{$name})) {
 691                                         $out .= $tags->{$name};
 692                                 }
 693                                 else {
 694                                         $out .= $tags->{'/?'};
 695                                         $debug .= debug($printdebug, "[unknown!]");
 696                                 }
 697
 698                                 $ind =~ s/\.([0-9]+)$//;
 699                                 $level -= 1;
 700                                 $debug .= debug($printdebug, "[<]");
 701                                 if ($level > 0) {
 702                                         $goto_next = 'nd';
 703                                 }
 704                                 else {
 705                                         # time to end this
 706                                         $level = -1;
 707                                 }
 708                         }
 709                         #starttag
 710                         else {
 711                                 my $value = $bbtree->{$ind.'.value'};
 712                                 if($bbtree->{$ind.'.closed'} ne '') {
 713                                         $debug .= debug($printdebug, "tag: [$name]");
 714
 715                                         if (exists($tags->{$name.'='}) && ($value ne '')) {
 716                                                 if (exists($tags->{$name.'='.$value})) {
 717                                                         $out .=
 718                                                                 $tags->{$name.'='} .
 719                                                                 $tags->{$name.'='.$value} .
 720                                                                 $tags->{$name.'/='};
 721                                                 }
 722                                                 else {
 723                                                         $out .=
 724                                                                 $tags->{$name.'='} .
 725                                                                 ($escape ? html_entity_encode_dec($value, 1) : $value) .
 726                                                                 $tags->{$name.'/='};
 727                                                 }
 728                                         }
 729                                         elsif (exists($tags->{$name})) {
 730                                                 $out .= $tags->{$name};
 731                                         }
 732                                         else {
 733                                                 $out .= $out.$tags->{'?'};
 734                                                 $debug .= debug($printdebug, "[unknown!]");
 735                                         }
 736                                 }
 737                                 else {
 738                                         $debug .= debug($printdebug, "unclosed tag: [$name]");
 739                                         my $text = $name . (($value ne '') ? ('='.$value) : '');
 740                                         $out .= '['.($escape ? html_encode_line($text) : $text).']';
 741                                 }
 742                                 if ($bbtree->{$ind.'.count'} > 0) {
 743                                         $ind = $ind.'.0';
 744                                         $level += 1;
 745                                         $debug .= debug($printdebug, "[>]");
 746                                 }
 747                                 else {
 748                                         $goto_next = 'st';
 749                                 }
 750                         }
 751                 }
 752                 # what is this
 753                 else {
 754                         $debug .= debug($printdebug, "unknown thing: ".$bbtree->{$ind.'.type'});
 755                         #should not occur with a correct bbtree
 756                         #unless unimplemented
 757                         $ind =~ s/\.([0-9]+)$//;
 758                         $level -= 1;
 759                         $debug .= debug($printdebug, "[<ui]");
 760                         if ($level > 0) {
 761                                 $goto_next = 'un';
 762                         }
 763                         else {
 764                                 # time to end this
 765                                 $level = -1;
 766                         }
 767                 }
 768                 if ($goto_next ne '') {
 769                         {do{
 770                                 $ind =~ s/\.([0-9]+)$//;
 771                                 my $i = int($1) + 1;
 772                                 if (($i < $bbtree->{$ind.'.count'}) and ($1 ne '')){
 773                                         # goto next
 774                                         $ind = $ind.'.'.$i;
 775                                         last;
 776                                 }
 777                                 else {
 778                                         # step out
 779                                         # should not occur with a correct bbtree
 780                                         $debug .= debug($printdebug, "[<$goto_next]");
 781                                         $level -= 1;
 782                                 }
 783                         } while ($level >= 0);}
 784                 }
 785
 786                 $debug .= debug($printdebug, "[>$level:$ind]\n");
 787         }
 788
 789         $debug .= debug($printdebug, "-->\n");
 790         return ($debug, $out);
 791 }
 792
 793 #bbcode to html, TBD
 794 sub bb_to_html {
 795         (my $bb, my $printdebug) = @_;
 796         my $ht;
 797         my %bbtree;
 798         my $debug;
 799
 800         ($debug, %bbtree) = bbtree($bb, $printdebug);
 801         ($debug, $ht) = convtree ($printdebug, $debug, 'html', \%bbtree);
 802
 803         return $ht;
 804 }
 805
 806 #bbcode to bb, TBD
 807 sub bb_to_bbcode {
 808         (my $bb, my $printdebug) = @_;
 809         my $ht;
 810         my %bbtree;
 811         my $debug;
 812
 813         ($debug, %bbtree) = bbtree($bb, $printdebug);
 814         ($debug, $ht) = convtree ($printdebug, $debug, 'bb', \%bbtree);
 815
 816         return $ht;
 817 }
 818
 819 # TO REMOVE
 820 sub bb2ht {
 821         return bb_to_html(@_);
 822 }
 823
 824 # TO REMOVE
 825 sub bb2bb {
 826         return bb_to_bbcode(@_);
 827 }
 828
 829 sub eval_bb {
 830         (my $bb) = @_;
 831         my $value;
 832         my $before;
 833         my $after;
 834
 835         while ($bb =~ m/###([^#;]*);/g) {
 836                 $value = $1;
 837                 $before = $`;
 838                 $after = $';
 839
 840                 if ($value =~ /^att&([0-9]+)$/) {
 841                         $value = merge_url(
 842                                 SCHEME().WEBSITE(),
 843                                 CGI_ATTACH_PATH(),
 844                                 int($1)
 845                         )
 846                 }
 847                 elsif ($value =~ /^vw&([0-9]+)$/) {
 848                         $value = merge_url(
 849                                 SCHEME().WEBSITE(),
 850                                 CGI_VIEWER_PATH(),
 851                                 int($1)
 852                         )
 853                 }
 854                 elsif ($value =~ /^fr&([0-9]+)$/) {
 855                         $value = merge_url(
 856                                 SCHEME().WEBSITE(),
 857                                 CGI_FRAME_PATH(),
 858                                 int($1)
 859                         )
 860                 }
 861                 else {
 862                         $value = '';
 863                 }
 864                 $bb = $before . $value . $after;
 865         }
 866         return $bb;
 867 }
 868
 869
 870 sub html_encode_line {
 871         (my $text, my $non_ascii, my $all) = @_;
 872         my $html;
 873         my $ind;
 874
 875         $text =~ s/\r\n/\n/gs;
 876         $text =~ s/\r/\n/gs;
 877
 878         while ($text ne '') {
 879                 $ind = index($text, "\n");
 880                 if ($ind >= 0) {
 881                         $html .= html_entity_encode_dec(substr($text, 0, $ind), $non_ascii, $all)."<br>\n";
 882                         $text = substr($text, $ind+1);
 883                 }
 884                 else
 885                 {
 886                         $html .= html_entity_encode_dec($text, 1);
 887                         $text = '';
 888                 }
 889         }
 890         return $html;
 891 }
 892
 893 # TO REMOVE
 894 sub linehtml {
 895         return html_encode_line($_[0], 1);
 896 }
 897
 898 sub debug {
 899         (my $print, my $text) = @_;
 900
 901         if ($print) {
 902                 print $text;
 903         }
 904
 905         return $text;
 906 }
 907
 908
 909 sub print_html_start {
 910         (my $fh) = @_;
 911         print $fh '<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "">'."\n";
 912         print $fh '<html lang="en">'."\n";
 913 }
 914
 915 sub print_html_end {
 916         (my $fh) = @_;
 917         print $fh '</html>'."\n";
 918 }
 919
 920 sub print_html_head_start {
 921         (my $fh) = @_;
 922         print $fh ' <head>'."\n";
 923         print $fh '  <meta http-equiv="Content-type" content="text/html; charset=UTF-8">'."\n";
 924         print $fh '  <link rel="icon" type="image/png" href="'.html_entity_encode_dec(FAVICON_PATH(),1).'">'."\n";
 925         print $fh '  <link rel="stylesheet" href="'.html_entity_encode_dec(CGI_CSS_PATH(),1).'">'."\n";
 926 }
 927
 928 sub print_html_head_end {
 929         (my $fh) = @_;
 930         print $fh ' </head>'."\n";
 931 }
 932
 933 sub print_html_body_start {
 934         (my $fh) = @_;
 935         print $fh ' <body>'."\n";
 936         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";
 937         print $fh '  <div id="all">'."\n";
 938 }
 939
 940 sub print_html_body_end {
 941         (my $fh) = @_;
 942         print $fh '  </div>'."\n";
 943         print $fh '  <a href="/" class="cz">'.html_entity_encode_dec(WEBSITE(),1).'</a>'."\n";
 944         print $fh ' </body>'."\n";
 945 }
 946
 947 sub print_html_data {
 948         (my $fh, my $data) = @_;
 949
 950         foreach my $key (keys %$data) {
 951                 unless ($key eq 'content') {
 952                         my $val = $data->{$key};
 953                         $val =~ s/(\r)?\n/\n /gs; # does the space make sense in HTML anyway?
 954                         print $fh html_encode_line("$key: $val\n", 1);
 955                 }
 956         }
 957         print $fh html_encode_line("\n".$data->{'content'});
 958 }
 959
 960 sub print_viewer_page {
 961         (
 962                 my $file,
 963                 my $context,
 964                 my $state,
 965                 my $settings,
 966                 my $frame_data,
 967                 my $next_frame_data
 968         ) = @_;
 969         my $fh;
 970
 971         my $launch      = $context->{'launch'};
 972         my $access      = $context->{'access'};
 973         my $password_ok = $context->{'password_ok'};
 974         my $static      = $context->{'static'};
 975
 976         my $frame          = int($context->{'frame'});
 977         my $text_mode      = int($context->{'text_mode'});
 978         my $timer_unlocked = int($context->{'timer_unlocked'});
 979         my $timer          = int($context->{'timer'});
 980
 981         # my $prev_frame = $frame - 1;
 982         my $next_frame = $frame + 1;
 983
 984         my $story = $settings->{'story'};
 985         my $title = $frame_data->{'title'};
 986         my $command = ($frame_data->{'command'} ne '') ?
 987                 $frame_data->{'command'} :
 988                 $next_frame_data->{'title'};
 989
 990         my $last_frame = int($state->{'last'});
 991         my $ong_state  = int($state->{'state'});
 992
 993         my $timer_color_h = (($timer_unlocked >= 1) || ($ong_state >= STATE->{'ready'})) ? 'br' : 'ni';
 994         my $timer_color_m = (($timer_unlocked >= 2) || ($ong_state >= STATE->{'ready'})) ? 'br' : 'ni';
 995         my $timer_color_s = (($timer_unlocked >= 3) || ($ong_state >= STATE->{'ready'})) ? 'br' : 'ni';
 996
 997         my $timer_h;
 998         my $timer_m;
 999         my $timer_s;
1000         if (
1001                 ($timer > 0) ||
1002                 (($timer >= 0) && ($frame == 0))
1003         ) {
1004                 $timer_s = sprintf('%02d', $timer % 60);
1005                 $timer_h = int($timer / 60);
1006                 $timer_m = sprintf('%02d', $timer_h % 60);
1007                 $timer_h = sprintf('%02d', $timer_h / 60);
1008         }
1009         elsif (($timer >= -15) && ($ong_state >= STATE->{'ready'})) {
1010                 $timer_h = '00';
1011                 $timer_m = '00';
1012                 $timer_s = 'NG';
1013         }
1014         else {
1015                 $timer_h = 'EE';
1016                 $timer_m = 'EE';
1017                 $timer_s = 'EE';
1018         }
1019
1020         my $prev_available = (($frame > 0) && $access);
1021         my $next_available = ($launch || $password_ok || ($next_frame <= $last_frame));
1022         my $prefetch_next  = (
1023                 $password_ok ||
1024                 ($next_frame < $last_frame) || (  # avoid unseen trigger!
1025                         ($next_frame <= $last_frame) &&
1026                         ($ong_state >= STATE->{'ready'})
1027                 )
1028         );
1029         my $show_timer = (
1030                 (
1031                         $access && $launch
1032                 ) || (
1033                         ($frame == $last_frame) && (
1034                                 ($ong_state == STATE->{'waiting'}) ||
1035                                 ($ong_state == STATE->{'ready'})
1036                         )
1037                 )
1038         );
1039         my $show_command = (
1040                 $launch ||
1041                 $password_ok ||
1042                 (!$access) ||
1043                 ($frame < $last_frame) || (
1044                         ($ong_state >= STATE->{'ready'}) &&
1045                         $context->{'show_command'}
1046                 )
1047         );
1048         my $show_command_link = ($next_available || (!$access));
1049         my $show_command_cursor = ((!$next_available) || ($command eq ''));
1050         my $frame_indirect = !(
1051                 (!$access) || (
1052                         ($frame <= $last_frame) &&
1053                         ($ong_state > STATE->{'inactive'})
1054                 )
1055         );
1056         my $nextframe_indirect = !($next_frame <= $last_frame);
1057
1058         my $password_query;
1059
1060         my $base_url   = CGI_PATH;
1061         my $goto_url   = CGI_GOTO_PATH;
1062         my $info_url   = CGI_INFO_PATH;
1063         my $bbcode_url = CGI_BBCODE_PATH;
1064         my $timer_url  = CGI_TIMER_PATH;
1065         my $viewer_full_url = merge_url(
1066                 {'scheme' => SCHEME(), 'host' => WEBSITE()},
1067                 {'path' => CGI_VIEWER_PATH()},
1068                 {'path' => $frame}
1069         );
1070         my $viewer_url = merge_url(
1071                 {'path' => CGI_VIEWER_PATH()},
1072                 {'path' => $frame}
1073         );
1074         my $viewer_0_url = merge_url(
1075                 {'path' => CGI_VIEWER_PATH()},
1076                 {'path' => 0}
1077         );
1078         my $viewer_prev_url = merge_url(
1079                 {'path' => CGI_VIEWER_PATH()},
1080                 {'path' => $frame-1}
1081         );
1082         my $viewer_next_url = merge_url(
1083                 {'path' => CGI_VIEWER_PATH()},
1084                 {'path' => $next_frame}
1085         );
1086         my $viewer_last_url = merge_url(
1087                 {'path' => CGI_VIEWER_PATH()},
1088                 {'path' => ($static ? -1 : $last_frame)}
1089         );
1090         if ($text_mode != TEXT_MODE->{'bb'}) {
1091                 $bbcode_url = merge_url(
1092                         $viewer_url,
1093                         {'query'=>{
1094                                 'b' => TEXT_MODE->{'bb'}
1095                         }}
1096                 );
1097         }
1098         if ($text_mode != TEXT_MODE->{'info'}) {
1099                 $info_url = merge_url(
1100                         $viewer_url,
1101                         {'query'=>{
1102                                 'b' => TEXT_MODE->{'info'}
1103                         }}
1104                 );
1105         }
1106         my $frame_file;
1107         my $frame_url;
1108         my $frame_next_url;
1109         my $frame_normal_url;
1110         my $frame_full_url;
1111         if ($frame_data->{'frame'} ne '') {
1112                 $frame_file = $frame_data->{'frame'};
1113         }
1114         else {
1115                 $frame_file = sprintf(
1116                         $settings->{'frame'},
1117                         $frame, $frame_data->{'ext'}
1118                 );
1119         }
1120         $frame_normal_url = merge_url(
1121                         {'path' => CGI_PATH()},
1122                         {'path' => $frame_file}
1123                 );
1124         $frame_url = $frame_indirect ?
1125                 merge_url(
1126                         {'path' => CGI_FRAME_PATH()},
1127                         {'path' => $frame}
1128                 ) :
1129                 $frame_normal_url;
1130         $frame_full_url = merge_url(
1131                 {'scheme' => SCHEME(), 'host' => WEBSITE()},
1132                 {'path' => $frame_normal_url}
1133         );
1134         if ($nextframe_indirect) {
1135                 $frame_next_url = merge_url(
1136                         {'path' => CGI_FRAME_PATH()},
1137                         {'path' => $next_frame}
1138                 );
1139         }
1140         elsif ($next_frame_data->{'frame'} ne '') {
1141                 $frame_next_url = merge_url(
1142                         {'path' => CGI_PATH()},
1143                         {'path' => $next_frame_data->{'frame'}}
1144                 );
1145         }
1146         else {
1147                 $frame_next_url = merge_url(CGI_PATH(), sprintf(
1148                         $settings->{'frame'}, $next_frame, $next_frame_data->{'ext'}
1149                 ));
1150         }
1151
1152         if ($password_ok) {
1153                 $password_query = url_query_encode({'p', $settings->{'password'}});
1154                 $goto_url        = merge_url($goto_url       , {'query' => $password_query, 'append_query' => 1});
1155                 $info_url        = merge_url($info_url       , {'query' => $password_query, 'append_query' => 1});
1156                 $bbcode_url      = merge_url($bbcode_url     , {'query' => $password_query, 'append_query' => 1});
1157                 $viewer_url      = merge_url($viewer_url     , {'query' => $password_query, 'append_query' => 1});
1158                 $viewer_0_url    = merge_url($viewer_0_url   , {'query' => $password_query, 'append_query' => 1});
1159                 $viewer_prev_url = merge_url($viewer_prev_url, {'query' => $password_query, 'append_query' => 1});
1160                 $viewer_next_url = merge_url($viewer_next_url, {'query' => $password_query, 'append_query' => 1});
1161                 $viewer_last_url = merge_url($viewer_last_url, {'query' => $password_query, 'append_query' => 1});
1162                 if ($frame_indirect) {
1163                         $frame_url     = merge_url($frame_url      , {'query' => $password_query, 'append_query' => 1});
1164                 }
1165                 if ($nextframe_indirect) {
1166                         $frame_next_url= merge_url($frame_next_url , {'query' => $password_query, 'append_query' => 1});
1167                 }
1168         }
1169         my $_base_url        = html_entity_encode_dec($base_url       , 1);
1170         my $_goto_url        = html_entity_encode_dec($goto_url       , 1);
1171         my $_info_url        = html_entity_encode_dec($info_url       , 1);
1172         my $_bbcode_url      = html_entity_encode_dec($bbcode_url     , 1);
1173         my $_timer_url       = html_entity_encode_dec($timer_url      , 1);
1174         my $_viewer_full_url = html_entity_encode_dec($viewer_full_url, 1);
1175         my $_viewer_url      = html_entity_encode_dec($viewer_url     , 1);
1176         my $_viewer_0_url    = html_entity_encode_dec($viewer_0_url   , 1);
1177         my $_viewer_prev_url = html_entity_encode_dec($viewer_prev_url, 1);
1178         my $_viewer_next_url = html_entity_encode_dec($viewer_next_url, 1);
1179         my $_viewer_last_url = html_entity_encode_dec($viewer_last_url, 1);
1180         my $_frame_url       = html_entity_encode_dec($frame_url      , 1);
1181         my $_frame_next_url  = html_entity_encode_dec($frame_next_url , 1);
1182         my $_frame_full_url  = html_entity_encode_dec($frame_full_url , 1);
1183
1184         my $_story   = html_entity_encode_dec($story,   1);
1185         my $_title   = html_entity_encode_dec($title,   1);
1186         my $_command = html_entity_encode_dec($command, 1);
1187
1188         my $_website_name = html_entity_encode_dec(WEBSITE_NAME(), 1);
1189
1190         if ($text_mode == TEXT_MODE->{'info'}) {
1191                 if ($show_command) {
1192                         $frame_data->{'command'} = $command;
1193                 }
1194                 if ($context->{'access'}) {
1195                         $frame_data->{'frame'} = $frame_file;
1196                 }
1197         }
1198
1199         # everything determined, now start generating
1200
1201         if (ref($file)) {
1202                 $fh=$file;
1203                 unless (seek($fh, 0, 0)) {
1204                         #don't actually fail here
1205                 }
1206         }
1207         else {
1208                 unless (open ($fh, ">:encoding(UTF-8)", encode('locale_fs', $file))) {
1209                         return 0;
1210                 }
1211         }
1212
1213         print_html_start($fh);
1214         print_html_head_start($fh);
1215
1216         print $fh '  <title>'.$_title;
1217         if ($story ne $title) {
1218                 print $fh ' &bull; '.$_story;
1219         }
1220         print $fh ' &bull; '.$_website_name.'</title>'."\n";
1221         print $fh '  <link rel="index" href="'.$_goto_url.'">'."\n";
1222         print $fh '  <link rel="start" href="'.$_viewer_0_url.'">'."\n";
1223         if ($prev_available) {
1224                 print $fh '  <link rel="prev" href="'.$_viewer_prev_url.'">'."\n";
1225         }
1226         if ($next_available) {
1227                 print $fh '  <link rel="next" href="'.$_viewer_next_url.'">'."\n";
1228                 if ($prefetch_next) {
1229                         print $fh '  <link rel="prefetch" href="'.$_viewer_next_url.'">'."\n";
1230                         print $fh '  <link rel="prefetch" href="'.$_frame_next_url.'">'."\n";
1231                 }
1232         }
1233         if ($show_timer) {
1234                 print $fh '  <!-- <script src="'.$_timer_url.'"></script> -->'."\n";
1235         }
1236
1237         print_html_head_end($fh);
1238         print_html_body_start($fh);
1239
1240         print $fh '   <div id="inst" class="ins">'."\n";
1241
1242         print $fh '    <div id="title">'."\n";
1243         print $fh '     <h1 id="titletext">'.$_title.'</h1>'."\n";
1244         print $fh '    </div>'."\n";
1245
1246         print $fh '   </div>'."\n";
1247         print $fh '   <div id="framespace">'."\n";
1248
1249         print $fh '    <img src="'.$_frame_url.'" id="frame" alt="'.$frame.'" title="'.$_title.'">'."\n";
1250
1251         print $fh '   </div>'."\n";
1252         print $fh '   <div id="insb" class="ins">'."\n";
1253
1254         if ($text_mode == TEXT_MODE->{'info'}) {
1255                 print $fh '    <div id="chat">'."\n";
1256
1257                 print_html_data($fh, $frame_data);
1258
1259                 print $fh '    </div>'."\n";
1260         }
1261         elsif ($text_mode == TEXT_MODE->{'bb'}) {
1262                 print $fh '    <div id="chat">'."\n";
1263
1264                 print $fh '[quote][center][size=200]'.$_title.'[/size]<br>'."\n";
1265                 print $fh '[url='.$_viewer_full_url.'][img]'.$_frame_full_url.'[/img][/url][/center]<br>'."\n";
1266                 print $fh html_encode_line(bb_to_bbcode(eval_bb($frame_data->{'content'})));
1267                 print $fh '[/quote]'."\n";
1268
1269                 print $fh '    </div>'."\n";
1270         }
1271         elsif ($frame_data->{'content'} ne '') {
1272                 print $fh '    <div id="undertext">'."\n";
1273                 print $fh bb_to_html(eval_bb($frame_data->{'content'}))."\n";
1274                 print $fh '    </div>'."\n";
1275         }
1276
1277         print $fh '    <div id="command">'."\n";
1278
1279         if ($show_timer) {
1280                 print $fh '     [<span id="ongh" class="'.$timer_color_h.'">'.$timer_h.'</span>';
1281                 print $fh      ':<span id="ongm" class="'.$timer_color_m.'">'.$timer_m.'</span>';
1282                 print $fh      ':<span id="ongs" class="'.$timer_color_s.'">'.$timer_s.'</span>]<br>'."\n";
1283         }
1284         print $fh '&gt;';
1285         if ($show_command_link) {
1286                 print $fh '<a href="'.($access ? $_viewer_next_url : $_viewer_last_url).'">';
1287         }
1288         if ($show_command) {
1289                 print $fh $_command;
1290         }
1291         if ($show_command_cursor) {
1292                 print $fh '<span class="inp">_</span>';
1293         }
1294         if ($show_command_link) {
1295                 print $fh '</a>';
1296         }
1297         print $fh "<br>\n";
1298         print $fh "    </div>\n";
1299
1300         print $fh '    <div id="underlinks">'."\n     ";
1301
1302         unless (($frame == 0) && $static) {
1303                 print $fh '<a href="'.$_base_url.'">Once again</a> | ';
1304         }
1305         if ($prev_available) {
1306                 print $fh '<a href="'.$_viewer_prev_url.'">Before</a> | ';
1307         }
1308         unless ($frame == $last_frame) {
1309                 print $fh '<a href="'.$_viewer_last_url.'">Now</a> | ';
1310         }
1311         print $fh '<a href="'.$_goto_url.'">GOTO</a>'."\n";
1312         print $fh '     <span style="float: right;">'."\n      ";
1313         if ($text_mode != TEXT_MODE->{'normal'}) {
1314                 print $fh '<a href="'.$_viewer_url.'">Without</a> | ';
1315         }
1316         print $fh '<a href="'.$_info_url.'">Info</a> | ';
1317         print $fh '<a href="'.$_bbcode_url.'">BB</a>';
1318         print $fh "\n     </span>\n";
1319
1320         print $fh "    </div>\n";
1321         print $fh "   </div>\n";
1322
1323         print_html_body_end($fh);
1324         print_html_end($fh);
1325
1326
1327         unless (ref($file)) {
1328                 close ($fh);
1329         }
1330         else {
1331                 truncate ($fh , tell($fh));
1332         }
1333
1334         return 1;
1335 }
1336
1337 sub write_index {
1338         (
1339                 my $state,
1340                 my $settings,
1341                 my $pass,
1342                 my $mode,
1343                 my $pause
1344         ) = @_;
1345         my $fh;
1346         my $r = 1;
1347         my $ong_state = int($state->{'state'});
1348
1349         unless (open ($fh, ">:encoding(UTF-8)", encode('locale_fs', WWW_INDEX_PATH()))) {
1350                 return 0;
1351         }
1352
1353         # normal running story
1354         if ($ong_state > STATE->{'inactive'}) {
1355                 my %frame_data     = read_data_file(join_path(PATH_SEPARATOR(), DATA_PATH(), 0));
1356                 my %next_frame_data= read_data_file(join_path(PATH_SEPARATOR(), DATA_PATH(), 1));
1357                 my %default        = read_data_file(DATA_DEFAULT_PATH());
1358
1359                 %frame_data     = merge_settings(\%default,      \%frame_data);
1360                 %next_frame_data= merge_settings(\%default, \%next_frame_data);
1361
1362                 $r = print_viewer_page(
1363                         $fh,
1364                         {
1365                                 'launch' => 0,
1366                                 'frame' => 0,
1367                                 'access' => 1,
1368                                 'password_ok' => 0,
1369                                 'timer_unlocked' => 3, # not relevant
1370                                 'timer' => 0, # not relevant
1371                                 'static' => 1,
1372                                 'show_command' => 1
1373                         },
1374                         $state,
1375                         $settings,
1376                         \%frame_data,
1377                         \%next_frame_data
1378                 );
1379         }
1380         # no conditions met, pretend a normal Apache2 index
1381         elsif ($pass != 1) {
1382                 my $index_of = CGI_PATH;
1383                 $index_of =~ s/\/$//g;
1384
1385                 my $_index_of     = html_entity_encode_dec($index_of  , 1);
1386                 my $_2words_date  = html_entity_encode_dec(INTF_DATE(), 1);
1387                 my $_coin_date    = html_entity_encode_dec(COIN_DATE(), 1);
1388                 my $_website      = html_entity_encode_dec(WEBSITE()  , 1);
1389
1390                 print_html_start ($fh);
1391                 print $fh ' <head>'."\n";
1392                 print $fh '  <meta http-equiv="Content-type" content="text/html; charset=UTF-8">'."\n";
1393                 print $fh '  <title>Index of '.$_index_of.'</title>'."\n";
1394                 print $fh ' </head>'."\n";
1395                 print $fh ' <body>'."\n";
1396                 print $fh '  <h1>Index of '.$_index_of.'</h1>'."\n";
1397                 print $fh '  <table>'."\n";
1398                 print $fh '   <tr>'."\n";
1399                 print $fh '    <th><img src="/icons/blank.gif" alt="[ICO]"></th>'."\n";
1400                 print $fh '    <th><a href="?C=N;O=D">Name</a></th>'."\n";
1401                 print $fh '    <th><a href="?C=M;O=A">Last modified</a></th>'."\n";
1402                 print $fh '    <th><a href="?C=S;O=A">Size</a></th>'."\n";
1403                 print $fh '    <th><a href="?C=D;O=A">Description</a></th>'."\n";
1404                 print $fh '   </tr><tr>'."\n";
1405                 print $fh '    <th colspan="5"><hr></th>'."\n";
1406                 print $fh '   </tr><tr>'."\n";
1407                 print $fh '    <td valign="top"><img src="/icons/back.gif" alt="[DIR]"></td>'."\n";
1408                 print $fh '    <td><a href="/">Parent Directory</a></td>'."\n";
1409                 print $fh '    <td>&nbsp;</td>'."\n";
1410                 print $fh '    <td align="right">  - </td>'."\n";
1411                 print $fh '    <td>&nbsp;</td>'."\n";
1412                 print $fh '   </tr><tr>'."\n";
1413                 print $fh '    <td valign="top"><img src="/icons/folder.gif" alt="[DIR]"></td>'."\n";
1414                 print $fh '    <td><a href="2words/">2words/</a></td>'."\n";
1415                 print $fh '    <td align="right">'.$_2words_date.'  </td>'."\n";
1416                 print $fh '    <td align="right">  - </td><td>&nbsp;</td>'."\n";
1417                 print $fh '   </tr><tr>'."\n";
1418                 print $fh '    <td valign="top"><img src="/icons/folder.gif" alt="[DIR]"></td>'."\n";
1419                 print $fh '    <td><a href="coin/">coin/</a></td>'."\n";
1420                 print $fh '    <td align="right">'.$_coin_date.'  </td>'."\n";
1421                 print $fh '    <td align="right">  - </td><td> Coincidence </td>'."\n";
1422                 print $fh '   </tr><tr>'."\n";
1423                 print $fh '    <th colspan="5"><hr></th>'."\n";
1424                 print $fh '   </tr>'."\n";
1425                 print $fh '  </table>'."\n";
1426                 print $fh '  <address>Apache/2.2.22 (Debian) Server at '.$_website.' Port 80</address>'."\n";
1427                 print $fh '  /body>'."\n";
1428                 print_html_end ($fh);
1429         }
1430         # the launch index
1431         else {
1432                 my %frame_data     = read_data_file(join_path(PATH_SEPARATOR(), DATA_PATH(), 0));
1433                 my %next_frame_data= read_data_file(join_path(PATH_SEPARATOR(), DATA_PATH(), 1));
1434                 my %default        = read_data_file(DATA_DEFAULT_PATH());
1435                 my %coin_data      = read_data_file(DATA_COIN_PATH());
1436
1437                 %frame_data     = merge_settings(\%default,      \%frame_data);
1438                 %next_frame_data= merge_settings(\%default, \%next_frame_data);
1439
1440                 if (($mode == INTF_STATE->{'>'}) && $pause) {
1441                         $r = print_viewer_page(
1442                                 $fh,
1443                                 {
1444                                         'launch' => 1,
1445                                         'frame' => 0,
1446                                         'access' => 1,
1447                                         'password_ok' => 0,
1448                                         'timer_unlocked' => 3,
1449                                         'timer' => 0,
1450                                         'static' => 1,
1451                                         'show_command' => 1,
1452                                 },
1453                                 $state,
1454                                 $settings,
1455                                 \%frame_data,
1456                                 \%next_frame_data
1457                         );
1458                         return $r;
1459                 }
1460
1461                 my $index_of = CGI_PATH;
1462                 $index_of =~ s/\/$//g;
1463                 my $title;
1464                 my $frame_file;
1465                 my $undertext = '';
1466                 my $show_parent_dir = 0;
1467                 my $show_yb = 0;
1468                 my $show_folders = 0;
1469                 my $timer = '';
1470                 my $timer_color = 'ni';
1471                 if ($mode == INTF_STATE->{'>'}) {
1472                         $title = $settings->{'story'}; # $frame_data{'title'} ?
1473                         $frame_file = 'intf-tr.gif';
1474                         $undertext = '...';
1475                         $timer = '--';
1476                 }
1477                 elsif ($mode == INTF_STATE->{'<<'}) {
1478                         $title = 'Index of';
1479                         $frame_file = 'intf-ll.gif';
1480                         $show_parent_dir = 1;
1481                         $show_yb = 1;
1482                         $timer = 'EE';
1483                         $timer_color = 'br';
1484                 }
1485                 elsif ($mode == INTF_STATE->{'>>'}) {
1486                         $title = 'Index of';
1487                         $frame_file = 'intf-pp.gif';
1488                         $show_parent_dir = 1;
1489                         $show_yb = 1;
1490                         $timer = 'EE';
1491                 }
1492                 else
1493                 {
1494                         $title = 'Index of '.$index_of;
1495                         $frame_file = 'intf-kw.gif';
1496                         $show_parent_dir = 1;
1497                         $show_folders = 1;
1498                 }
1499                 my $frame_url = merge_url(
1500                         {'path' => CGI_PATH()},
1501                         {'path' => $frame_file}
1502                 );
1503                 my $coin_server = $coin_data{'server'};
1504
1505                 my $_title        = html_entity_encode_dec($title           , 1);
1506                 my $_website_name = html_entity_encode_dec(WEBSITE_NAME()   , 1);
1507                 my $_frame_url    = html_entity_encode_dec($frame_url       , 1);
1508                 my $_undertext    = html_entity_encode_dec($undertext       , 1);
1509                 my $_2words_date  = html_entity_encode_dec(INTF_DATE()      , 1);
1510                 my $_coin_date    = html_entity_encode_dec(COIN_DATE()      , 1);
1511                 my $_coin_server  = html_entity_encode_dec($coin_server     , 1);
1512                 my $_2words_url   = html_entity_encode_dec(CGI_2WORDS_PATH(), 1);
1513                 my $_coin_url     = html_entity_encode_dec(CGI_COIN_PATH()  , 1);
1514
1515                 print_html_start($fh);
1516                 print_html_head_start($fh);
1517
1518                 print $fh '  <title>'.$_title.' &bull; '.$_website_name.'</title>'."\n";
1519
1520                 print_html_head_end($fh);
1521                 print_html_body_start($fh);
1522
1523                 print $fh '   <div id="inst" class="ins">'."\n";
1524
1525                 print $fh '    <div id="title">'."\n";
1526                 print $fh '     <h1 id="titletext">'.$_title.'</h1>'."\n";
1527                 print $fh '    </div>'."\n";
1528
1529                 print $fh '   </div>'."\n";
1530                 print $fh '   <div id="framespace">'."\n";
1531
1532                 print $fh '    <img src="'.$_frame_url.'" id="frame" alt="0">'."\n"; # title="'.$_title.'"
1533
1534                 print $fh '   </div>'."\n";
1535                 print $fh '   <div id="insb" class="ins">'."\n";
1536
1537                 print $fh '    <div id="undertext">'."\n";
1538
1539                 if ($show_parent_dir) {
1540                         print $fh '     <img src="/icons/back.gif" alt="[DIR]"> <a href="..">Parent Directory</a><br>'."\n";
1541                 }
1542                 if ($show_folders) {
1543                         print $fh '     <img src="/icons/folder.gif" alt="[DIR]"> <a href="'.$_2words_url.'">2words/</a> '.$_2words_date.' - <br>'."\n";
1544                         print $fh '     <img src="/icons/folder.gif" alt="[DIR]"> <a href="'.$_coin_url.'">coin/</a> '.$_coin_date.' - '.$_coin_server."\n";
1545                 }
1546                 elsif ($show_yb) {
1547                         print $fh '     <img src="/icons/folder.gif" alt="[DIR]"> <a href="#">yyyyb/</a>'."\n";
1548                 }
1549                 if ($undertext ne '') {
1550                         print $fh '     '.$_undertext."\n";
1551                 }
1552
1553                 print $fh '    </div>'."\n";
1554
1555                 if ($timer ne '') {
1556                         print $fh '    <div id="command">'."\n";
1557
1558                         print $fh '     [<span id="ongh" class="'.$timer_color.'">'.$timer.'</span>';
1559                         print $fh      ':<span id="ongm" class="'.$timer_color.'">'.$timer.'</span>';
1560                         print $fh      ':<span id="ongs" class="'.$timer_color.'">'.$timer.'</span>]<br>'."\n";
1561
1562                         if ($undertext ne '') {
1563                                 print $fh '&gt;'.$_undertext.'<span class="inp">_</span>'."\n";
1564                         }
1565                         print $fh "    </div>\n";
1566                 }
1567
1568                 print $fh "   </div>\n";
1569
1570                 print_html_body_end($fh);
1571                 print_html_end($fh);
1572         }
1573         close ($fh);
1574         return $r
1575 }
1576
1577
1578 # ONG the frame + attachment & stiff. NOT update state file.
1579 sub ong {
1580         (
1581                 my $ID, my $ongtime, my $timer, my $update,
1582                 my $settings_ref, my $default_ref, my $data_ref, my $goto_ref
1583         ) = @_;
1584         my @files;
1585         my $cfrt;
1586         my $intf;
1587         my $frame;
1588         my $frame_data_path;
1589         my $write_data;
1590         my $in_path;
1591         my $out_path;
1592         my $r;
1593         my %settings;
1594         my %default;
1595         my %frame_data;
1596         my %frame_full_data;
1597         my %goto_list;
1598
1599         if ($ongtime eq '') {
1600                 $ongtime = time();
1601         }
1602
1603         if ($ID eq 'i') {
1604                 $intf = 1;
1605         }
1606         elsif ($ID eq 'c') {
1607                 $cfrt = 1;
1608         }
1609         else {
1610                 $frame = int($ID);
1611         }
1612
1613         if ($intf) {
1614                 @files = (
1615                         'intf-00.gif',
1616                         'intf-00_04.gif',
1617                         'intf-00_08.gif',
1618                         'intf-00_10.gif',
1619                         'intf-01.gif',
1620                         'intf-01_.gif',
1621                         'intf-02.gif',
1622                         'intf-02_.gif',
1623                         'intf-04.gif',
1624                         'intf-04_.gif',
1625                         'intf-08.gif',
1626                         'intf-08_.gif',
1627                         'intf-10.gif',
1628                         'intf-10_.gif',
1629                         'intf-20.gif',
1630                         'intf-20_.gif',
1631                         'intf-kw.gif',
1632                         'intf-ll.gif',
1633                         'intf-pp.gif',
1634                         'intf-tr.gif',
1635                 );
1636         }
1637         else {
1638                 %settings = (ref ($settings_ref)) ?
1639                         %$settings_ref :
1640                         read_data_file(DATA_SETTINGS_PATH());
1641                 %default = (ref ($default_ref)) ?
1642                         %$default_ref :
1643                         read_data_file(DATA_DEFAULT_PATH());
1644                 $frame_data_path = $cfrt ?
1645                         DATA_NOACCESS_PATH() :
1646                         join_path(PATH_SEPARATOR(), DATA_PATH(), $frame);
1647                 %frame_data = (ref ($data_ref)) ?
1648                         %$data_ref :
1649                         read_data_file($frame_data_path);
1650                 %frame_full_data = merge_settings(\%default, \%frame_data);
1651                 @files = (
1652                         ($frame_full_data{'frame'} ne '') ?
1653                                 $frame_full_data{'frame'} :
1654                                 sprintf(
1655                                         $settings{'frame'},
1656                                         $frame, $frame_full_data{'ext'}
1657                                 )
1658                         ,
1659                 );
1660                 unless ($cfrt) {
1661                         %goto_list = (ref ($goto_ref)) ?
1662                                 %$goto_ref :
1663                                 read_data_file(DATA_LIST_PATH());
1664                         for (my $i=0; ;$i+=1) {
1665                                 my %file_data = read_data_file(DATA_ATTACH_PATH().$i);
1666                                 if ($file_data{'frame'} eq '') {
1667                                         last;
1668                                 }
1669                                 if (int($file_data{'frame'}) != $frame) {
1670                                         next;
1671                                 }
1672                                 if ($file_data{'content'} ne '') {
1673                                         next;
1674                                 }
1675                                 unshift @files, $file_data{'filename'};
1676                         }
1677                         if (
1678                                 (!$update) ||
1679                                 ($frame_full_data{'ongtime'} eq '')
1680                         ) {
1681                                 $frame_data{'ongtime'} = $ongtime;
1682                                 $write_data = 1;
1683                         }
1684                         if (
1685                                 ($timer ne '') && (
1686                                         (!$update) ||
1687                                         ($frame_full_data{'timer'} eq '')
1688                                 )
1689                         ) {
1690                                 $frame_data{'timer'} = int($timer);
1691                                 $write_data = 1;
1692                         }
1693                         if ($write_data) {
1694                                 $r = write_data_file($frame_data_path, '', '', \%frame_data);
1695                         }
1696                         unless ($r) {
1697                                 return $r;
1698                         }
1699                         $goto_list{'title-'  .$frame} = $frame_full_data{'title'};
1700                         $goto_list{'ongtime-'.$frame} = $frame_full_data{'ongtime'};
1701                         $r = write_data_file(DATA_LIST_PATH(), '', '', \%goto_list);
1702                         unless ($r) {
1703                                 return $r;
1704                         }
1705                 }
1706         }
1707         foreach my $file (@files) {
1708                 $in_path  = join_path(PATH_SEPARATOR(), DATA_PATH(), $file);
1709                 $out_path = join_path(PATH_SEPARATOR(), WWW_PATH() , $file);
1710                 $r = copy($in_path, $out_path);
1711                 unless ($r) {
1712                         return $r
1713                 }
1714         }
1715
1716         return 1;
1717 }
1718
1719 1