use strict;
#use warnings
+
+use utf8;
use Exporter;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
+# TO REMOVE
use constant entitycode => {
'amp' => '&',
'gt' => '>',
'loz' => '◊',
};
+use constant STATE => {
+ 'inactive' => 0,
+ 'waiting' => 1,
+ 'ready' => 2
+};
+
use constant tagsbb => {
'ht' => '',
'/ht' => '',
###PERL_EXPORT_VERSION: our $VERSION = 'x.x.x';
our @ISA = qw(Exporter);
our @EXPORT = ();
-our @EXPORT_OK = qw(entityencode failpage gethttpheader getcgi urldecode readdatafile writedatafile printdatafile printdatafileht urlencode linehtml bb2ht bb2bb);
-our %EXPORT_TAGS = ();
+our @EXPORT_OK = (
+ 'STATE',
+ 'entityencode' # TO REMOVE
+ 'failpage', 'fail_method', 'fail_content_type',
+ 'gethttpheader', 'getcgi', # TO REMOVE
+ 'urldecode', # TO REMOVE
+ 'readdatafile', 'writedatafile', 'printdatafile',
+ 'printdatafileht', # TO REMOVE ???
+ 'urlencode', # TO REMOVE
+ 'linehtml',
+ 'bb2ht', 'bb2bb'
+);
+
+###PERL_LIB: use lib /botm/lib/bsta
+use botm_common (
+ 'html_entity_encode_dec'
+);
-# Function to show an error page
+
+# Function to return an error page
# arguments: 1 - header fields, 2 - page title, 3 - error message, 4 method
sub failpage {
- (my $header, my $title, my $message, my $method)=@_;
+ (my $header, my $title, my $message, my $method) = @_;
if($header ne ''){
print $header;
}
print "\n";
return;
}
- print "Content-type: text/html\n\n";
+ print "Content-type: text/html; charset=UTF-8\n\n";
+
print '<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "">'."\n";
print '<html lang="en"><head>'."\n";
- if($title ne ''){
- print '<title>'.entityencode($title).'</title>'."\n";
- }
print '<meta http-equiv="Content-type" content="text/html; charset=UTF-8">'."\n";
+ if ($title ne '') {
+ print '<title>'.html_entity_encode_dec($title, 1).'</title>'."\n";
+ }
print '</head><body>'."\n";
- if($title ne ''){
- print '<h1>'.entityencode($title).'</h1>'."\n";
+ if ($title ne '') {
+ print '<h1>'.html_entity_encode_dec($title, 1).'</h1>'."\n";
}
- if($message ne ''){
- print '<p>'.entityencode($message).'</p>'."\n";
+ if ($message ne '') {
+ print '<p>'.html_entity_encode_dec($message, 1).'</p>'."\n";
}
print '</body></html>'."\n";
}
+sub fail_method {
+ (my $method, my $allowed) = @_;
+
+ my $header = "Status: 405 Method Not Allowed\n";
+ if ($allowed ne '') {
+ $header .= "Allow: $allowed\n";
+ }
+ return failpage(
+ $header,
+ "405 Method Not Allowed",
+ "The interface does not support the $method method.",
+ $method
+ );
+}
+
+sub fail_content_type
+{
+ (my $content_type, $method) = @_
+
+ return failpage(
+ "Status: 415 Unsupported Media Type\n",
+ "415 Unsupported Media Type",
+ "Unsupported Content-type: $content_type.",
+ $method
+ );
+}
+
+
+# TO REMOVE
# function to encode entities, decimal,
sub entityencode {
(my $t, my $all) = @_;
return $t;
}
+# TO REMOVE
# function to get values of http header fields. Returns a hash. names of header
# fields are lowercase
sub gethttpheader {
return %http;
}
+# TO REMOVE
# The function to get CGI parameters from string.
# Format is: name=url_encoded_value&name=url_encoded_value& ... &name=url_encoded_value
sub getcgi {
return %cgi;
}
+# TO REMOVE
# Function for decoding URL-encoded text
sub urldecode {
my $t = $_[0];
return $t;
}
+# TO REMOVE
# Function to read data from datafiles.
# Very similar to http header file reading. (function readheaderfile() in proxy
# library)
return %data;
}
+# TO REMOVE
# the function to write data to datafiles (see readdatafile() description)
#
# First argument can be a path or a file handle. In case of a file handle it
return 1;
}
+# TO REMOVE
# the function to print data to stdout (see readdatafile() description)
#
# On success returns 1.
return 1;
}
+# TO REMOVE ???
# the function to print data to stdout as html (see readdatafile() description)
#
# On success returns 1.
}
+# TO REMOVE
sub urlencode {
(my $t, my $all) = @_;
if ($all) {
return $esc;
}
+# TO REMOVE ???
sub debug {
(my $print, my $text) = @_;
# 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 printdatafileht urlencode bb2ht bb2bb linehtml);
+use botm_common (
+ 'read-header_env',
+ 'read_data_file', 'write_data_file'
+);
+use bsta_lib (
+ 'STATE',
+ 'fail_method', 'fail_content_type',
+ 'entityencode',
+ 'printdatafileht'
+ 'urlencode',
+ 'bb2ht', 'bb2bb', 'linehtml'
+);
use File::Copy;
###PERL_CGI_PATH: CGI_PATH = /bsta/
###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 %http;
my %cgi;
my %framedata;
my $method;
my $frame;
+my $framedata_path;
my $password;
my $passwordOK;
my $IP;
$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') {
}
# 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);
}
}
}
if ($cgi{'f'} =~ /^(.+)$/) {
- $frame=int($1);
+ $frame = int($1);
}
elsif ($ENV{'PATH_INFO'} =~ /^\/(.+)$/) {
- $frame=int($1);
+ $frame = int($1);
}
else {
$frame = 0;
}
+$frame_data_path = join_path('/', DATA_PATH, $frame);
if ($cgi{'p'} =~ /^(.+)$/) {
- $password=$1;
+ $password = $1;
}
else {
- $password='';
+ $password = '';
}
# print "Content-type: text/plain\n\n";
-%settings=readdatafile(DATA_SETTINGS_PATH);
-%default=readdatafile(DATA_DEFAULT_PATH);
-%framedata=readdatafile(DATA_PATH.$frame);
-if($password eq $settings{'password'}){
+%settings = read_data_file(DATA_SETTINGS_PATH);
+%default = read_data_file(DATA_DEFAULT_PATH);
+%framedata= read_data_file($frame_data_path);
+if ($password eq $settings{'password'}) {
$passwordOK = 1;
}
else{
$passwordOK = 0;
}
-if (open ($statefile,"+<",DATA_STATE_PATH)){
- if (flock($statefile,2)) {
+if (open ($statefile, "+<:encoding(UTF-8)", DATA_STATE_PATH)) {
+ if (flock($statefile, 2)) {
- %state=readdatafile($statefile);
+ %state = read_data_file($statefile);
- if($frame<0) {
+ if ($frame < 0) {
$frame = int($state{'last'}) + $frame +1;
- %framedata=readdatafile(DATA_PATH.$frame);
+ $frame_data_path = join_path('/', DATA_PATH, $frame);
+ %framedata = read_data_file($frame_data_path);
}
- if(int($state{'state'})==1 && $frame == int($state{'last'}) && $method ne 'HEAD' && !$passwordOK){
- my %newstate=%state;
- if($state{'ip1'} ne $IP) {
+ if (
+ int($state{'state'}) == STATE->{'waiting'} &&
+ $frame == int($state{'last'}) &&
+ $method ne 'HEAD' &&
+ !$passwordOK
+ ) {
+ my %newstate = %state;
+ if ($state{'ip1'} ne $IP) {
if ($state{'ip1'} eq '') {
$newstate{'ip1'} = $IP;
- writedatafile($statefile,%newstate);
+ write_data_file($statefile, '', '', \%newstate);
}
- elsif($state{'ip2'} ne $IP) {
+ elsif ($state{'ip2'} ne $IP) {
if ($state{'ip2'} eq '') {
$newstate{'ip2'} = $IP;
- writedatafile($statefile,%newstate);
+ write_data_file($statefile, '', '', \%newstate);
}
else {
- $newstate{'state'}=2;
+ $newstate{'state'} = STATE->{'ready'};
$newstate{'ip3'} = $IP;
- writedatafile($statefile,%newstate);
+ write_data_file($statefile, '', '', \%newstate);
}
}
}
}
- elsif(int($state{'state'})==0 && $frame == 1) {
+ elsif (int($state{'state'}) == STATE->{'inactive'} && $frame == 1) {
my %story;
+ my $framefilename;
my $inpath;
my $outpath;
- %story = readdatafile(DATA_STORY_PATH);
- %gotolist=readdatafile(DATA_LIST_PATH);
- if(int($story{'state'}) == 17 && int($story{'pass'}) == 1) {
+ %story = read_data_file(DATA_STORY_PATH);
+ %gotolist = read_data_file(DATA_LIST_PATH);
+ if (int($story{'state'}) == 0x11 && int($story{'pass'}) == 1) {
#ACTIVATE!
$framedata{'ongtime'} = $time;
- writedatafile(DATA_PATH.$frame,%framedata);
+ write_data_file($framedata_path, '', '', \%framedata);
$state{'state'} = 1;
$state{'last'} = 1;
$state {'ip1'} = '0.0.0.0';
$state {'nextong'} = (int($time / 3600) + int($settings{'firstongtime'})) * 3600 ;
$state{'ongtime'} = int($settings{'firstongtime'});
- unless(defined($framedata{'ext'})){
- $framedata{'ext'}=$default{'ext'};
+ unless (defined($framedata{'ext'})){
+ $framedata{'ext'} = $default{'ext'};
}
- $inpath = DATA_PATH.sprintf($settings{'frame'},$frame,$framedata{'ext'});
- $outpath = WWW_PATH.sprintf($settings{'frame'},$frame,$framedata{'ext'});
+ $framefilename = sprintf($settings{'frame'}, $frame, $framedata{'ext'});
+ $inpath = join_path('/', DATA_PATH, $framefilename);
+ $outpath = join_path('/', WWW_PATH, $framefilename);
- $gotolist{'title-1'}=$framedata{'title'};
- $gotolist{'ongtime-1'}=$framedata{'ongtime'};
+ $gotolist{'title-1'} = $framedata{'title'};
+ $gotolist{'ongtime-1'} = $framedata{'ongtime'};
- if(copy ($inpath, $outpath)) {
+ if (copy ($inpath, $outpath)) {
writeindex(WWW_INDEX_PATH);
- writedatafile($statefile,%state);
- writedatafile(DATA_LIST_PATH,%gotolist);
+ write_data_file($statefile, '', '', \%state);
+ write_data_file(DATA_LIST_PATH, '', '', \%gotolist);
}
else {
- $state{'state'} = 0;
+ $state{'state'} = STATE->{'inactive'};
}
}
}
bicyclesonthemoon.info / projects / ott / bsta / commitdiff