bicyclesonthemoon.info Git - ott/bsta/blob - goto.1.pl

   1 ###RUN_PERL: #!/usr/bin/perl
   2
   3 # /bsta/g
   4 # goto is generated from goto.1.pl.
   5 #
   6 # The frame list
   7 #
   8 # Copyright (C) 2017, 2023, 2024  Balthasar Szczepański
   9 #
  10 # This program is free software: you can redistribute it and/or modify
  11 # it under the terms of the GNU Affero General Public License as
  12 # published by the Free Software Foundation, either version 3 of the
  13 # License, or (at your option) any later version.
  14 #
  15 # This program is distributed in the hope that it will be useful,
  16 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 # GNU Affero General Public License for more details.
  19 #
  20 # You should have received a copy of the GNU Affero General Public License
  21 # along with this program.  If not, see <http://www.gnu.org/licenses/>.
  22
  23 use strict;
  24 use utf8;
  25 # use Encode::Locale ('decode_argv');
  26 use Encode ('encode', 'decode');
  27
  28 ###PERL_LIB: use lib /botm/lib/bsta
  29 use botm_common (
  30         'read_header_env',
  31         'read_data_file',
  32         'url_query_encode', 'url_query_decode',
  33         'merge_url',
  34         'join_path',
  35         'html_entity_encode_dec'
  36 );
  37 use bsta_lib (
  38         'STATE',
  39         'fail_method', 'fail_content_type',
  40         'get_password',
  41         'print_html_start', 'print_html_end',
  42         'print_html_head_start', 'print_html_head_end',
  43         'print_html_body_start', 'print_html_body_end',
  44         'write_index',
  45         'merge_settings'
  46 );
  47
  48 ###PERL_PATH_SEPARATOR:     PATH_SEPARATOR     = /
  49
  50 ###PERL_CGI_PATH:           CGI_PATH           = /bsta/
  51 ###PERL_CGI_VIEWER_PATH:    CGI_VIEWER_PATH    = /bsta/v
  52
  53 ###PERL_DATA_PATH:          DATA_PATH          = /botm/data/bsta/
  54 ###PERL_DATA_SETTINGS_PATH: DATA_SETTINGS_PATH = /botm/data/bsta/settings
  55 ###PERL_DATA_STATE_PATH:    DATA_STATE_PATH    = /botm/data/bsta/state
  56 ###PERL_DATA_LIST_PATH:     DATA_LIST_PATH     = /botm/data/bsta/list
  57
  58 ###PERL_WEBSITE_NAME:       WEBSITE_NAME       = Bicycles on the Moon
  59
  60 binmode STDIN,  ':encoding(UTF-8)';
  61 binmode STDOUT, ':encoding(UTF-8)';
  62 binmode STDERR, ':encoding(UTF-8)';
  63 # decode_argv();
  64
  65 my $time = time();
  66 srand ($time-$$);
  67
  68 my %http;
  69 my %cgi;
  70 my %settings;
  71 my %state;
  72 my %goto_list;
  73
  74 my $method;
  75 my $password;
  76 my $password_ok;
  77 my $password_query;
  78 my $frame;
  79 my $last_frame;
  80 my $ong_state;
  81 my $line;
  82
  83 delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
  84 ###PERL_SET_PATH: $ENV{'PATH'} = /usr/local/bin:/usr/bin:/bin;
  85
  86 if ($ENV{'REQUEST_METHOD'} =~ /^(HEAD|GET|POST)$/) {
  87         $method = $1;
  88 }
  89 else{
  90         exit fail_method($ENV{'REQUEST_METHOD'}, ['GET', 'POST', 'HEAD']);
  91 }
  92
  93 %http = read_header_env(\%ENV);
  94 %cgi = url_query_decode($ENV{'QUERY_STRING'});
  95
  96 if ($method eq 'POST') {
  97         if ($http{'content-type'} eq 'application/x-www-form-urlencoded') {
  98                 my %cgi_post = url_query_decode( <STDIN> );
  99                 %cgi = merge_settings(\%cgi, \%cgi_post);
 100         }
 101         # multipart not supported
 102         else{
 103                 exit fail_content_type($method, $http{'content-type'});
 104         }
 105 }
 106
 107 $password = get_password(\%cgi);
 108
 109 %settings  = read_data_file(DATA_SETTINGS_PATH());
 110 %state     = read_data_file(DATA_STATE_PATH());
 111 %goto_list = read_data_file(DATA_LIST_PATH());
 112
 113 $last_frame = int($state{'last'});
 114 $ong_state  = int($state{'state'});
 115
 116 $password_ok = ($password eq $settings{'password'});
 117 $password_query = url_query_encode({'p', $settings{'password'}});
 118
 119 print "Content-type: text/html; charset=UTF-8\n";
 120 print "\n";
 121 if($method eq 'HEAD') {
 122         exit;
 123 }
 124
 125 my $_title        = html_entity_encode_dec($settings{'story'}, 1);
 126 my $_website_name = html_entity_encode_dec(WEBSITE_NAME()    , 1);
 127 my $_base_url     = html_entity_encode_dec(CGI_PATH()        , 1);
 128
 129 print_html_start(\*STDOUT);
 130 print_html_head_start(\*STDOUT);
 131
 132 print '  <title>GOTO &bull; '.$_title.' &bull; '.$_website_name.'</title>'."\n";
 133
 134 print_html_head_end(\*STDOUT);
 135 print_html_body_start(\*STDOUT);
 136
 137 print '   <div id="inst" class="ins">'."\n";
 138
 139 print '    <div id="title">'."\n";
 140 print '     <h1 id="titletext">'.$_title.'</h1>'."\n";
 141 print '    </div>'."\n";
 142
 143 print '   </div>'."\n";
 144 print '   <div id="insb" class="ins">'."\n";
 145
 146 print '    <div id="chat">'."\n";
 147 for ($frame = 0; ; $frame += 1) {
 148         unless (
 149                 $password_ok || (
 150                         ($frame <= $last_frame) &&
 151                         ($ong_state >= STATE->{'waiting'})
 152                 )
 153         ) {
 154                 last;
 155         }
 156         my $title;
 157         my $ongtime;
 158         my @time_tab;
 159         my $time_text;
 160         my $timer_color;
 161         my $frame_text;
 162         my $viewer_url;
 163
 164         $ongtime = $goto_list{'ongtime-'.$frame};
 165         $title   = $goto_list{'title-'  .$frame};
 166         if (($ongtime eq '') && ($title eq '')) {
 167                 my $frame_data_path = join_path(PATH_SEPARATOR(), DATA_PATH(), $frame);
 168                 my %frame_data = read_data_file($frame_data_path);
 169                 $ongtime = $frame_data{'ongtime'};
 170                 $title   = $frame_data{'title'};
 171                 unless (keys %frame_data) {
 172                         last;
 173                 }
 174         }
 175
 176         if ($ongtime ne '') {
 177                 @time_tab = gmtime($ongtime);
 178                 $time_text = sprintf(
 179                         '%02d.%02d.%02d %02d:%02d',
 180                         $time_tab[3],
 181                         $time_tab[4]+1,
 182                         $time_tab[5]-100, # TODO: %100 ?
 183                         $time_tab[2],
 184                         $time_tab[1]
 185                 );
 186         }
 187         else {
 188                 $time_text = (($frame <= $last_frame) && ($ong_state >= STATE->{'waiting'})) ?
 189                         'EE.EE.EE EE:EE' : '--.--.-- --:--';
 190         }
 191         if ($title eq '') {
 192                 $title = '_';
 193         }
 194         $timer_color = (($frame > $last_frame) || ($ong_state < STATE->{'waiting'})) ?
 195                 'cz' : (
 196                         (($frame == $last_frame) && ($ong_state < STATE->{'ready'})) ?
 197                                 'ni' : 'br'
 198                 );
 199         $frame_text = sprintf('%03d',$frame);
 200         $viewer_url = merge_url(
 201                 {'path' => CGI_VIEWER_PATH()},
 202                 {'path' => $frame}
 203         );
 204         if ($password_ok) {
 205                 $viewer_url = merge_url($viewer_url, {'query' => $password_query, 'append_query' => 1, 'preserve_fragment' => 1});
 206         }
 207
 208         my $_viewer_url = html_entity_encode_dec($viewer_url, 1);
 209         my $_title      = html_entity_encode_dec($title     , 1);
 210
 211         print '     <span class="'.$timer_color.'">'.$frame_text.'</span> '.$time_text.' <a href="'.$_viewer_url.'">'.$_title.'</a><br>'."\n";
 212 }
 213 print '    </div>'."\n";
 214
 215 print '    <div id="underlinks">'."\n";
 216 print '     <a href="'.$_base_url.'">BSTA</a>'."\n";
 217 print '    </div>'."\n";
 218
 219 print '   </div>'."\n";
 220
 221 print_html_body_end(\*STDOUT, $ong_state == STATE->{'inactive'});
 222 print_html_end(\*STDOUT);