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