# along with this program. If not, see <http://www.gnu.org/licenses/>.
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 entityencode readdatafile writedatafile urlencode bb2ht);
+use botm_common (
+ 'read_data_file', 'write_data_file'
+);
+use bsta_lib (
+ 'STATE', 'INTF_STATE',
+ 'fail_method', 'fail_content_type',
+ 'read_header_env',
+ 'url_query_decode',
+
+
+
+ # to replace
+ 'failpage',
+ 'gethttpheader',
+ 'getcgi',
+ 'entityencode',
+ 'readdatafile',
+ 'writedatafile',
+ 'urlencode',
+ 'bb2ht'
+);
use File::Copy;
###PERL_CGI_PATH: CGI_PATH = /bsta/
###PERL_PAGE_LENGTH: PAGE_LENGTH = 16
###PERL_FIRSTPAGE_LENGTH: FIRSTPAGE_LENGTH = 4
+binmode STDIN, ':encoding(UTF-8)';
+binmode STDOUT, ':encoding(UTF-8)';
+binmode STDERR, ':encoding(UTF-8)';
+# decode_argv();
my %http;
my %cgi;
my %story;
-my %newstory;
+my %new_story;
my %settings;
my %state;
-my %gotolist;
+my %goto_list;
my $time = time();
srand ($time-$$);
my $IP;
my $words;
my $color2;
-my $lastip;
-my $storyid;
+my $last_IP;
+my $story_id;
my $turn;
my $message;
-my $firstletter;
-my $secondletter;
-my $intfstate;
-my $intfpass;
-my $intfpause;
-my $intfmode;
-my $storypath;
-my $storyfile;
-my $storylock;
+my $first_letter;
+my $second_letter;
+my $intf_state;
+my $intf_pass;
+my $intf_pause;
+my $intf_mode;
+my $story_path;
+my $story_file;
+my $story_lock;
my @storylines;
-my $ongstate;
+my $ong_state;
my $page;
+my $cmd_clear;
+my $cmd_clear_all;
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( <STDIN> );
- foreach my $ind (keys %cgipost) {
- $cgi{$ind}=$cgipost{$ind};
+ my %cgi_post=url_query_decode( <STDIN> );
+ foreach my $ind (keys %cgi_post) {
+ $cgi{$ind} = $cgi_post{$ind};
}
}
# 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($http{'content-type'}, $method);
}
}
-
+$IP = get_remote_addr();
if ($ENV{'PATH_INFO'} =~ /^\/(.+)$/) {
$page=int($1);
}
else {
$page=0;
}
-
-if ($ENV{'HTTP_X_FORWARDED_FOR'} =~ /^([0-9]+\.[0-9]+\.[0-9]+\.[0-9]+)$/) {
- $IP=$1;
-}
-elsif ($ENV{'REMOTE_ADDR'} =~ /^([0-9]+\.[0-9]+\.[0-9]+\.[0-9]+)$/) {
- $IP=$1;
-}
-else {
- $IP='0.0.0.0';
-}
-
if ($cgi{'words'} ne '') {
$words=$cgi{'words'};
}
-%settings=readdatafile(DATA_SETTINGS_PATH);
-%state=readdatafile(DATA_STATE_PATH);
-$ongstate=int($state{'state'});
-
-$storylock=0;
-if (open ($storyfile,"+<",DATA_STORY_PATH)){
- $storylock=1;
- if (flock($storyfile,2)) {
- $storylock=2;
+%settings = read_data_file(DATA_SETTINGS_PATH());
+%state = read_data_file(DATA_STATE_PATH());
+$ong_state = int($state{'state'});
+$cmd_clear = settings{'password'}.' clear';
+$cmd_clear_all = settings{'password'}.' clearall';
+
+$story_lock=0;
+if (open ($story_file,"+<:encoding(UTF-8)",DATA_STORY_PATH())){
+ $story_lock=1;
+ if (flock($story_file,2)) {
+ $story_lock=2;
}
- %story=readdatafile($storyfile);
+ %story = $read_data_file($story_file);
- if ($story{'lastip'} =~ /^([0-9]+\.[0-9]+\.[0-9]+\.[0-9]+)$/) {
- $lastip=$1;
+ if ($story{'lastip'} =~ /^.+$/) {
+ $last_IP=$&;
}
else {
- $lastip='0.0.0.0';
+ $last_IP='0.0.0.0';
}
- $storyid = int($story{'id'});
- $intfpass = int($story{'pass'});
- $intfstate = int($story{'state'});
- $intfmode = $intfstate;
- $intfpause = $intfstate & 1;
- if ($intfpause) {
- $intfmode -= 1;
+ $last_letter = lc($story{'letter'});
+ $story_id = int($story{'id'});
+ $intf_pass = int($story{'pass'});
+ $intf_state = int($story{'state'});
+ $intf_mode = $intf_state;
+ $intf_pause = $intf_state & 0x01;
+ if ($intf_pause) {
+ $intf_mode &= 0xFE;
}
- if ($IP ne $lastip) {
+ if ($IP ne $last_IP) {
$turn = 1;
}
else {
$turn = 0 ;
}
- if($words =~ /^bstaaaclear(all)?$/ || $intfstate < 0) {
- if($words eq 'bstaaaclearall' || $intfstate < -1) {
- $story{'id'}=0;
+ if (
+ ($words eq $cmd_clear) ||
+ ($words eq $cmd_clear_all) ||
+ ($intf_state < 0)
+ ) {
+ if (
+ ($words eq $cmd_clear_all) ||
+ ($intf_state < -1)
+ ) {
+ $story{'id'} = 0;
}
- $story{'content'}='';
- $story{'lastip'}='0.0.0.0';
- $story{'letter'}='';
- $story{'pass'}='0';
- $story{'state'}='0';
- $turn=0;
- if($ongstate == 0) {
- writeindex(WWW_INDEX_PATH,0,0,0);
+ $story{'content'} = '';
+ $story{'lastip' } = '0.0.0.0';
+ $story{'letter' } = '';
+ $story{'pass' } = 0;
+ $story{'state' } = INTF_STATE->{'X'};
+ $turn = 0;
+ if($ong_state == STATE->{'inactive'}) {
+ writeindex(WWW_INDEX_PATH,0,0,0); # TO REPLACE
}
- writedatafile($storyfile,%story);
+ write_data_file($story_file, '', '', \%story);
}
if ($words ne '') {
if (!$turn) {
$message = "It's not your turn.";
}
- else {
- if ($words =~ /^([!"\(\),\.:;\?][ \t]*)?([A-Za-z][A-Za-z'\-]*[A-Za-z']?)([!"\(\),\.:;\? \t][ \t]*)([A-Za-z][A-Za-z'\-]*[A-Za-z']?)([!"\(\),\.:;\?]?[ \t]*)$/) {
+ # TODO: consider allowing non-ASCII letters in words.
+ # (not very important in English language)
+ elsif ($words =~ /^([!"\(\),\.:;\?][ \t]*)?([A-Za-z][A-Za-z'\-]*[A-Za-z']?)([!"\(\),\.:;\? \t][ \t]*)([A-Za-z][A-Za-z'\-]*[A-Za-z']?)([!"\(\),\.:;\?]?[ \t]*)$/) {
+ $first_letter = lc(substr($2, 0, 1));
+ $second_letter = lc(substr($4, 0, 1));
+ if (
+ ($first_letter ne $last_letter) &&
+ ($last_letter ne '')
+ ) {
+ $message = 'The first word must start with '.uc($last_letter).'.';
+ }
+ elsif ($first_letter eq $second_letter) {
+ $message = 'The second word can\'t also start with '.uc($first_letter).'.';
+ }
+ else {
+ $story{'content'} = $story{'content'} . $words."\n";
+ $turn = 0;
+ $story{'lastip'} = $IP;
+ $story{'letter'} = $second_letter;
- $firstletter = lc(substr($2,0,1));
- $secondletter = lc(substr($4,0,1));
- if (($firstletter ne $story{'letter'})&&($story{'letter'} ne '')) {
- $message = 'The first word must start with '.uc($story{'letter'}).'.';
- }
- elsif ($firstletter eq $secondletter) {
- $message = 'The second word can\'t also start with '.uc($firstletter).'.';
+ if ($cgi{'next'} ne '') {
+ if (split(/\r?\n/,$story{'content'}) >= (STORY_LENGTH-1)) {
+ $story_path = DATA_STORY_PATH.$story_id;
+ write_data_file($story_path, '', '', \%story);
+ $new_story{'id' } = $story_id + 1;
+ $new_story{'letter' } = '';
+ $new_story{'lastip' } = $IP;
+ $new_story{'content'} = '';
+ $new_story{'pass' } = 0;
+ $new_story{'state' } = INTF_STATE->{'X'};
+ $intf_state = INTF_STATE->{'X'};
+ $intf_pass = 0;
+ $intf_mode = INTF_STATE->{'X'};
+ $intf_pause= 0;
+ if($ong_state == STATE->{'inactive'}) {
+ writeindex(WWW_INDEX_PATH,0,0,0); # TO REPLACE
+ }
+ write_data_file($story_file, '', '', \%new_story);
+ }
+ else {
+ $message = 'To early to finish this wordgame.';
+ write_data_file($story_file, '', '', \%story);
+ }
}
else {
- $story{'content'} = $story{'content'} . $words."\n";
- $turn = 0;
- $story{'lastip'} = $IP;
- $story{'letter'} = $secondletter;
-
- if ($cgi{'next'} ne '') {
- if (split(/\r?\n/,$story{'content'}) >= (STORY_LENGTH-1)) {
- $storypath = DATA_STORY_PATH.$storyid;
- writedatafile($storypath,%story);
- $newstory{'id'} = $storyid + 1;
- $newstory{'letter'}='';
- $newstory{'lastip'}=$IP;
- $newstory{'content'}='';
- $newstory{'pass'}='0';
- $newstory{'state'}='0';
- $intfstate=0;
- $intfpass=0;
- $intfmode=0;
- $intfpause=0;
- if($ongstate == 0) {
- writeindex(WWW_INDEX_PATH,0,0,0);
- }
- writedatafile($storyfile,%newstory);
- }
- else {
- $message = 'To early to finish this wordgame.';
- writedatafile($storyfile,%story);
+ if ($intf_pass == 1) {
+ $intf_pass = 2;
+ $story{'pass'} = 2;
+ if($ong_state == STATE->{'inactive'}) {
+ writeindex(WWW_INDEX_PATH,2,0,0); # TO REPLACE
}
}
- else {
- if ($intfpass == 1){
- $intfpass = 2;
- $story{'pass'} = '2';
- if($ongstate == 0) {
- writeindex(WWW_INDEX_PATH,2,0,0);
- }
+ elsif(lc($2).' '.lc($4) eq $settings{'unlock'}) {
+ if ($intf_pass != 0) {
+ $message = 'The password has already been used in this story.';
}
- elsif(lc($2).' '.lc($4) eq $settings{'unlock'}) {
- if ($intfpass == 0) {
- if($ongstate == 0) {
- my %framedata = readdatafile(DATA_PATH.0);
- my %default = readdatafile(DATA_DEFAULT_PATH);
- my $inpath;
- my $outpath;
-
- $framedata{'ongtime'} = $time;
- $gotolist{'title-0'} = $framedata{'title'};
- $gotolist{'ongtime-0'} = $framedata{'ongtime'};
- writedatafile(DATA_PATH.0,%framedata);
- writedatafile(DATA_LIST_PATH,%gotolist);
-
- foreach my $ind (keys %default) {
- unless(defined($framedata{$ind})){
- $framedata{$ind}=$default{$ind};
- }
- }
-
- $inpath = DATA_PATH.sprintf($settings{'frame'},0,$framedata{'ext'});
- $outpath = WWW_PATH.sprintf($settings{'frame'},0,$framedata{'ext'});
-
- if(copy ($inpath, $outpath)) {
- $intfpass = 1;
- $intfstate = 0;
- $intfmode=0;
- $intfpause=0;
- $story{'pass'} = '1';
- $story{'state'} = '0';
- writeindex(WWW_INDEX_PATH,1,0,0);
- }
- }
- else {
- $message = "???";
+ elsif ($ong_state != STATE->{'inactive'}) {
+ $message = "???";
+ }
+ else {
+ my %frame_data = read_data_file(DATA_PATH.0);
+ my %default = read_data_file(DATA_DEFAULT_PATH());
+ my $in_path;
+ my $out_path;
+
+ $frame_data{'ongtime'} = $time;
+ $goto_list{'title-0'} = $frame_data{'title'};
+ $goto_list{'ongtime-0'} = $frame_data{'ongtime'};
+ writedatafile(DATA_PATH.0,%frame_data);
+ writedatafile(DATA_LIST_PATH,%goto_list);
+
+ foreach my $ind (keys %default) {
+ unless(defined($frame_data{$ind})){
+ $frame_data{$ind}=$default{$ind};
}
}
- else {
- $message = 'The password has already been used in this story.';
+
+ $inpath = DATA_PATH.sprintf($settings{'frame'},0,$frame_data{'ext'});
+ $outpath = WWW_PATH.sprintf($settings{'frame'},0,$frame_data{'ext'});
+
+ if(copy ($inpath, $outpath)) {
+ $intf_pass = 1;
+ $intf_state = 0;
+ $intf_mode=0;
+ $intf_pause=0;
+ $story{'pass'} = '1';
+ $story{'state'} = '0';
+ writeindex(WWW_INDEX_PATH,1,0,0);
}
}
- writedatafile($storyfile,%story);
}
+ writedatafile($story_file,%story);
}
}
else {
}
}
}
- elsif (($cgi{'s'} ne '') && ($intfpass==1) && ($ongstate == 0)) {
- $intfstate = int($cgi{'s'});
- if($intfstate > 63 || $intfstate <0) {
- $intfstate = 0;
+ elsif (($cgi{'s'} ne '') && ($intf_pass==1) && ($ong_state == 0)) {
+ $intf_state = int($cgi{'s'});
+ if($intf_state > 63 || $intf_state <0) {
+ $intf_state = 0;
}
- $intfmode = $intfstate;
- $intfpause = $intfstate & 1;
- if ($intfpause) {
- $intfmode -= 1;
+ $intf_mode = $intf_state;
+ $intf_pause = $intf_state & 1;
+ if ($intf_pause) {
+ $intf_mode -= 1;
}
- $story{'state'} = $intfstate;
- writeindex(WWW_INDEX_PATH,1,$intfmode,$intfpause);
- writedatafile($storyfile,%story);
+ $story{'state'} = $intf_state;
+ writeindex(WWW_INDEX_PATH,1,$intf_mode,$intf_pause);
+ writedatafile($story_file,%story);
}
@storylines = split(/\r?\n/,$story{'content'});
if(@storylines & 1) {
$turn = !$turn;
}
- close($storyfile);
+ close($story_file);
}
print "Content-type: text/html\n\n";
print '</div>'."\n";
}
-if(($intfpass == 1) && ($ongstate == 0)) {
+if(($intf_pass == 1) && ($ong_state == 0)) {
print '</div><div id="framespace">'."\n";
print '<table id="intftable" cellspacing="0" cellpadding="0"><tr class="intf">'."\n";
print '<td colspan="6" class="intf"><img src="'.CGI_PATH.'intf-00';
- if ($intfmode == 4) {
+ if ($intf_mode == 4) {
print '_04';
}
- elsif ($intfmode == 8) {
+ elsif ($intf_mode == 8) {
print '_08';
}
- elsif ($intfstate == 16) {
+ elsif ($intf_state == 16) {
print '_10';
}
print'.gif" alt="" class="intf"></td>'."\n";
print '</tr><tr class="intf">'."\n";
print '<td class="intf"><img src="'.CGI_PATH.'intf-20.gif" alt="o" class="intf"></td>'."\n";
- print '<td class="intf"><a href="'.CGI_PATH.'2words?s='.($intfpause?17:16).'"><img src="'.CGI_PATH.'intf-10'.(($intfmode==16)?'_':'').'.gif" class="intf" alt=">"></td>'."\n";
- print '<td class="intf"><a href="'.CGI_PATH.'2words?s='.($intfpause?9:8).'"><img src="'.CGI_PATH.'intf-08'.(($intfmode==8)?'_':'').'.gif" class="intf" alt="<<"></td>'."\n";
- print '<td class="intf"><a href="'.CGI_PATH.'2words?s='.($intfpause?5:4).'"><img src="'.CGI_PATH.'intf-04'.(($intfmode==4)?'_':'').'.gif" class="intf" alt=">>"></td>'."\n";
- print '<td class="intf"><a href="'.CGI_PATH.'2words?s='.($intfpause?0:0).'"><img src="'.CGI_PATH.'intf-02.gif" class="intf" alt="^"></td>'."\n";
- print '<td class="intf"><a href="'.CGI_PATH.'2words?s='.($intfpause?$intfmode:$intfmode+1).'"><img src="'.CGI_PATH.'intf-01'.($intfpause?'_':'').'.gif" class="intf" alt="||"></td>'."\n";
+ print '<td class="intf"><a href="'.CGI_PATH.'2words?s='.($intf_pause?17:16).'"><img src="'.CGI_PATH.'intf-10'.(($intf_mode==16)?'_':'').'.gif" class="intf" alt=">"></td>'."\n";
+ print '<td class="intf"><a href="'.CGI_PATH.'2words?s='.($intf_pause?9:8).'"><img src="'.CGI_PATH.'intf-08'.(($intf_mode==8)?'_':'').'.gif" class="intf" alt="<<"></td>'."\n";
+ print '<td class="intf"><a href="'.CGI_PATH.'2words?s='.($intf_pause?5:4).'"><img src="'.CGI_PATH.'intf-04'.(($intf_mode==4)?'_':'').'.gif" class="intf" alt=">>"></td>'."\n";
+ print '<td class="intf"><a href="'.CGI_PATH.'2words?s='.($intf
_pause?0:0).'"><img src="'.CGI_PATH.'intf-02.gif" class="intf" alt="^"></td>'."\n";
+ print '<td class="intf"><a href="'.CGI_PATH.'2words?s='.($intf_pause?$intf_mode:$intf_mode+1).'"><img src="'.CGI_PATH.'intf-01'.($intf_pause?'_':'').'.gif" class="intf" alt="||"></td>'."\n";
print '</tr></table>'."\n";
}
print '</div><div id="insb" class="ins">'."\n";
print '<div id="undertext">'."\n";
-for (my $i = $storyid-1-(($page!=0)?((($page-1)*PAGE_LENGTH)+FIRSTPAGE_LENGTH):0); $i > ($storyid-1-($page*PAGE_LENGTH)- FIRSTPAGE_LENGTH) && $i >= 0; --$i) {
- $storypath = DATA_STORY_PATH.$i;
- %newstory = readdatafile($storypath);
- print '<p class="'.(($i&1)?'br':'ni').'" id="s'.$i.'">'.entityencode($newstory{'content'}).'</p>'."\n";
+for (my $i = $story_id-1-(($page!=0)?((($page-1)*PAGE_LENGTH)+FIRSTPAGE_LENGTH):0); $i > ($story_id-1-($page*PAGE_LENGTH)- FIRSTPAGE_LENGTH) && $i >= 0; --$i) {
+ $story_path = DATA_STORY_PATH.$i;
+ %new_story = readdatafile($story_path);
+ print '<p class="'.(($i&1)?'br':'ni').'" id="s'.$i.'">'.entityencode($new_story{'content'}).'</p>'."\n";
}
print '</div>'."\n";
print '<div id="underlinks">'."\n";
print '<a href="'.CGI_PATH.'">BSTA</a> | <a href="'.CGI_2WORDS_PATH.'">Once again</a>';
-if(($storyid - ($page*PAGE_LENGTH)) - FIRSTPAGE_LENGTH > 0) {
+if(($story_id - ($page*PAGE_LENGTH)) - FIRSTPAGE_LENGTH > 0) {
print ' | <a href="'.CGI_2WORDS_PATH.'/'.($page+1).'">Before</a>';
}
if($page > 0) {
print ' | <a href="'.CGI_2WORDS_PATH.'/'.($page-1).'">Unbefore</a>';
}
-if(($storyid - ($page*PAGE_LENGTH)) - FIRSTPAGE_LENGTH > 0) {
- print ' | <a href="'.CGI_2WORDS_PATH.'/'.(int(($storyid - FIRSTPAGE_LENGTH - 1) / PAGE_LENGTH) + 1).'">Initially</a>';
+if(($story_id - ($page*PAGE_LENGTH)) - FIRSTPAGE_LENGTH > 0) {
+ print ' | <a href="'.CGI_2WORDS_PATH.'/'.(int(($story_id - FIRSTPAGE_LENGTH - 1) / PAGE_LENGTH) + 1).'">Initially</a>';
}
if($turn) {
print ' | (Entering words here is irreversible. Your actions might be remembered forever. So please be reasonable.)';
bicyclesonthemoon.info / projects / ott / bsta / commitdiff