From cba8d01dc5e9cb1e7ee4d6a6da00da838a311b9e Mon Sep 17 00:00:00 2001 From: b Date: Tue, 2 Jan 2024 20:33:45 +0000 Subject: [PATCH] rework GOTO --- bsta_lib.1.pm | 3 +- goto.1.pl | 231 ++++++++++++++++++++++++++++++-------------------- reset.1.pl | 7 +- 3 files changed, 148 insertions(+), 93 deletions(-) diff --git a/bsta_lib.1.pm b/bsta_lib.1.pm index eb6d61e..017e24b 100644 --- a/bsta_lib.1.pm +++ b/bsta_lib.1.pm @@ -1700,7 +1700,8 @@ sub ong { (!$update) || ($frame_full_data{'ongtime'} eq '') ) { - $frame_data{'ongtime'} = $ongtime; + $frame_data {'ongtime'} = $ongtime; + $frame_full_data{'ongtime'} = $ongtime; $write_data = 1; } if ( diff --git a/goto.1.pl b/goto.1.pl index 36c44ec..4cf3f1b 100644 --- a/goto.1.pl +++ b/goto.1.pl @@ -1,11 +1,11 @@ ###RUN_PERL: #!/usr/bin/perl -# -# /bsta/g -###RUN_PERL: #!/usr/bin/perl +# /bsta/g +# goto is generated from goto.1.pl. +# # The frame list # -# Copyright (C) 2017, 2023 Balthasar Szczepański +# Copyright (C) 2017, 2023, 2024 Balthasar Szczepański # # This program is free software: you can redistribute it and/or modify # it under the terms of the GNU Affero General Public License as @@ -21,14 +21,32 @@ # along with this program. If not, see . use strict; -#use warnings; +use utf8; +# use Encode::Locale ('decode_argv'); +use Encode ('encode', 'decode'); + ###PERL_LIB: use lib /botm/lib/bsta -use bsta_lib qw(failpage gethttpheader getcgi readdatafile printdatafile entityencode urlencode); -use File::Copy; +use botm_common ( + 'read_header_env', + 'read_data_file', + 'url_query_encode', 'url_query_decode', + 'merge_url', + 'join_path', + 'html_entity_encode_dec' +); +use bsta_lib ( + 'STATE', + 'fail_method', 'fail_content_type', + 'get_password', + 'print_html_start', 'print_html_end', + 'print_html_head_start', 'print_html_head_end', + 'print_html_body_start', 'print_html_body_end', + 'write_index' +); + +###PERL_PATH_SEPARATOR: PATH_SEPARATOR = / ###PERL_CGI_PATH: CGI_PATH = /bsta/ -###PERL_CGI_CSS_PATH: CGI_CSS_PATH = /bsta/bsta.css -###PERL_CGI_LOGO_PATH: CGI_LOGO_PATH = /bsta/botmlogo.png ###PERL_CGI_VIEWER_PATH: CGI_VIEWER_PATH = /bsta/v ###PERL_DATA_PATH: DATA_PATH = /botm/data/bsta/ @@ -36,75 +54,66 @@ use File::Copy; ###PERL_DATA_STATE_PATH: DATA_STATE_PATH = /botm/data/bsta/state ###PERL_DATA_LIST_PATH: DATA_LIST_PATH = /botm/data/bsta/list -###PERL_WEBSITE: WEBSITE = 1190.bicyclesonthemoon.info ###PERL_WEBSITE_NAME: WEBSITE_NAME = Bicycles on the Moon -###PERL_FAVICON_PATH: FAVICON_PATH = /img/favicon.png + +binmode STDIN, ':encoding(UTF-8)'; +binmode STDOUT, ':encoding(UTF-8)'; +binmode STDERR, ':encoding(UTF-8)'; +# decode_argv(); + +my $time = time(); +srand ($time-$$); my %http; my %cgi; my %settings; my %state; -my %gotolist; - -my @timetab; - -my $time = time(); -srand ($time-$$); +my %goto_list; my $method; my $password; -my $passwordOK; - +my $password_ok; +my $password_query; my $frame; -my $last; -my $title; -my $ongtime; -my $ongstate; +my $last_frame; +my $ong_state; my $line; delete @ENV{qw(IFS CDPATH ENV BASH_ENV)}; ###PERL_SET_PATH: $ENV{'PATH'} = /usr/local/bin:/usr/bin:/bin; if ($ENV{'REQUEST_METHOD'} =~ /^(HEAD|GET|POST)$/) { - $method=$1; + $method = $1; } else{ - exit failpage("Status: 405 Method Not Allowed\nAllow: GET, POST, HEAD\n","405 Method Not Allowed","The interface does not support the $ENV{'REQUEST_METHOD'} method.",$method); + exit fail_method($ENV{'REQUEST_METHOD'}, 'GET, POST, HEAD'); } -%http = gethttpheader (\%ENV); -%cgi = getcgi($ENV{'QUERY_STRING'}); +%http = read_header_env(\%ENV); +%cgi = url_query_decode($ENV{'QUERY_STRING'}); if ($method eq 'POST') { if ($http{'content-type'} eq 'application/x-www-form-urlencoded') { - my %cgipost=getcgi( ); - foreach my $ind (keys %cgipost) { - $cgi{$ind}=$cgipost{$ind}; - } + my %cgi_post = url_query_decode( ); + %cgi = merge_settings(\%cgi, \%cgi_post); } # multipart not supported else{ - exit failpage("Status: 415 Unsupported Media Type\n","415 Unsupported Media Type","Unsupported Content-type: $http{'content-type'}."); + exit fail_content_type($method, $http{'content-type'}); } } -if ($cgi{'p'} =~ /^(.+)$/) { - $password=$1; -} -else { - $password=''; -} +$password = get_password(\%cgi); -%settings=readdatafile(DATA_SETTINGS_PATH); -%state=readdatafile(DATA_STATE_PATH); -%gotolist=readdatafile(DATA_LIST_PATH); +%settings = read_data_file(DATA_SETTINGS_PATH()); +%state = read_data_file(DATA_STATE_PATH()); +%goto_list = read_data_file(DATA_LIST_PATH()); -if($password eq $settings{'password'}){ - $passwordOK = 1; -} -else{ - $passwordOK = 0; -} +$last_frame = int($state{'last'}); +$ong_state = int($state{'state'}); + +$password_ok = ($password eq $settings{'password'}); +$password_query = url_query_encode({'p', $settings{'password'}}); print "Content-type: text/html\n"; print "\n"; @@ -112,61 +121,101 @@ if($method eq 'HEAD') { exit; } -print ''."\n"; -print ''."\n"; -print 'GOTO • '.entityencode($settings{'story'}).' • '.WEBSITE_NAME.''."\n"; -print ''."\n"; -print ''."\n"; -print ''."\n"; -print ''."\n"; -print ''."\n"; -print '
'."\n"; +my $_title = html_entity_encode_dec($settings{'story'}, 1); +my $_website_name = html_entity_encode_dec(WEBSITE_NAME() , 1); +my $_base_url = html_entity_encode_dec(CGI_PATH() , 1); -print '
'."\n"; +print_html_start(\*STDOUT); +print_html_head_start(\*STDOUT); -print '
'."\n"; -print '

'.entityencode($settings{'story'}).'

'."\n"; -print '
'."\n"; +print ' GOTO • '.$_title.' • '.$_website_name.''."\n"; -print '
'."\n"; +print_html_head_end(\*STDOUT); +print_html_body_start(\*STDOUT); -print '
'."\n"; +print '
'."\n"; -$last=int($state{'last'}); -$ongstate=int($state{'state'}); -for ($frame=0; ; ++$frame) { - if((($frame > $last) || $ongstate<1) && !$passwordOK) { +print '
'."\n"; +print '

'.$_title.'

'."\n"; +print '
'."\n"; + +print '
'."\n"; +print '
'."\n"; + +print '
'."\n"; +for ($frame = 0; ; $frame += 1) { + unless ( + $password_ok || ( + ($frame <= $last_frame) && + ($ong_state >= STATE->{'waiting'}) + ) + ) { last; } + my $title; + my $ongtime; + my @time_tab; + my $time_text; + my $timer_color; + my $frame_text; + my $viewer_url; - $ongtime=$gotolist{'ongtime-'.$frame}; - $title=$gotolist{'title-'.$frame}; - if ($ongtime eq '') { - last; + $ongtime = $goto_list{'ongtime-'.$frame}; + $title = $goto_list{'title-' .$frame}; + if (($ongtime eq '') && ($title eq '')) { + my $frame_data_path = join_path(PATH_SEPARATOR(), DATA_PATH(), $frame); + my %frame_data = read_data_file($frame_data_path); + $ongtime = $frame_data{'ongtime'}; + $title = $frame_data{'title'}; + unless (keys %frame_data) { + last; + } } - @timetab=gmtime($ongtime); - print ''.sprintf('%03d',$frame).' '.sprintf('%02d.%02d.%02d %02d:%02d',$timetab[3],$timetab[4]+1,$timetab[5]-100,$timetab[2],$timetab[1]).' '.entityencode($title).'
'."\n"; + if ($ongtime ne '') { + @time_tab = gmtime($ongtime); + $time_text = sprintf( + '%02d.%02d.%02d %02d:%02d', + $time_tab[3], + $time_tab[4]+1, + $time_tab[5]-100, + $time_tab[2], + $time_tab[1] + ); + } + else { + $time_text = (($frame <= $last_frame) && ($ong_state >= STATE->{'waiting'})) ? + 'EE.EE.EE EE:EE' : '--.--.-- --:--'; + } + if ($title eq '') { + $title = '_'; + } + $timer_color = (($frame > $last_frame) || ($ong_state < STATE->{'waiting'})) ? + 'cz' : ( + (($frame == $last_frame) && ($ong_state < STATE->{'ready'})) ? + 'ni' : 'br' + ); + $frame_text = sprintf('%03d',$frame); + $viewer_url = merge_url( + {'path' => CGI_VIEWER_PATH()}, + {'path' => $frame} + ); + if ($password_ok) { + $viewer_url = merge_url($viewer_url, {'query' => $password_query, 'append_query' => 1}); + } + + my $_viewer_url = html_entity_encode_dec($viewer_url, 1); + my $_title = html_entity_encode_dec($title , 1); + + print ' '.$frame_text.' '.$time_text.' '.$_title.'
'."\n"; } +print '
'."\n"; -print '
'."\n"; - -print ''."\n"; - -print '
'."\n"; - -print '
'."\n"; -print ''.WEBSITE.''."\n"; - - -print ''."\n"; - - - - +print ' '."\n"; +print '
'."\n"; +print_html_body_end(\*STDOUT, $ong_state == STATE->{'inactive'}); +print_html_end(\*STDOUT); diff --git a/reset.1.pl b/reset.1.pl index 7d1a534..b289b5e 100644 --- a/reset.1.pl +++ b/reset.1.pl @@ -4,7 +4,7 @@ # # Reset BSTA state # -# Copyright (C) 2016 - 2018, 2023 Balthasar Szczepański +# Copyright (C) 2016, 2017, 2018, 2023, 2024 Balthasar Szczepański # # This program is free software: you can redistribute it and/or modify # it under the terms of the GNU Affero General Public License as @@ -39,6 +39,7 @@ binmode STDERR, ':encoding(UTF-8)'; decode_argv(); ###PERL_DATA_CHAT_PATH: DATA_CHAT_PATH = /botm/data/bsta/chat +###PERL_DATA_LIST_PATH: DATA_LIST_PATH = /botm/data/bsta/list ###PERL_DATA_SETTINGS_PATH: DATA_SETTINGS_PATH = /botm/data/bsta/state ###PERL_DATA_STATE_PATH: DATA_STATE_PATH = /botm/data/bsta/state ###PERL_DATA_STORY_PATH: DATA_STORY_PATH = /botm/data/bsta/story @@ -49,6 +50,7 @@ my %story; my %state; my %chat; my %settings; +my %goto_list; delete @ENV{qw(IFS CDPATH ENV BASH_ENV)}; ###PERL_SET_PATH: $ENV{'PATH'} = /usr/local/bin:/usr/bin:/bin; @@ -86,10 +88,13 @@ unless ( 'state' => CHAT_STATE->{'disconnected'}, 'content' => '' ); +%goto_list = ( +); write_data_file(DATA_STATE_PATH(), '', '', \%state); write_data_file(DATA_STORY_PATH(), '', '', \%story); write_data_file(DATA_CHAT_PATH() , '', '', \%chat); +write_data_file(DATA_LIST_PATH() , '', '', \%goto_list); write_index( \%state, -- 2.30.2