#
# The wordgame interface
#
-# Copyright (C) 2016 - 2017, 2023 Balthasar Szczepański
+# Copyright (C) 2016, 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
###PERL_LIB: use lib /botm/lib/bsta
use botm_common (
+ 'HTTP_STATUS',
+ 'http_header_status', 'http_header_allow',
'read_data_file', 'write_data_file',
- 'join_path',
'merge_url',
'read_header_env',
'html_entity_encode_dec',
- 'url_query_decode'
+ 'url_query_decode',
+ 'open_encoded'
);
use bsta_lib (
'STATE', 'INTF_STATE',
+ 'get_id',
'fail_method', 'fail_content_type',
'print_html_start', 'print_html_end',
'print_html_head_start', 'print_html_head_end',
'print_html_body_start', 'print_html_body_end',
'write_index',
'get_remote_addr',
- 'merge_settings'
+ 'merge_settings',
+ 'ong'
);
-use File::Copy;
-
-###PERL_PATH_SEPARATOR: PATH_SEPARATOR = /
###PERL_CGI_PATH: CGI_PATH = /bsta/
###PERL_CGI_2WORDS_PATH: CGI_2WORDS_PATH = /bsta/2words
-###PERL_DATA_PATH: DATA_PATH = /botm/data/bsta/
-###PERL_DATA_DEFAULT_PATH: DATA_DEFAULT_PATH = /botm/data/bsta/default
-###PERL_DATA_LIST_PATH: DATA_LIST_PATH = /botm/data/bsta/list
###PERL_DATA_SETTINGS_PATH: DATA_SETTINGS_PATH = /botm/data/bsta/settings
###PERL_DATA_STATE_PATH: DATA_STATE_PATH = /botm/data/bsta/state
###PERL_DATA_STORY_PATH: DATA_STORY_PATH = /botm/data/bsta/story
-###PERL_WWW_PATH: WWW_PATH = /botm/www/1190/bsta/
-
###PERL_WEBSITE_NAME: WEBSITE_NAME = Bicycles on the Moon
###PERL_STORY_LENGTH: STORY_LENGTH = 16
my %new_story;
my %settings;
my %state;
-my %goto_list;
my $time = time();
srand ($time-$$);
my $last_IP;
my $story_id;
my $turn;
+my $status;
+my $allow;
my $message;
my $first_letter;
my $second_letter;
my $intf_pause;
my $intf_mode;
my $story_i_path;
-my $story_file;
+my $fh;
my $story_lock;
my @story_lines;
my $ong_state;
if ($ENV{'REQUEST_METHOD'} =~ /^(HEAD|GET|POST)$/) {
$method = $1;
}
-else{
- exit fail_method($ENV{'REQUEST_METHOD'}, 'GET, POST, HEAD');
+else {
+ exit fail_method($ENV{'REQUEST_METHOD'}, ['GET','POST', 'HEAD']);
}
%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 %cgi_post=url_query_decode( <STDIN> );
- foreach my $ind (keys %cgi_post) {
- $cgi{$ind} = $cgi_post{$ind};
- }
+ my %cgi_post = url_query_decode( <STDIN> );
+ %cgi = merge_settings(\%cgi, \%cgi_post);
}
# multipart not supported
else{
exit fail_content_type($method, $http{'content-type'});
}
}
+
$IP = get_remote_addr();
-if ($ENV{'PATH_INFO'} =~ /^\/(.+)$/) {
- $page=int($1);
-}
-else {
- $page=0;
-}
+$page = get_id(\%cgi);
if ($cgi{'words'} ne '') {
- $words=$cgi{'words'};
+ $words = $cgi{'words'};
}
%settings = read_data_file(DATA_SETTINGS_PATH());
$cmd_clear_all = $settings{'password'}.' clearall';
$story_lock=0;
-if (open ($story_file,"+<:encoding(UTF-8)",DATA_STORY_PATH())){
+if (open_encoded($fh, "+<:encoding(UTF-8)", DATA_STORY_PATH())) {
$story_lock=1;
- if (flock($story_file,2)) {
+ if (flock($fh,2)) {
$story_lock=2;
}
- %story = read_data_file($story_file);
+ %story = read_data_file($fh);
if ($story{'lastip'} =~ /^.+$/) {
$last_IP=$&;
}
if (
- ($words eq $cmd_clear) ||
- ($words eq $cmd_clear_all) ||
- ($intf_state < 0)
+ ($intf_state < 0) || (
+ ($method eq 'POST') && (
+ ($words eq $cmd_clear) ||
+ ($words eq $cmd_clear_all)
+ )
+ )
) {
if (
($words eq $cmd_clear_all) ||
0 # pause
);
}
- write_data_file($story_file, '', '', \%story);
+ write_data_file($fh, \%story);
}
- if ($words ne '') {
+ if (($words ne '') && ($method eq 'POST')) {
if (!$turn) {
+ $status = HTTP_STATUS->{'forbidden'};
$message = "It's not your turn.";
}
# TODO: consider allowing non-ASCII letters in words.
($first_letter ne $last_letter) &&
($last_letter ne '')
) {
+ $status = HTTP_STATUS->{'bad_request'};
$message = 'The first word must start with '.uc($last_letter).'.';
}
elsif ($first_letter eq $second_letter) {
+ $status = HTTP_STATUS->{'bad_request'};
$message = 'The second word can\'t also start with '.uc($first_letter).'.';
}
else {
if (split(/\r?\n/,$story{'content'}) >= (STORY_LENGTH-1)) {
# store finished game
$story_i_path = DATA_STORY_PATH.$story_id;
- write_data_file($story_i_path, '', '', \%story);
+ write_data_file($story_i_path, \%story);
# init new game
$new_story{'id' } = $story_id + 1;
$new_story{'letter' } = '';
);
}
# save new game
- write_data_file($story_file, '', '', \%new_story);
+ write_data_file($fh, \%new_story);
}
else {
$message = 'To early to finish this wordgame.';
- write_data_file($story_file, '', '', \%story);
+ write_data_file($fh, \%story);
}
}
else {
}
else {
# ready to activate?
- my $frame_data_path;
- my %frame_data;
- my %default;
- my $frame_file;
- my $in_path;
- my $out_path;
- my $ext;
-
- # prepare to ONG frame 0!
-
- $frame_data_path = join_path(PATH_SEPARATOR(), DATA_PATH(), 0);
- %frame_data = read_data_file($frame_data_path);
- %default = read_data_file(DATA_DEFAULT_PATH());
-
- $ext = (defined($frame_data{'ext'})) ?
- $frame_data{'ext'} :
- $default{'ext'};
+ my $r;
- $frame_file = sprintf($settings{'frame'}, 0, $ext);
- $in_path = join_path(PATH_SEPARATOR(), DATA_PATH(), $frame_file);;
- $out_path = join_path(PATH_SEPARATOR(), WWW_PATH(), $frame_file);
-
- # set ONG time of frame 0
- # NOTE: might get overwritten later if ONG not launched
- $frame_data{'ongtime'} = $time;
- $frame_data{'timer'} = 0;
- write_data_file($frame_data_path, '', '', \%frame_data);
-
- # update the GOTO list with frame 0
- $goto_list{'title-0' } = $frame_data{'title'};
- $goto_list{'ongtime-0'} = $frame_data{'ongtime'};
- write_data_file(DATA_LIST_PATH(), '', '', \%goto_list);
-
- if(copy ($in_path, $out_path)) {
+ # ONG tape interface
+ $r = ong(
+ 'i', # ID: tape interface
+ $time, # ONG time; not relevant
+ 0, # timer; not relevant
+ 0, # update; not relevant
+ 0, # print
+ \%settings, # not relevant
+ '', # %default; not relevant
+ '', # %frame_data; not relevant
+ '' # $goto_list; not relevant
+ );
+ if ($r) {
+ # ONG CFRT
+ $r = ong(
+ 'c', # ID: CFRT
+ $time, # ONG time; not relevant
+ 0, # timer; not relevant
+ 0, # update; not relevant
+ 0, # print
+ \%settings,
+ '', # %default
+ '', # %frame_data
+ '' # $goto_list; not relevant
+ );
+ }
+ if ($r) {
+ # ONG frame 0!
+ $r = ong(
+ 0, # frame ID
+ $time, # ONG time; might get overwritten later
+ 0, # timer
+ 0, # update
+ 0, # print
+ \%settings,
+ '', # %default
+ '', # %frame_data
+ '' # $goto_list
+ );
+ }
+ if($r) {
# new state of hidden interface
$intf_pass = 1;
$intf_state = INTF_STATE->{'X'};
}
}
}
- write_data_file($story_file, '', '', \%story);
+ write_data_file($fh, \%story);
}
}
}
else {
+ $status = HTTP_STATUS->{'bad_request'};
$message = 'Please, two words, not more, not less (some punctuation is allowed).';
}
}
$intf_mode,
$intf_pause
);
- write_data_file($story_file, '', '', \%story);
+ write_data_file($fh, \%story);
}
@story_lines = split(/\r?\n/, $story{'content'});
if(@story_lines & 1) {
$turn = !$turn;
}
- close($story_file);
+ close($fh);
+}
+
+if ($status ne '') {
+ print http_header_status($status);
+}
+if ($allow ne '') {
+ print http_header_allow($allow);
}
+print "Content-type: text/html; charset=UTF-8\n\n";
-print "Content-type: text/html\n\n";
if($method eq 'HEAD') {
exit;
}
}
print ' <input class="intx" type="text" name="words">'."\n";
print ' <input class="inbt" type="submit" value="enter">'."\n";
- if(@story_lines >= (STORY_LENGTH-1)) {
+ if (@story_lines >= (STORY_LENGTH-1)) {
print ' <input class="inbt" type="submit" name="next" value="enter and then start a new one">'."\n";
}
print ' </form>'."\n";
print ' </div>'."\n";
-print_html_body_end(\*STDOUT);
+print_html_body_end(\*STDOUT, $ong_state == STATE->{'inactive'});
print_html_end(\*STDOUT);
bicyclesonthemoon.info / projects / ott / bsta / blobdiff