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