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