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  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',
  40         'failpage', 'fail_method', 'fail_content_type',
  41         'get_remote_addr', 'get_frame', 'get_password',
  42         'merge_settings',
  43         'print_viewer_page',
  44         'write_index',
  45
  46         'readdatafile', 'writedatafile', 'printdatafile', # TO REMOVE
  47         'entityencode', # TO REMOVE
  48         'printdatafileht', # TO REMOVE ???
  49         'gethttpheader', 'getcgi', # TO REMOVE
  50         'urldecode', # TO REMOVE
  51         'urlencode', # TO REMOVE
  52         'linehtml', # TO REMOVE
  53         'bb2ht', 'bb2bb' # TO REMOVE
  54 );
  55
  56 ###PERL_LIB: use lib /botm/lib/bsta
  57 use botm_common (
  58         'url_query_decode', 'url_query_encode',
  59         'url_decode', 'url_encode',
  60         'html_entity_encode_dec',
  61         'merge_url',
  62         'read_header_env',
  63         'read_data_file', 'write_data_file',
  64         'join_path'
  65 );
  66
  67 ###PERL_PATH_SEPARATOR:     PATH_SEPARATOR     = /
  68
  69 ###PERL_CGI_PATH:           CGI_PATH           = /bsta/
  70 ###PERL_CGI_BBCODE_PATH:    CGI_BBCODE_PATH    = /bsta/b
  71 ###PERL_CGI_CSS_PATH:       CGI_CSS_PATH       = /bsta/bsta.css
  72 ###PERL_CGI_FRAME_PATH:     CGI_FRAME_PATH     = /bsta/f
  73 ###PERL_CGI_GOTO_PATH:      CGI_GOTO_PATH      = /bsta/g
  74 ###PERL_CGI_INFO_PATH:      CGI_INFO_PATH      = /bsta/i
  75 ###PERL_CGI_LOGO_PATH:      CGI_LOGO_PATH      = /bsta/botmlogo.png
  76 ###PERL_CGI_TIMER_PATH:     CGI_TIMER_PATH     = /bsta/timer.js
  77 ###PERL_CGI_VIEWER_PATH:    CGI_VIEWER_PATH    = /bsta/v
  78
  79 ###PERL_DATA_PATH:          DATA_PATH          = /botm/data/bsta/
  80 ###PERL_DATA_DEFAULT_PATH:  DATA_DEFAULT_PATH  = /botm/data/bsta/default
  81
  82 ###PERL_WWW_INDEX_PATH:     WWW_INDEX_PATH     = /botm/www/1190/bsta/index.htm
  83
  84 ###PERL_SCHEME:             SCHEME             = http
  85 ###PERL_WEBSITE:            WEBSITE            = 1190.bicyclesonthemoon.info
  86 ###PERL_WEBSITE_NAME:       WEBSITE_NAME       = Bicycles on the Moon
  87 ###PERL_FAVICON_PATH:       FAVICON_PATH       = /img/favicon.png
  88
  89
  90 use constant STATE => {
  91         'inactive' => 0,
  92         'waiting'  => 1,
  93         'ready'    => 2,
  94         'end'      => 3,
  95 };
  96 use constant INTF_STATE => {
  97         'X'  => 0b000000,
  98         'x'  => 0b000000,
  99         '||' => 0b000001,
 100         '>>' => 0b000100,
 101         '>>|'=> 0b000101,
 102         '<<' => 0b001000,
 103         '|<<'=> 0b001001,
 104         '>'  => 0b010000,
 105         '>|' => 0b010001,
 106         'mask'=>0b111111,
 107         'mode'=>0b111110,
 108 };
 109 use constant TEXT_MODE => {
 110         'normal' => 0,
 111         'bb'     => 1,
 112         'info'   => 2,
 113 };
 114
 115 use constant tags_bbcode => {
 116         'ht'    => '',
 117         '/ht'   => '',
 118         'fq'    => '[quote]',
 119         '/fq'   => '[/quote]',
 120         'tq'    => '[quote]',
 121         '/tq'   => '[/quote]',
 122         'ni'    => '[color=#0057AF]',
 123         '/ni'   => '[/color]',
 124         'br'    => '[color=#BB6622]',
 125         '/br'   => '[/color]',
 126         'po'    => '[color=#FF8800]',
 127         '/po'   => '[/color]',
 128         'url'   => '[url]',
 129         'url='  => '[url=',
 130         'url/=' => ']',
 131         '/url'  => '[/url]',
 132         'i'     => '[i]',
 133         '/i'    => '[/i]',
 134         'list'  => '[list]',
 135         'list=' => '[list=',
 136         'list/='=> ']',
 137         '/list' => '[/list]',
 138         '*'     => '[*]',
 139         '/*'    => '[/*]',
 140         '?'     => '[unknown!]',
 141         '/?'    => '[/unknown!]',
 142 };
 143 use constant tags_html => {
 144         'ht'     => '',
 145         '/ht'    => '',
 146         'fq'     => '<div class="fq">',
 147         '/fq'    => '</div>',
 148         'tq'     => '<div class="tq">',
 149         '/tq'    => '</div>',
 150         'ni'     => '<span class="ni">',
 151         '/ni'    => '</span>',
 152         'br'     => '<span class="br">',
 153         '/br'    => '</span>',
 154         'po'     => '<span class="po">',
 155         '/po'    => '</span>',
 156         'url'    => '<a href="#">',#think: how to add selfincluding?
 157         'url='   => '<a href="',
 158         'url/='  => '">',
 159         '/url'   => '</a>',
 160         'i'      => '<i>',
 161         '/i'     => '</i>',
 162         'list'   => '<ul>',
 163         'list='  => '<ol style="list-style-type: ',
 164         'list=1' => 'decimal',
 165         'list=A' => 'upper-alpha',
 166         'list=a' => 'lower-alpha',
 167         'list=I' => 'upper-roman',
 168         'list=i' => 'lower-roman',
 169         'list/=' => '">',
 170         '/list'  => '</ul>',
 171         '/list=' => '</ol>',
 172         '*'      => '<li>',
 173         '/*'     => '</li>',
 174         '?'      => '[unknown!]',
 175         '/?'     => '[/unknown!]',
 176 };
 177
 178
 179
 180 # Function to return an error page
 181 # arguments: 1 - header fields, 2 - page title, 3 - error message, 4 method
 182 sub failpage {
 183         (my $header, my $title, my $message, my $method) = @_;
 184         if($header ne ''){
 185                 print $header;
 186         }
 187         if($method eq 'HEAD') {
 188                 print "\n";
 189                 return;
 190         }
 191         print "Content-type: text/html; charset=UTF-8\n\n";
 192
 193         print '<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "">'."\n";
 194         print ' <html lang="en">'."\n";
 195         print '  <head>'."\n";
 196         print '   <meta http-equiv="Content-type" content="text/html; charset=UTF-8">'."\n";
 197         if ($title ne '') {
 198                 print '   <title>'.html_entity_encode_dec($title, 1).'</title>'."\n";
 199         }
 200         print '  </head>'."\n";
 201         print ' <body>'."\n";
 202         if ($title ne '') {
 203                 print '  <h1>'.html_entity_encode_dec($title, 1).'</h1>'."\n";
 204         }
 205         if ($message ne '') {
 206                 print '  <p>'.html_entity_encode_dec($message, 1).'</p>'."\n";
 207         }
 208         print ' </body>'."\n";
 209         print '</html>'."\n";
 210 }
 211
 212 sub fail_method {
 213         (my $method, my $allowed) = @_;
 214
 215         my $header = "Status: 405 Method Not Allowed\n";
 216         if ($allowed ne '') {
 217                 $header .= "Allow: $allowed\n";
 218         }
 219         return failpage(
 220                 $header,
 221                 "405 Method Not Allowed",
 222                 "The interface does not support the $method method.",
 223                 $method
 224         );
 225 }
 226
 227 sub fail_content_type
 228 {
 229         (my $content_type, my $method) = @_;
 230
 231         return failpage(
 232                 "Status: 415 Unsupported Media Type\n",
 233                 "415 Unsupported Media Type",
 234                 "Unsupported Content-type: $content_type.",
 235                 $method
 236         );
 237 }
 238
 239 # function to obtain address of remote agent
 240 sub get_remote_addr {
 241         if ($ENV{'HTTP_X_FORWARDED_FOR'} =~ /^.+$/) {
 242                 return $&;
 243         }
 244         elsif ($ENV{'REMOTE_ADDR'} =~ /^.+$/) {
 245                 return $&;
 246         }
 247         else {
 248                 return '0.0.0.0';
 249         }
 250 }
 251
 252 # function to obtain frame number
 253 sub get_frame {
 254         (my $cgi) = @_;
 255
 256         if ($cgi->{'f'} =~ /^.+$/) {
 257                 return int($&);
 258         }
 259         elsif ($ENV{'PATH_INFO'} =~ /^\/(.+)$/) {
 260                 return int($1);
 261         }
 262         else {
 263                 return 0;
 264         }
 265 }
 266
 267 # function to obtain password
 268 sub get_password {
 269         (my $cgi) = @_;
 270
 271         if ($cgi->{'p'} =~ /^.+$/) {
 272                 return $&;
 273         }
 274         else {
 275                 return '';
 276         }
 277 }
 278
 279 sub merge_settings {
 280                 my %final_settings;
 281
 282         foreach my $settings (@_) {
 283                 foreach my $ind (keys %$settings) {
 284                         $final_settings{$ind} = $settings->{$ind};
 285                 }
 286         }
 287         return %final_settings;
 288 }
 289
 290 # TO REMOVE
 291 # function to encode entities, decimal,
 292 sub entityencode {
 293         (my $t, my $all) = @_;
 294         return html_entity_encode_dec($t, 1, $all);
 295 }
 296
 297 # TO REMOVE
 298 # function to get values of http header fields. Returns a hash. names of header
 299 # fields are lowercase
 300 sub gethttpheader {
 301         (my $env) = @_;
 302
 303         return read_header_env($env);
 304 }
 305
 306 # TO REMOVE
 307 # The function to get CGI parameters from string.
 308 # Format is: name=url_encoded_value&name=url_encoded_value& ... &name=url_encoded_value
 309 sub getcgi {
 310         return url_query_decode($_[0]);
 311 }
 312
 313 # TO REMOVE
 314 # Function for decoding URL-encoded text
 315 sub urldecode {
 316         return url_decode($_[0]);
 317 }
 318
 319 # TO REMOVE
 320 # Function to read data from datafiles.
 321 # Very similar to http header file reading. (function readheaderfile() in proxy
 322 # library)
 323 #
 324 # Differences:
 325 #
 326 # 1. After field name and colon there must be exactly one whitespace (space or
 327 # tab). Any other leading or trailing whitespace (but not the newline character
 328 # at the end of the line) is treated as part of the field value.
 329 #
 330 # 2. Instead of colon an equal sign can be used. The number of whitespaces after
 331 # it is then zero and not one.
 332 #
 333 # 3. When header field is split into multiple lines the next lines must start
 334 # with exactly one whitespace (tab or space) Any other leading or trailing
 335 # whitespace (but not the newline character at the end of the line) is treated
 336 # as part of the field value. the lines will be joined with a newline between
 337 # them.
 338 #
 339 # 4. When the same field name appears it replaces the previous one.
 340 #
 341 # 5. Line separator is LF and not CR LF. The CR character is treated as part of
 342 # the field value.
 343 #
 344 # 6. After the end of header (double newline) all next lines are treated as the
 345 # value of the "content" field.
 346 #
 347 # Returns a hash containing the values.
 348 # Names are case sensitive and are converted to lowercase
 349 #
 350 # Argument can be a path or a file handle. In case of a file handle it will just
 351 # read the file. In case of path it opens the file before reading and closes
 352 # after. On failure (file not open) returns empty hash.
 353 #
 354 sub readdatafile {
 355         (my $datapath) = @_;
 356
 357         return read_data_file($datapath);
 358 }
 359
 360 # TO REMOVE
 361 # the function to write data to datafiles (see readdatafile() description)
 362 #
 363 # First argument can be a path or a file handle. In case of a file handle it
 364 # will just write the file. In case of path it opens the file before writing and
 365 # closes after.
 366 #
 367 # On failure (file not open) returns 0.
 368 # On success returns 1.
 369 #
 370 sub writedatafile {
 371         (my $headerpath, my %header) = @_;
 372
 373         return write_data_file($headerpath, '', 0, \%header);
 374 }
 375
 376 # TO REMOVE
 377 # the function to print data to stdout (see readdatafile() description)
 378 #
 379 # On success returns 1.
 380 #
 381 sub printdatafile {
 382         (my %header) = @_;
 383
 384         return write_data_file(\*STDOUT, '', 0, \%header);
 385 }
 386
 387 # TO REMOVE
 388 # the function to print data to stdout as html (see readdatafile() description)
 389 #
 390 # On success returns 1.
 391 #
 392 sub printdatafileht {
 393         (my %header) = @_;
 394
 395         print_html_data(\*STDOUT, \%header);
 396         return 1;
 397 }
 398
 399 # TO REMOVE
 400 sub urlencode {
 401         (my $t, my $all) = @_;
 402         return url_encode($t, '', $all);
 403 }
 404
 405 # BB code stuff
 406 # different & simpler implementation than in post library
 407 # to consider:
 408 # a BBcode library?
 409
 410 #analyse bbcode text to build tag tree
 411 #TODO make [/*] optional!
 412 sub bbtree {
 413         (my $bb, my $printdebug) = @_;
 414         my %bbtree;
 415         my $ind;
 416         my $tag;
 417         my $tag_name;
 418         my $tag_value;
 419         my $tag_end;
 420         my $level=0;
 421         my $pre_text;
 422         my $debug;
 423
 424         $ind="_";
 425         $level=0;
 426         $bbtree{"_.name" }  = "ht";
 427         $bbtree{"_.value" } = '';
 428         $bbtree{"_.type"  } = "tag";
 429         $bbtree{"_.count" } = 0;
 430         $bbtree{"_.closed"} = 0;
 431         $debug .= debug($printdebug,
 432                 "\n".
 433                 "<!--GENERATING BBCODE TREE:\n".
 434                 '[_]automatic tag: [ht]'."\n"
 435         );
 436
 437         while ($bb ne '') {
 438                 my $new_ind = $ind.'.'.$bbtree{$ind.'.count'};
 439
 440                 if($bb =~ m/\[(\/?)([a-z]+|\*)(=([^\[\]]*))?\]/g) {
 441                         $pre_text = $`;
 442                         $tag = $&;
 443                         $tag_end = $1;
 444                         $tag_name = $2;
 445                         $tag_value = $4;
 446                         $bb = $';
 447
 448                         if ($pre_text ne '') {
 449                                 $debug .= debug($printdebug, "[$new_ind]text: $pre_text\n");
 450                                 $bbtree{$new_ind.'.type' } = 'text';
 451                                 $bbtree{$new_ind.'.value'} = $pre_text;
 452                                 $bbtree{    $ind.'.count'}+= 1;
 453                                 $new_ind = $ind.'.'.$bbtree{$ind.'.count'};
 454                         }
 455
 456                         if($tag_name =~ /^(fq|tq|br|ni|po|url|i|list|\*)$/) {
 457                                 if ($tag_end ne '') {
 458                                         if (
 459                                                 ($tag_name ne $bbtree{$ind.'.name'}) ||
 460                                                 ($level <= 0)
 461                                         ) {
 462                                                 $debug .= debug($printdebug, "[$new_ind]text: $tag\n");
 463                                                 $bbtree{$new_ind.'.type' } = 'text';
 464                                                 $bbtree{$new_ind.'.value'} = $tag;
 465                                                 $bbtree{    $ind.'.count'}+= 1;
 466                                                 # $new_ind = $ind.'.'.$bbtree{$ind.'.count'};
 467                                         }
 468                                         else {
 469                                                 $debug .= debug($printdebug, "[$new_ind]tag: $tag\n");
 470                                                 $bbtree{$new_ind.'.type'  } = 'tag';
 471                                                 $bbtree{$new_ind.'.name'  } = '/'.$tag_name;
 472                                                 $bbtree{$new_ind.'.value' } = $tag_value;
 473                                                 $bbtree{    $ind.'.count' }+= 1;
 474                                                 $bbtree{    $ind.'.closed'} = 1;
 475                                                 $level -= 1;
 476                                                 $ind =~ s/\.[0-9]+$//;
 477                                                 # $new_ind = $ind.'.'.$bbtree{$ind.'.count'};
 478                                         }
 479                                 }
 480                                 else
 481                                 {
 482                                         $debug .= debug($printdebug, "[$new_ind]tag: $tag\n");
 483                                         $bbtree{$new_ind.'.type'  } = 'tag';
 484                                         $bbtree{$new_ind.'.name'  } = $tag_name;
 485                                         $bbtree{$new_ind.'.value' } = $tag_value;
 486                                         $bbtree{$new_ind.'.count' } = 0;
 487                                         $bbtree{$new_ind.'.closed'} = 0;
 488                                         $bbtree{    $ind.'.count' }+= 1;
 489                                         $level += 1;
 490                                         $ind = $new_ind;
 491                                         # $new_ind = $ind.'.'.$bbtree{$ind.'.count'};
 492                                 }
 493                         }
 494                         else {
 495                                 $debug .= debug($printdebug, "[$new_ind]text: $tag\n");
 496                                 $bbtree{$new_ind.'.type' } = 'text';
 497                                 $bbtree{$new_ind.'.value'} = $tag;
 498                                 $bbtree{    $ind.'.count'}+= 1;
 499                                 # $new_ind = $ind.'.'.$bbtree{$ind.'.count'};
 500                         }
 501                 }
 502                 else {
 503                         $debug .= debug($printdebug, "[$new_ind]text: $bb\n");
 504                         $bbtree{$new_ind.'.type' } = 'text';
 505                         $bbtree{$new_ind.'.value'} = $bb;
 506                         $bbtree{    $ind.'.count'}+= 1;
 507                         # $new_ind = $ind.'.'.$bbtree{$ind.'.count'};
 508                         $bb = '';
 509                 }
 510         }
 511         my $final_ind = '_.'.$bbtree{"_.count"};
 512         $debug .= debug($printdebug, "[$final_ind]automatic tag: [/ht]\n -->\n");
 513         $bbtree{$final_ind.'.type' } = "tag";
 514         $bbtree{$final_ind.'.name' } = '/ht';
 515         $bbtree{         '_.count' }+= 1;
 516         $bbtree{         '_.closed'} = 1;
 517
 518         return ($debug, %bbtree);
 519 }
 520
 521 #convert tag tree to final text
 522 sub convtree {
 523         (my $printdebug, my $debug, my $lang, my $bbtree) = @_;
 524         my $out;
 525         my $ind;
 526         my $indd;
 527         my $level = 0;
 528         my $tags = ($lang eq 'html') ? tags_html : tags_bbcode;
 529         my $escape = ($lang eq 'html');
 530
 531         # $debug .= debug($printdebug, "\n****\n");
 532         # foreach my $iiii (keys %tags) {
 533                 # $debug .= debug($printdebug, $iiii.'='.$tags->{$iiii}."\n");
 534         # }
 535         # $debug .= debug($printdebug, "****\n");
 536
 537         $level = 0;
 538         $ind = '_';
 539         $out = '';
 540         $debug .= debug($printdebug, "\n<!--PROCESSING BBCODE TREE:\n");
 541
 542         while ($level >= 0) {
 543                 my $goto_next = '';
 544                 $debug .= debug($printdebug, "[$level:$ind:".int($bbtree->{$ind.'.count'})."]");
 545                 #normal text
 546                 if ($bbtree->{$ind.'.type'} eq 'text') {
 547                         my $text = $bbtree->{$ind.'.value'};
 548                         $debug .= debug($printdebug, "text: ".$text);
 549                         $out .= $escape ? html_encode_line($text) : $text;
 550
 551                         $goto_next = 'tx';
 552                 }
 553                 #tag
 554                 elsif ($bbtree->{$ind.'.type'} eq 'tag') {
 555                         my $name = $bbtree->{$ind.'.name'};
 556                         #endtag
 557                         if ($name =~ /^\//) {
 558                                 $debug .= debug($printdebug, "tag: [$name]");
 559                                 $indd = $ind;
 560                                 $indd =~ s/\.([0-9]+)$//;
 561                                 if (exists($tags->{$name.'='}) && ($bbtree->{$indd.'.value'} ne '')) {
 562                                         $out .= $tags->{$name.'='};
 563                                 }
 564                                 elsif (exists($tags->{$name})) {
 565                                         $out .= $tags->{$name};
 566                                 }
 567                                 else {
 568                                         $out .= $tags->{'/?'};
 569                                         $debug .= debug($printdebug, "[unknown!]");
 570                                 }
 571
 572                                 $ind =~ s/\.([0-9]+)$//;
 573                                 $level -= 1;
 574                                 $debug .= debug($printdebug, "[<]");
 575                                 if ($level > 0) {
 576                                         $goto_next = 'nd';
 577                                 }
 578                                 else {
 579                                         # time to end this
 580                                         $level = -1;
 581                                 }
 582                         }
 583                         #starttag
 584                         else {
 585                                 my $value = $bbtree->{$ind.'.value'};
 586                                 if($bbtree->{$ind.'.closed'} ne '') {
 587                                         $debug .= debug($printdebug, "tag: [$name]");
 588
 589                                         if (exists($tags->{$name.'='}) && ($value ne '')) {
 590                                                 if (exists($tags->{$name.'='.$value})) {
 591                                                         $out .=
 592                                                                 $tags->{$name.'='} .
 593                                                                 $tags->{$name.'='.$value} .
 594                                                                 $tags->{$name.'/='};
 595                                                 }
 596                                                 else {
 597                                                         $out .=
 598                                                                 $tags->{$name.'='} .
 599                                                                 ($escape ? html_entity_encode_dec($value, 1) : $value) .
 600                                                                 $tags->{$name.'/='};
 601                                                 }
 602                                         }
 603                                         elsif (exists($tags->{$name})) {
 604                                                 $out .= $tags->{$name};
 605                                         }
 606                                         else {
 607                                                 $out .= $out.$tags->{'?'};
 608                                                 $debug .= debug($printdebug, "[unknown!]");
 609                                         }
 610                                 }
 611                                 else {
 612                                         $debug .= debug($printdebug, "unclosed tag: [$name]");
 613                                         my $text = $name . (($value ne '') ? ('='.$value) : '');
 614                                         $out .= '['.($escape ? html_encode_line($text) : $text).']';
 615                                 }
 616                                 if ($bbtree->{$ind.'.count'} > 0) {
 617                                         $ind = $ind.'.0';
 618                                         $level += 1;
 619                                         $debug .= debug($printdebug, "[>]");
 620                                 }
 621                                 else {
 622                                         $goto_next = 'st';
 623                                 }
 624                         }
 625                 }
 626                 # what is this
 627                 else {
 628                         $debug .= debug($printdebug, "unknown thing: ".$bbtree->{$ind.'.type'});
 629                         #should not occur with a correct bbtree
 630                         #unless unimplemented
 631                         $ind =~ s/\.([0-9]+)$//;
 632                         $level -= 1;
 633                         $debug .= debug($printdebug, "[<ui]");
 634                         if ($level > 0) {
 635                                 $goto_next = 'un';
 636                         }
 637                         else {
 638                                 # time to end this
 639                                 $level = -1;
 640                         }
 641                 }
 642                 if ($goto_next ne '') {
 643                         {do{
 644                                 $ind =~ s/\.([0-9]+)$//;
 645                                 my $i = int($1) + 1;
 646                                 if (($i < $bbtree->{$ind.'.count'}) and ($1 ne '')){
 647                                         # goto next
 648                                         $ind = $ind.'.'.$i;
 649                                         last;
 650                                 }
 651                                 else {
 652                                         # step out
 653                                         # should not occur with a correct bbtree
 654                                         $debug .= debug($printdebug, "[<$goto_next]");
 655                                         $level -= 1;
 656                                 }
 657                         } while ($level >= 0);}
 658                 }
 659
 660                 $debug .= debug($printdebug, "[>$level:$ind]\n");
 661         }
 662
 663         $debug .= debug($printdebug, "-->\n");
 664         return ($debug, $out);
 665 }
 666
 667 #bbcode to html, TBD
 668 sub bb_to_html {
 669         (my $bb, my $printdebug) = @_;
 670         my $ht;
 671         my %bbtree;
 672         my $debug;
 673
 674         ($debug, %bbtree) = bbtree($bb, $printdebug);
 675         ($debug, $ht) = convtree ($printdebug, $debug, 'html', \%bbtree);
 676
 677         return $ht;
 678 }
 679
 680 #bbcode to bb, TBD
 681 sub bb_to_bbcode {
 682         (my $bb, my $printdebug) = @_;
 683         my $ht;
 684         my %bbtree;
 685         my $debug;
 686
 687         ($debug, %bbtree) = bbtree($bb, $printdebug);
 688         ($debug, $ht) = convtree ($printdebug, $debug, 'bb', \%bbtree);
 689
 690         return $ht;
 691 }
 692
 693 # TO REMOVE
 694 sub bb2ht {
 695         return bb_to_html(@_);
 696 }
 697
 698 # TO REMOVE
 699 sub bb2bb {
 700         return bb_to_bbcode(@_);
 701 }
 702
 703 sub eval_bb {
 704         (my $bb) = @_;
 705         my $value;
 706         my $before;
 707         my $after;
 708
 709         while ($bb =~ m/###([^#;]*);/g) {
 710                 $value = $1;
 711                 $before = $`;
 712                 $after = $';
 713
 714                 if ($value =~ /^att&([0-9]+)$/) {
 715                         $value = merge_url(
 716                                 SCHEME().WEBSITE(),
 717                                 CGI_ATTACH_PATH(),
 718                                 int($1)
 719                         )
 720                 }
 721                 elsif ($value =~ /^vw&([0-9]+)$/) {
 722                         $value = merge_url(
 723                                 SCHEME().WEBSITE(),
 724                                 CGI_VIEWER_PATH(),
 725                                 int($1)
 726                         )
 727                 }
 728                 elsif ($value =~ /^fr&([0-9]+)$/) {
 729                         $value = merge_url(
 730                                 SCHEME().WEBSITE(),
 731                                 CGI_FRAME_PATH(),
 732                                 int($1)
 733                         )
 734                 }
 735                 else {
 736                         $value = '';
 737                 }
 738                 $bb = $before . $value . $after;
 739         }
 740         return $bb;
 741 }
 742
 743
 744 sub html_encode_line {
 745         (my $text, my $non_ascii, my $all) = @_;
 746         my $html;
 747         my $ind;
 748
 749         $text =~ s/\r\n/\n/gs;
 750         $text =~ s/\r/\n/gs;
 751
 752         while ($text ne '') {
 753                 $ind = index($text, "\n");
 754                 if ($ind >= 0) {
 755                         $html .= html_entity_encode_dec(substr($text, 0, $ind), $non_ascii, $all)."<br>\n";
 756                         $text = substr($text, $ind+1);
 757                 }
 758                 else
 759                 {
 760                         $html .= html_entity_encode_dec($text, 1);
 761                         $text = '';
 762                 }
 763         }
 764         return $html;
 765 }
 766
 767 # TO REMOVE
 768 sub linehtml {
 769         return html_encode_line($_[0], 1);
 770 }
 771
 772 sub debug {
 773         (my $print, my $text) = @_;
 774
 775         if ($print) {
 776                 print $text;
 777         }
 778
 779         return $text;
 780 }
 781
 782
 783 sub print_html_start {
 784         (my $fh) = @_;
 785         print $fh '<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "">'."\n";
 786         print $fh '<html lang="en">'."\n";
 787 }
 788
 789 sub print_html_end {
 790         (my $fh) = @_;
 791         print $fh '</html>'."\n";
 792 }
 793
 794 sub print_html_head_start {
 795         (my $fh) = @_;
 796         print $fh ' <head>'."\n";
 797         print $fh '  <meta http-equiv="Content-type" content="text/html; charset=UTF-8">'."\n";
 798         print $fh '  <link rel="icon" type="image/png" href="'.html_entity_encode_dec(FAVICON_PATH(),1).'">'."\n";
 799         print $fh '  <link rel="stylesheet" href="'.html_entity_encode_dec(CGI_CSS_PATH(),1).'">'."\n";
 800 }
 801
 802 sub print_html_head_end {
 803         (my $fh) = @_;
 804         print $fh ' </head>'."\n";
 805 }
 806
 807 sub print_html_body_start {
 808         (my $fh) = @_;
 809         print $fh ' <body>'."\n";
 810         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";
 811         print $fh '  <div id="all">'."\n";
 812 }
 813
 814 sub print_html_body_end {
 815         (my $fh) = @_;
 816         print $fh '  </div>'."\n";
 817         print $fh '  <a href="/" class="cz">'.html_entity_encode_dec(WEBSITE(),1).'</a>'."\n";
 818         print $fh ' </body>'."\n";
 819 }
 820
 821 sub print_html_data {
 822         (my $fh, my $data) = @_;
 823
 824         foreach my $key (keys %$data) {
 825                 unless ($key eq 'content') {
 826                         my $val = $data->{$key};
 827                         $val =~ s/(\r)?\n/\n /gs; # does the space make sense in HTML anyway?
 828                         print $fh html_encode_line("$key: $val\n", 1);
 829                 }
 830         }
 831         print $fh html_encode_line("\n".$data->{'content'});
 832 }
 833
 834 sub print_viewer_page {
 835         (
 836                 my $file,
 837                 my $context,
 838                 my $state,
 839                 my $settings,
 840                 my $frame_data,
 841                 my $next_frame_data
 842         ) = @_;
 843         my $fh;
 844
 845         my $frame = int($context->{'frame'});
 846         # my $prev_frame = $frame - 1;
 847         my $next_frame = $frame + 1;
 848
 849         my $story = $settings->{'story'};
 850         my $title = $frame_data->{'title'};
 851         my $command = ($frame_data->{'command'} ne '') ?
 852                 $frame_data->{'command'} :
 853                 $next_frame_data->{'title'};
 854
 855         my $access      = $context->{'access'};
 856         my $password_ok = $context->{'password_ok'};
 857         my $static      = $context->{'static'};
 858
 859         my $text_mode      = int($context->{'text_mode'});
 860         my $timer_unlocked = int($context->{'timer_unlocked'});
 861         my $timer          = int($context->{'timer'});
 862
 863         my $last_frame = int($state->{'last'});
 864         my $ong_state  = int($state->{'state'});
 865
 866         my $timer_color_h = (($timer_unlocked >= 1) || ($ong_state >= STATE->{'ready'})) ? 'br' : 'ni';
 867         my $timer_color_m = (($timer_unlocked >= 2) || ($ong_state >= STATE->{'ready'})) ? 'br' : 'ni';
 868         my $timer_color_s = (($timer_unlocked >= 3) || ($ong_state >= STATE->{'ready'})) ? 'br' : 'ni';
 869
 870         my $timer_h;
 871         my $timer_m;
 872         my $timer_s;
 873         if ($timer > 0) {
 874                 $timer_s = sprintf('%02d', $timer % 60);
 875                 $timer_h = int($timer / 60);
 876                 $timer_m = sprintf('%02d', $timer_h % 60);
 877                 $timer_h = sprintf('%02d', $timer_h / 60);
 878         }
 879         elsif (($timer >= -15) && ($ong_state >= STATE->{'ready'})) {
 880                 $timer_h = '00';
 881                 $timer_m = '00';
 882                 $timer_s = 'NG';
 883         }
 884         else {
 885                 $timer_h = 'EE';
 886                 $timer_m = 'EE';
 887                 $timer_s = 'EE';
 888         }
 889
 890         my $prev_available = (($frame > 0) && $access);
 891         my $next_available = ($password_ok || ($next_frame <= $last_frame));
 892         my $prefetch_next  = (
 893                 $password_ok ||
 894                 ($next_frame < $last_frame) || (  # avoid unseen trigger!
 895                         ($next_frame <= $last_frame) &&
 896                         ($ong_state >= STATE->{'ready'})
 897                 )
 898         );
 899         my $show_timer = (
 900                 ($frame == $last_frame) && (
 901                         ($ong_state == STATE->{'waiting'}) ||
 902                         ($ong_state == STATE->{'ready'})
 903                 )
 904         );
 905         my $show_command = (
 906                 $password_ok ||
 907                 (!$access) ||
 908                 ($frame < $last_frame) || (
 909                         ($ong_state >= STATE->{'ready'}) &&
 910                         $context->{'show_command'}
 911                 )
 912         );
 913         my $show_command_link = ($next_available || (!$access));
 914         my $show_command_cursor = ((!$next_available) || ($command eq ''));
 915         my $frame_indirect = !(
 916                 (!$access) || (
 917                         ($frame <= $last_frame) &&
 918                         ($ong_state > STATE->{'inactive'})
 919                 )
 920         );
 921         my $nextframe_indirect = !($next_frame <= $last_frame);
 922
 923         my $password_query;
 924
 925         my $base_url   = CGI_PATH;
 926         my $goto_url   = CGI_GOTO_PATH;
 927         my $info_url   = CGI_INFO_PATH;
 928         my $bbcode_url = CGI_BBCODE_PATH;
 929         my $timer_url  = CGI_TIMER_PATH;
 930         my $viewer_full_url = merge_url(
 931                 {'scheme' => SCHEME(), 'host' => WEBSITE()},
 932                 {'path' => CGI_VIEWER_PATH()},
 933                 {'path' => $frame}
 934         );
 935         my $viewer_url = merge_url(
 936                 {'path' => CGI_VIEWER_PATH()},
 937                 {'path' => $frame}
 938         );
 939         my $viewer_0_url = merge_url(
 940                 {'path' => CGI_VIEWER_PATH()},
 941                 {'path' => 0}
 942         );
 943         my $viewer_prev_url = merge_url(
 944                 {'path' => CGI_VIEWER_PATH()},
 945                 {'path' => $frame-1}
 946         );
 947         my $viewer_next_url = merge_url(
 948                 {'path' => CGI_VIEWER_PATH()},
 949                 {'path' => $next_frame}
 950         );
 951         my $viewer_last_url = merge_url(
 952                 {'path' => CGI_VIEWER_PATH()},
 953                 {'path' => ($static ? -1 : $last_frame)}
 954         );
 955         if ($text_mode != TEXT_MODE->{'bb'}) {
 956                 $bbcode_url = merge_url(
 957                         $viewer_url,
 958                         {'query'=>{
 959                                 'b' => TEXT_MODE->{'bb'}
 960                         }}
 961                 );
 962         }
 963         if ($text_mode != TEXT_MODE->{'info'}) {
 964                 $info_url = merge_url(
 965                         $viewer_url,
 966                         {'query'=>{
 967                                 'b' => TEXT_MODE->{'info'}
 968                         }}
 969                 );
 970         }
 971         my $frame_file;
 972         my $frame_url;
 973         my $frame_next_url;
 974         my $frame_normal_url;
 975         my $frame_full_url;
 976         if ($frame_data->{'frame'} ne '') {
 977                 $frame_file = $frame_data->{'frame'};
 978         }
 979         else {
 980                 $frame_file = sprintf(
 981                         $settings->{'frame'},
 982                         $frame, $frame_data->{'ext'}
 983                 );
 984         }
 985         $frame_normal_url = merge_url(
 986                         {'path' => CGI_PATH()},
 987                         {'path' => $frame_file}
 988                 );
 989         $frame_url = $frame_indirect ?
 990                 merge_url(
 991                         {'path' => CGI_FRAME_PATH()},
 992                         {'path' => $frame}
 993                 ) :
 994                 $frame_normal_url;
 995         $frame_full_url = merge_url(
 996                 {'scheme' => SCHEME(), 'host' => WEBSITE()},
 997                 {'path' => $frame_normal_url}
 998         );
 999         if ($nextframe_indirect) {
1000                 $frame_next_url = merge_url(
1001                         {'path' => CGI_FRAME_PATH()},
1002                         {'path' => $next_frame}
1003                 );
1004         }
1005         elsif ($next_frame_data->{'frame'} ne '') {
1006                 $frame_next_url = merge_url(
1007                         {'path' => CGI_PATH()},
1008                         {'path' => $next_frame_data->{'frame'}}
1009                 );
1010         }
1011         else {
1012                 $frame_next_url = merge_url(CGI_PATH(), sprintf(
1013                         $settings->{'frame'}, $next_frame, $next_frame_data->{'ext'}
1014                 ));
1015         }
1016
1017         if ($password_ok) {
1018                 $password_query = url_query_encode({'p', $settings->{'password'}});
1019                 $goto_url        = merge_url($goto_url       , {'query' => $password_query, 'append_query' => 1});
1020                 $info_url        = merge_url($info_url       , {'query' => $password_query, 'append_query' => 1});
1021                 $bbcode_url      = merge_url($bbcode_url     , {'query' => $password_query, 'append_query' => 1});
1022                 $viewer_url      = merge_url($viewer_url     , {'query' => $password_query, 'append_query' => 1});
1023                 $viewer_0_url    = merge_url($viewer_0_url   , {'query' => $password_query, 'append_query' => 1});
1024                 $viewer_prev_url = merge_url($viewer_prev_url, {'query' => $password_query, 'append_query' => 1});
1025                 $viewer_next_url = merge_url($viewer_next_url, {'query' => $password_query, 'append_query' => 1});
1026                 $viewer_last_url = merge_url($viewer_last_url, {'query' => $password_query, 'append_query' => 1});
1027                 if ($frame_indirect) {
1028                         $frame_url     = merge_url($frame_url      , {'query' => $password_query, 'append_query' => 1});
1029                 }
1030                 if ($nextframe_indirect) {
1031                         $frame_next_url= merge_url($frame_next_url , {'query' => $password_query, 'append_query' => 1});
1032                 }
1033         }
1034         my $_base_url        = html_entity_encode_dec($base_url       , 1);
1035         my $_goto_url        = html_entity_encode_dec($goto_url       , 1);
1036         my $_info_url        = html_entity_encode_dec($info_url       , 1);
1037         my $_bbcode_url      = html_entity_encode_dec($bbcode_url     , 1);
1038         my $_timer_url       = html_entity_encode_dec($timer_url      , 1);
1039         my $_viewer_full_url = html_entity_encode_dec($viewer_full_url, 1);
1040         my $_viewer_url      = html_entity_encode_dec($viewer_url     , 1);
1041         my $_viewer_0_url    = html_entity_encode_dec($viewer_0_url   , 1);
1042         my $_viewer_prev_url = html_entity_encode_dec($viewer_prev_url, 1);
1043         my $_viewer_next_url = html_entity_encode_dec($viewer_next_url, 1);
1044         my $_viewer_last_url = html_entity_encode_dec($viewer_last_url, 1);
1045         my $_frame_url       = html_entity_encode_dec($frame_url      , 1);
1046         my $_frame_next_url  = html_entity_encode_dec($frame_next_url , 1);
1047         my $_frame_full_url  = html_entity_encode_dec($frame_full_url , 1);
1048
1049         my $_story   = html_entity_encode_dec($story,   1);
1050         my $_title   = html_entity_encode_dec($title,   1);
1051         my $_command = html_entity_encode_dec($command, 1);
1052
1053         my $_website_name = html_entity_encode_dec(WEBSITE_NAME(), 1);
1054
1055         if ($text_mode == TEXT_MODE->{'info'}) {
1056                 if ($show_command) {
1057                         $frame_data->{'command'} = $command;
1058                 }
1059                 if ($context->{'access'}) {
1060                         $frame_data->{'frame'} = $frame_file;
1061                 }
1062         }
1063
1064         # everything determined, now start generating
1065
1066         if (ref($file)) {
1067                 $fh=$file;
1068                 unless (seek($fh, 0, 0)) {
1069                         #don't actually fail here
1070                 }
1071         }
1072         else {
1073                 unless (open ($fh, ">:encoding(UTF-8)", encode('locale_fs', $file))) {
1074                         return 0;
1075                 }
1076         }
1077
1078         print_html_start($fh);
1079         print_html_head_start($fh);
1080
1081         print $fh '  <title>'.$_title;
1082         if ($story ne $title) {
1083                 print $fh ' &bull; '.$_story;
1084         }
1085         print $fh ' &bull; '.$_website_name.'</title>'."\n";
1086         print $fh '  <link rel="index" href="'.$_goto_url.'">'."\n";
1087         print $fh '  <link rel="start" href="'.$_viewer_0_url.'">'."\n";
1088         if ($prev_available) {
1089                 print $fh '  <link rel="prev" href="'.$_viewer_prev_url.'">'."\n";
1090         }
1091         if ($next_available) {
1092                 print $fh '  <link rel="next" href="'.$_viewer_next_url.'">'."\n";
1093                 if ($prefetch_next) {
1094                         print $fh '  <link rel="prefetch" href="'.$_viewer_next_url.'">'."\n";
1095                         print $fh '  <link rel="prefetch" href="'.$_frame_next_url.'">'."\n";
1096                 }
1097         }
1098         if ($show_timer) {
1099                 print $fh '  <!-- <script src="'.$_timer_url.'"></script> -->'."\n";
1100         }
1101
1102         print_html_head_end($fh);
1103         print_html_body_start($fh);
1104
1105         print $fh '   <div id="inst" class="ins">'."\n";
1106
1107         print $fh '    <div id="title">'."\n";
1108         print $fh '     <h1 id="titletext">'.$_title.'</h1>'."\n";
1109         print $fh '    </div>'."\n";
1110
1111         print $fh '   </div>'."\n";
1112         print $fh '   <div id="framespace">'."\n";
1113
1114         print $fh '    <img src="'.$_frame_url.'" id="frame" alt="'.$frame.'" title="'.$_title.'">'."\n";
1115
1116         print $fh '   </div>'."\n";
1117         print $fh '   <div id="insb" class="ins">'."\n";
1118
1119         if ($text_mode == TEXT_MODE->{'info'}) {
1120                 print $fh '    <div id="chat">'."\n";
1121
1122                 print_html_data($fh, $frame_data);
1123
1124                 print $fh '    </div>'."\n";
1125         }
1126         elsif ($text_mode == TEXT_MODE->{'bb'}) {
1127                 print $fh '    <div id="chat">'."\n";
1128
1129                 print $fh '[quote][center][size=200]'.$_title.'[/size]<br>'."\n";
1130                 print $fh '[url='.$_viewer_full_url.'][img]'.$_frame_full_url.'[/img][/url][/center]<br>'."\n";
1131                 print $fh html_encode_line(bb_to_bbcode(eval_bb($frame_data->{'content'})));
1132                 print $fh '[/quote]'."\n";
1133
1134                 print $fh '    </div>'."\n";
1135         }
1136         elsif ($frame_data->{'content'} ne '') {
1137                 print $fh '    <div id="undertext">'."\n";
1138                 print $fh bb_to_html(eval_bb($frame_data->{'content'}))."\n";
1139                 print $fh '    </div>'."\n";
1140         }
1141
1142         print $fh '    <div id="command">'."\n";
1143
1144         if ($show_timer) {
1145                 print $fh '     [<span id="ongh" class="'.$timer_color_h.'">'.$timer_h.'</span>';
1146                 print $fh      ':<span id="ongm" class="'.$timer_color_m.'">'.$timer_m.'</span>';
1147                 print $fh      ':<span id="ongs" class="'.$timer_color_s.'">'.$timer_s.'</span>]<br>'."\n";
1148         }
1149         print $fh '&gt;';
1150         if ($show_command_link) {
1151                 print $fh '<a href="'.($access ? $_viewer_next_url : $_viewer_last_url).'">';
1152         }
1153         if ($show_command) {
1154                 print $fh $_command;
1155         }
1156         if ($show_command_cursor) {
1157                 print $fh '<span class="inp">_</span>';
1158         }
1159         if ($show_command_link) {
1160                 print $fh '</a>';
1161         }
1162         print $fh "<br>\n";
1163         print $fh "    </div>\n";
1164
1165         print $fh '    <div id="underlinks">'."\n     ";
1166
1167         unless (($frame == 0) && $static) {
1168                 print $fh '<a href="'.$_base_url.'">Once again</a> | ';
1169         }
1170         if ($prev_available) {
1171                 print $fh '<a href="'.$_viewer_prev_url.'">Before</a> | ';
1172         }
1173         unless ($frame == $last_frame) {
1174                 print $fh '<a href="'.$_viewer_last_url.'">Now</a> | ';
1175         }
1176         print $fh '<a href="'.$_goto_url.'">GOTO</a>'."\n";
1177         print $fh '     <span style="float: right;">'."\n      ";
1178         if ($text_mode != TEXT_MODE->{'normal'}) {
1179                 print $fh '<a href="'.$_viewer_url.'">Without</a> | ';
1180         }
1181         print $fh '<a href="'.$_info_url.'">Info</a> | ';
1182         print $fh '<a href="'.$_bbcode_url.'">BB</a>';
1183         print $fh "\n     </span>\n";
1184
1185         print $fh "    </div>\n";
1186         print $fh "   </div>\n";
1187
1188         print_html_body_end($fh);
1189         print_html_end($fh);
1190
1191
1192         unless (ref($file)) {
1193                 close ($fh);
1194         }
1195         else {
1196                 truncate ($fh , tell($fh));
1197         }
1198
1199         return 1;
1200 }
1201
1202
1203 sub write_index {
1204         (
1205                 my $state,
1206                 my $settings,
1207                 my $pass,
1208                 my $mode,
1209                 my $index
1210         ) = @_;
1211         my $fh;
1212         my $r;
1213
1214         unless (open ($fh, ">:encoding(UTF-8)", encode('locale_fs', WWW_INDEX_PATH()))) {
1215                 return 0;
1216         }
1217
1218         # normal running story
1219         if ($state > STATE->{'inactive'}) {
1220                 my %frame_data     = read_data_file(join_path(PATH_SEPARATOR(), DATA_PATH(), 0));
1221                 my %next_frame_data= read_data_file(join_path(PATH_SEPARATOR(), DATA_PATH(), 1));
1222                 my %default        = read_data_file(DATA_DEFAULT_PATH());
1223
1224                 %frame_data     = merge_settings(\%default,      \%frame_data);
1225                 %next_frame_data= merge_settings(\%default, \%next_frame_data);
1226
1227                 $r = print_viewer_page(
1228                         $fh,
1229                         {
1230                                 'frame' => 0,
1231                                 'access' => 1,
1232                                 'password_ok' => 0,
1233                                 'timer_unlocked' => 3, # not relevant
1234                                 'timer' => 0, # not relevant
1235                                 'static' => 1,
1236                                 'show_command' => 1
1237                         },
1238                         $state,
1239                         $settings,
1240                         \%frame_data,
1241                         \%next_frame_data
1242                 );
1243         }
1244         # no conditions met, pretend a normal Apache2 index
1245         elsif ($pass != 1) {
1246                 my $index_of = CGI_PATH;
1247                 $index_of =~ s/\/$//g;
1248
1249                 my $_index_of = html_entity_encode_dec($index_of, 1);
1250
1251
1252                 print_html_start ($fh);
1253                 print $fh ' <head>'."\n";
1254                 print $fh '  <meta http-equiv="Content-type" content="text/html; charset=UTF-8">'."\n";
1255                 print $fh '  <title>Index of '.$_index_of.'</title>'."\n";
1256                 print $fh ' </head>'."\n";
1257                 print $fh ' <body>'."\n";
1258                 print $fh '  <h1>Index of '.$_index_of.'</h1>'."\n";
1259                 print $fh '  <table>'."\n";
1260                 print $fh '   <tr>'."\n";
1261                 print $fh '    <th><img src="/icons/blank.gif" alt="[ICO]"></th>'."\n";
1262                 print $fh '    <th><a href="?C=N;O=D">Name</a></th>'."\n";
1263                 print $fh '    <th><a href="?C=M;O=A">Last modified</a></th>'."\n";
1264                 print $fh '    <th><a href="?C=S;O=A">Size</a></th>'."\n";
1265                 print $fh '    <th><a href="?C=D;O=A">Description</a></th>'."\n";
1266                 print $fh '   </tr><tr>'."\n";
1267                 print $fh '    <th colspan="5"><hr></th>'."\n";
1268                 print $fh '   </tr><tr>'."\n";
1269                 print $fh '    <td valign="top"><img src="/icons/back.gif" alt="[DIR]"></td>'."\n";
1270                 print $fh '    <td><a href="/">Parent Directory</a></td>'."\n";
1271                 print $fh '    <td>&nbsp;</td>'."\n";
1272                 print $fh '    <td align="right">  - </td>'."\n";
1273                 print $fh '    <td>&nbsp;</td>'."\n";
1274                 print $fh '   </tr><tr>'."\n";
1275                 print $fh '    <td valign="top"><img src="/icons/folder.gif" alt="[DIR]"></td>'."\n";
1276                 print $fh '    <td><a href="2words/">2words/</a></td>'."\n";
1277                 print $fh '    <td align="right">'.INTF_DATE.'  </td>'."\n";
1278                 print $fh '    <td align="right">  - </td><td>&nbsp;</td>'."\n";
1279                 print $fh '   </tr><tr>'."\n";
1280                 print $fh '    <td valign="top"><img src="/icons/folder.gif" alt="[DIR]"></td>'."\n";
1281                 print $fh '    <td><a href="coin/">coin/</a></td>'."\n";
1282                 print $fh '    <td align="right">'.COIN_DATE.'  </td>'."\n";
1283                 print $fh '    <td align="right">  - </td><td> Coincidence </td>'."\n";
1284                 print $fh '   </tr><tr>'."\n";
1285                 print $fh '    <th colspan="5"><hr></th>'."\n";
1286                 print $fh '   </tr>'."\n";
1287                 print $fh '  </table>'."\n";
1288                 print $fh '  <address>Apache/2.2.22 (Debian) Server at '.WEBSITE.' Port 80</address>'."\n";
1289                 print $fh '  /body>'."\n";
1290                 print_html_end ($fh);
1291         }
1292         else {
1293
1294         }
1295         close ($fh);
1296         return $r
1297 }
1298
1299
1300 1