From b2eeb5761855dbd48b3a9923be3198db9ac33b67 Mon Sep 17 00:00:00 2001 From: b Date: Tue, 26 Mar 2024 19:27:38 +0000 Subject: [PATCH] continue rework: frame - OK, viewer - ongoing --- .gitmodules | 3 + botm-common | 1 + frame.1.pl | 114 ++++--- frameaftertime.1.pl | 115 +++---- makefile | 1 + makefile.1.mak | 1 + mscha_lib.1.pm | 705 ++++++++++------------------------------- settings-debug.txt | 8 + settings.txt | 15 +- viewer.1.pl | 478 +++++++++++++++++++--------- www-data/botmlogo2.png | Bin 0 -> 297 bytes 11 files changed, 647 insertions(+), 794 deletions(-) create mode 160000 botm-common create mode 100644 www-data/botmlogo2.png diff --git a/.gitmodules b/.gitmodules index b6a0567..12d6f38 100644 --- a/.gitmodules +++ b/.gitmodules @@ -4,3 +4,6 @@ [submodule "exec"] path = exec url = ../../../botm/exec +[submodule "botm-common"] + path = botm-common + url = ../../../botm/common-perl diff --git a/botm-common b/botm-common new file mode 160000 index 0000000..111fb5f --- /dev/null +++ b/botm-common @@ -0,0 +1 @@ +Subproject commit 111fb5f38624401ac7f332dd8bf7fa65e7bf5b23 diff --git a/frame.1.pl b/frame.1.pl index a01891c..de6d631 100644 --- a/frame.1.pl +++ b/frame.1.pl @@ -1,73 +1,84 @@ -#!/usr/bin/perl -# +###RUN_PERL: #!/usr/bin/perl + # /mscha/frame -# 04.03.2020 # mscha time frame # -# Copyright (C) 2020 Balthasar Szczepański +# Copyright (C) 2020, 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 -# published by the Free Software Foundation, either version 3 of the -# License, or (at your option) any later version. +# This program is free software: you can redistribute it and/or modify +# it under the terms of the GNU Affero General Public License as +# published by the Free Software Foundation, either version 3 of the +# License, or (at your option) any later version. # -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU Affero General Public License for more details. +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU Affero General Public License for more details. # -# You should have received a copy of the GNU Affero General Public License -# along with this program. If not, see . +# You should have received a copy of the GNU Affero General Public License +# along with this program. If not, see . use strict; +use utf8; +# use Encode::Locale ('decode_argv'); +use Encode ('encode', 'decode'); + +###PERL_LIB: use lib /botm/lib/mscha +use botm_common ( + 'HTTP_STATUS', + 'fail_method', 'fail_content_type', + 'read_header_env', + 'url_query_decode', + 'merge_settings' +); +use mscha_lib ( + 'redirect', + 'get_time_frame' +); -#use warnings; -use lib '/eizm/lib/ottbackup/mscha/'; -use mscha_lib qw(failpage gethttpheader getcgi gettimeframe redirect); +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 %cgipost; -my %frameinfo; +my %cgi_post; +my %frame_info; my $method; my $frame; my $mode; -# my $embed; -my $embedUrl; +my $embed_URL; my $header; my $title; my $message; 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'}); } } -# $embed=lc($cgi{'embed'}); - if ($ENV{'PATH_INFO'} =~ /^\/([^\/]+)(\/(.+))?$/) { $frame = $1; $mode = lc($3); @@ -75,37 +86,40 @@ if ($ENV{'PATH_INFO'} =~ /^\/([^\/]+)(\/(.+))?$/) { $frame = '1'; $mode = ''; } -if ($cgi{'period'} ne '') { - $frame=$cgi{'period'}; + +if ($cgi{'frameNo'} ne '') { + $frame = $cgi{'frameNo'}; } -if ($cgi{'frame'} ne '') { - $frame=$cgi{'frame'}; +elsif ($cgi{'frame'} ne '') { + $frame = $cgi{'frame'}; } -if ($cgi{'frameNo'} ne '') { - $frame=$cgi{'frameNo'}; +elsif ($cgi{'period'} ne '') { + $frame = $cgi{'period'}; } + if ($cgi{'mode'} ne '') { - $mode=lc($cgi{'mode'}); + $mode = lc($cgi{'mode'}); } if ($mode !~ /^(orig|diff)$/) { $mode = ''; } -%frameinfo = gettimeframe($frame,$time); +%frame_info = get_time_frame($frame, $time); -if (($mode eq 'diff') && ($frameinfo{'diffUrl'} eq '')) { +if (($mode eq 'diff') && ($frame_info{'diffUrl'} eq '')) { $mode = ''; } if ($mode eq 'orig') { - $embedUrl = $frameinfo{'downloadedUrl'}; -} elsif ($mode eq 'diff') { - $embedUrl = $frameinfo{'diffUrl'}; -} else { - $embedUrl = ($frameinfo{'xkcdUrl'} ne '')?$frameinfo{'xkcdUrl'}:$frameinfo{'downloadedUrl'}; + $embed_URL = $frame_info{'downloadedUrl'}; +} +elsif ($mode eq 'diff') { + $embed_URL = $frame_info{'diffUrl'}; +} +else { + $embed_URL = ($frame_info{'xkcdUrl'} ne '') ? + $frame_info{'xkcdUrl'} : + $frame_info{'downloadedUrl'}; } -# if ($embedUrl !~ /^http/) { - # $embedUrl = 'http://1190.bicyclesonthemoon.info'.$embedUrl; -# } -redirect($embedUrl, !!%cgi, $method); +redirect($method, $embed_URL, HTTP_STATUS->{'see_other'}); diff --git a/frameaftertime.1.pl b/frameaftertime.1.pl index b9054de..2a5aa5a 100644 --- a/frameaftertime.1.pl +++ b/frameaftertime.1.pl @@ -1,70 +1,80 @@ -#!/usr/bin/perl +###RUN_PERL: #!/usr/bin/perl # # /mscha/frameaftertime -# 04.03.2020 # mscha TaT frame # -# Copyright (C) 2020 Balthasar Szczepański +# Copyright (C) 2020, 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 -# published by the Free Software Foundation, either version 3 of the -# License, or (at your option) any later version. +# This program is free software: you can redistribute it and/or modify +# it under the terms of the GNU Affero General Public License as +# published by the Free Software Foundation, either version 3 of the +# License, or (at your option) any later version. # -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU Affero General Public License for more details. +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU Affero General Public License for more details. # -# You should have received a copy of the GNU Affero General Public License -# along with this program. If not, see . +# You should have received a copy of the GNU Affero General Public License +# along with this program. If not, see . use strict; - -#use warnings; -use lib '/eizm/lib/ottbackup/mscha/'; -use mscha_lib qw(failpage gethttpheader getcgi gettatframe redirect); +use utf8; +# use Encode::Locale ('decode_argv'); +use Encode ('encode', 'decode'); + +###PERL_LIB: use lib /botm/lib/mscha +use botm_common ( + 'HTTP_STATUS', + 'fail_method', 'fail_content_type', + 'read_header_env', + 'url_query_decode', + 'merge_settings' +); +use mscha_lib ( + 'redirect', + 'get_tat_frame' +); + +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 %cgipost; -my %frameinfo; +my %cgi_post; +my %frame_info; my $method; my $frame; my $mode; -# my $embed; -my $embedUrl; -# my $tatName; +my $embed_URL; 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'}); } } -# $embed=lc($cgi{'embed'}); - if ($ENV{'PATH_INFO'} =~ /^\/([^\/]+)(\/(.+))?$/) { $frame = $1; $mode = lc($3); @@ -72,42 +82,39 @@ if ($ENV{'PATH_INFO'} =~ /^\/([^\/]+)(\/(.+))?$/) { $frame = '1'; $mode = ''; } -if ($cgi{'frame'} ne '') { - $frame=$cgi{'frame'}; -} + if ($cgi{'frameNo'} ne '') { - $frame=$cgi{'frameNo'}; + $frame = $cgi{'frameNo'}; +} +elsif ($cgi{'frame'} ne '') { + $frame = $cgi{'frame'}; } + if ($cgi{'mode'} ne '') { - $mode=lc($cgi{'mode'}); + $mode = lc($cgi{'mode'}); } if ($mode !~ /^(orig|diff)$/) { $mode = ''; } -%frameinfo = gettatframe($frame,$time); +%frame_info = get_tat_frame($frame, $time); -if (($mode eq 'diff') && ($frameinfo{'diffUrl'} eq '')) { +if (($mode eq 'diff') && ($frame_info{'diffUrl'} eq '')) { $mode = ''; } -# if ($frameinfo{'match'} !~ /^(frameNo|downloadedUrl|tatUrl)$/) { - # $frame = $frameinfo{'frameNo'}; -# } - -if (($mode eq '') && ($frameinfo{'match'} eq 'downloadedUrl')) { +if (($mode eq '') && ($frame_info{'match'} eq 'downloadedUrl')) { $mode = 'orig'; } if ($mode eq 'orig') { - $embedUrl = $frameinfo{'downloadedUrl'}; -} elsif ($mode eq 'diff') { - $embedUrl = $frameinfo{'diffUrl'}; -} else { - $embedUrl = $frameinfo{'tatUrl'}; + $embed_URL = $frame_info{'downloadedUrl'}; +} +elsif ($mode eq 'diff') { + $embed_URL = $frame_info{'diffUrl'}; +} +else { + $embed_URL = $frame_info{'tatUrl'}; } -# if ($embedUrl !~ /^http/) { - # $embedUrl = 'http://1190.bicyclesonthemoon.info'.$embedUrl; -# } -redirect($embedUrl, !!%cgi, $method); +redirect($method, $embed_URL, HTTP_STATUS->{'see_other'}); diff --git a/makefile b/makefile index b9e629c..7abf1d7 100644 --- a/makefile +++ b/makefile @@ -89,6 +89,7 @@ $(PERL_WRAP_EXEC) LIB=\ +botm-common/botm_common.pm\ mscha_lib.pm DIR=\ diff --git a/makefile.1.mak b/makefile.1.mak index 7d13bae..f8064c5 100644 --- a/makefile.1.mak +++ b/makefile.1.mak @@ -89,6 +89,7 @@ $(PERL_WRAP_EXEC) LIB=\ +botm-common/botm_common.pm\ mscha_lib.pm DIR=\ diff --git a/mscha_lib.1.pm b/mscha_lib.1.pm index 2934890..6066ca6 100644 --- a/mscha_lib.1.pm +++ b/mscha_lib.1.pm @@ -1,7 +1,5 @@ # Library of functions # -# Library of functions -# # Copyright (C) 2020, 2024 Balthasar Szczepański # # This program is free software: you can redistribute it and/or modify @@ -31,429 +29,37 @@ use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); @ISA = qw(Exporter); @EXPORT = (); @EXPORT_OK = ( - 'failpage', - 'entityencode', - 'gethttpheader', - 'getcgi', - 'urldecode', - 'gettimeframe', - 'urlencode' - 'printframeselection', - 'gettatframe', - 'redirect' + 'get_time_frame', 'get_tat-frame', + 'print_frame_selection' ); ###PERL_LIB: use lib /botm/lib/ottbackub/mscha +use botm_common ( + 'http_status', 'http_header_line', 'http_header_location', + 'html_entity_encode_dec', + 'open_encoded' +) -use constant entitycode => { - 'amp' => '&', - 'gt' => '>', - 'lt' => '<', - 'quot' => '"', - 'acute' => '´', - 'cedil' => '¸', - 'circ' => 'ˆ', - 'macr' => '¯', - 'middot' => '·', - 'tilde' => '˜', - 'uml' => '¨', - 'Aacute' => 'Á', - 'aacute' => 'á', - 'Acirc' => 'Â', - 'acirc' => 'â', - 'AElig' => 'Æ', - 'aelig' => 'æ', - 'Agrave' => 'À', - 'agrave' => 'à', - 'Aring' => 'Å', - 'aring' => 'å', - 'Atilde' => 'Ã', - 'atilde' => 'ã', - 'Auml' => 'Ä', - 'auml' => 'ä', - 'Ccedil' => 'Ç', - 'ccedil' => 'ç', - 'Eacute' => 'É', - 'eacute' => 'é', - 'Ecirc' => 'Ê', - 'ecirc' => 'ê', - 'Egrave' => 'È', - 'egrave' => 'è', - 'ETH' => 'Ð', - 'eth' => 'ð', - 'Euml' => 'Ë', - 'euml' => 'ë', - 'Iacute' => 'Í', - 'iacute' => 'í', - 'Icirc' => 'Î', - 'icirc' => 'î', - 'Igrave' => 'Ì', - 'igrave' => 'ì', - 'Iuml' => 'Ï', - 'iuml' => 'ï', - 'Ntilde' => 'Ñ', - 'ntilde' => 'ñ', - 'Oacute' => 'Ó', - 'oacute' => 'ó', - 'Ocirc' => 'Ô', - 'ocirc' => 'ô', - 'OElig' => 'Œ', - 'oelig' => 'œ', - 'Ograve' => 'Ò', - 'ograve' => 'ò', - 'Oslash' => 'Ø', - 'oslash' => 'ø', - 'Otilde' => 'Õ', - 'otilde' => 'õ', - 'Ouml' => 'Ö', - 'ouml' => 'ö', - 'Scaron' => 'Š', - 'scaron' => 'š', - 'szlig' => 'ß', - 'THORN' => 'Þ', - 'thorn' => 'þ', - 'Uacute' => 'Ú', - 'uacute' => 'ú', - 'Ucirc' => 'Û', - 'ucirc' => 'û', - 'Ugrave' => 'Ù', - 'ugrave' => 'ù', - 'Uuml' => 'Ü', - 'uuml' => 'ü', - 'Yacute' => 'Ý', - 'yacute' => 'ý', - 'yuml' => 'ÿ', - 'Yuml' => 'Ÿ', - 'cent' => '¢', - 'curren' => '¤', - 'euro' => '€', - 'pound' => '£', - 'yen' => '¥', - 'brvbar' => '¦', - 'bull' => '•', - 'copy' => '©', - 'dagger' => '†', - 'Dagger' => '‡', - 'frasl' => '⁄', - 'hellip' => '…', - 'iexcl' => '¡', - 'image' => 'ℑ', - 'iquest' => '¿', - 'lrm' => '‎', - 'mdash' => '—', - 'ndash' => '–', - 'not' => '¬', - 'oline' => '‾', - 'ordf' => 'ª', - 'ordm' => 'º', - 'para' => '¶', - 'permil' => '‰', - 'prime' => '′', - 'Prime' => '″', - 'real' => 'ℜ', - 'reg' => '®', - 'rlm' => '‏', - 'sect' => '§', - 'shy' => '­', - 'sup1' => '¹', - 'trade' => '™', - 'weierp' => '℘', - 'bdquo' => '„', - 'laquo' => '«', - 'ldquo' => '“', - 'lsaquo' => '‹', - 'lsquo' => '‘', - 'raquo' => '»', - 'rdquo' => '”', - 'rsaquo' => '›', - 'rsquo' => '’', - 'sbquo' => '‚', - 'emsp' => ' ', - 'ensp' => ' ', - 'nbsp' => ' ', - 'thinsp' => ' ', - 'zwj' => '‍', - 'zwnj' => '‌', - 'deg' => '°', - 'divide' => '÷', - 'frac12' => '½', - 'frac14' => '¼', - 'frac34' => '¾', - 'ge' => '≥', - 'le' => '≤', - 'minus' => '−', - 'sup2' => '²', - 'sup3' => '³', - 'times' => '×', - 'alefsym' => 'ℵ', - 'and' => '∧', - 'ang' => '∠', - 'asymp' => '≈', - 'cap' => '∩', - 'cong' => '≅', - 'cup' => '∪', - 'empty' => '∅', - 'equiv' => '≡', - 'exist' => '∃', - 'fnof' => 'ƒ', - 'forall' => '∀', - 'infin' => '∞', - 'int' => '∫', - 'isin' => '∈', - 'lang' => '⟨', - 'lceil' => '⌈', - 'lfloor' => '⌊', - 'lowast' => '∗', - 'micro' => 'µ', - 'nabla' => '∇', - 'ne' => '≠', - 'ni' => '∋', - 'notin' => '∉', - 'nsub' => '⊄', - 'oplus' => '⊕', - 'or' => '∨', - 'otimes' => '⊗', - 'part' => '∂', - 'perp' => '⊥', - 'plusmn' => '±', - 'prod' => '∏', - 'prop' => '∝', - 'radic' => '√', - 'rang' => '⟩', - 'rceil' => '⌉', - 'rfloor' => '⌋', - 'sdot' => '⋅', - 'sim' => '∼', - 'sub' => '⊂', - 'sube' => '⊆', - 'sum' => '∑', - 'sup' => '⊃', - 'supe' => '⊇', - 'there4' => '∴', - 'Alpha' => 'Α', - 'alpha' => 'α', - 'Beta' => 'Β', - 'beta' => 'β', - 'Chi' => 'Χ', - 'chi' => 'χ', - 'Delta' => 'Δ', - 'delta' => 'δ', - 'Epsilon' => 'Ε', - 'epsilon' => 'ε', - 'Eta' => 'Η', - 'eta' => 'η', - 'Gamma' => 'Γ', - 'gamma' => 'γ', - 'Iota' => 'Ι', - 'iota' => 'ι', - 'Kappa' => 'Κ', - 'kappa' => 'κ', - 'Lambda' => 'Λ', - 'lambda' => 'λ', - 'Mu' => 'Μ', - 'mu' => 'μ', - 'Nu' => 'Ν', - 'nu' => 'ν', - 'Omega' => 'Ω', - 'omega' => 'ω', - 'Omicron' => 'Ο', - 'omicron' => 'ο', - 'Phi' => 'Φ', - 'phi' => 'φ', - 'Pi' => 'Π', - 'pi' => 'π', - 'piv' => 'ϖ', - 'Psi' => 'Ψ', - 'psi' => 'ψ', - 'Rho' => 'Ρ', - 'rho' => 'ρ', - 'Sigma' => 'Σ', - 'sigma' => 'σ', - 'sigmaf' => 'ς', - 'Tau' => 'Τ', - 'tau' => 'τ', - 'Theta' => 'Θ', - 'theta' => 'θ', - 'thetasym' => 'ϑ', - 'upsih' => 'ϒ', - 'Upsilon' => 'Υ', - 'upsilon' => 'υ', - 'Xi' => 'Ξ', - 'xi' => 'ξ', - 'Zeta' => 'Ζ', - 'zeta' => 'ζ', - 'crarr' => '↵', - 'darr' => '↓', - 'dArr' => '⇓', - 'harr' => '↔', - 'hArr' => '⇔', - 'larr' => '←', - 'lArr' => '⇐', - 'rarr' => '→', - 'rArr' => '⇒', - 'uarr' => '↑', - 'uArr' => '⇑', - 'clubs' => '♣', - 'diams' => '♦', - 'hearts' => '♥', - 'spades' => '♠', - 'loz' => '◊', -}; - -use constant time_data => '/eizm/www/time/mscha/time-data'; -use constant time_data_period => '/eizm/www/time/mscha/time-data-period'; -use constant tat_data => '/eizm/www/time/mscha/tat-data'; - - -# Function to show 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)=@_; - if($header ne ''){ - print $header; - } - if($method eq 'HEAD') { - print "\n"; - return; - } - print "Content-type: text/html\n\n"; - print ''."\n"; - print ''."\n"; - if($title ne ''){ - print ''.entityencode($title).''."\n"; - } - print ''."\n"; - print ''."\n"; - if($title ne ''){ - print '

'.entityencode($title).'

'."\n"; - } - if($message ne ''){ - print '

'.entityencode($message).'

'."\n"; - } - print ''."\n"; -} - -# HTTP redirection -sub redirect { - (my $url, my $temporary, my $method)=@_; - $url =~ s/\n//g; - my $status = $temporary?'302 Found':'301 Moved Permanently'; - my $en_url = entityencode($url); - - print 'Status: '.$status."\n"; - print 'Location: '.$url."\n"; - if($method eq 'HEAD') { - print "\n"; - return; - } - print "Content-type: text/html\n\n"; - print ''."\n"; - print ''."\n"; - print ''.$status.''."\n"; - print ''."\n"; - print ''."\n"; - print '

'.$status.'

'."\n"; - print '

'.$en_url.'

'."\n"; - print ''."\n"; -} - -# function to encode entities, decimal, -sub entityencode { - (my $t, my $all) = @_; - if ($all) { - $t =~ s/(.)/sprintf('\&#%02hu;',ord($1))/eg; - } - else { - $t =~ s/([\"=><\&])/sprintf('&#%02hu;',ord($1))/eg; - } - return $t; -} - -# function to get values of http header fields. Returns a hash. names of header -# fields are lowercase -sub gethttpheader { - (my $env) = @_; - - my %http; - - foreach my $ind (keys %$env) { - my $name = ''; - my $value= ''; - - if ($ind =~ /^HTTP_([A-Z0-9_]+)$/) { - $name=$1; - } - elsif ($ind =~ /^(CONTENT_[A-Z0-9_]+)$/) { - $name=$1; - } - else{ - next; - } - $name =~ s/_/-/g; - $name = lc($name); - if ($$env{$ind} =~ /^([\x20-\x7e]*)$/) { - $value=$1; - } - else { - next; - } - $http{$name}=$value; - } - return %http; -} - -# The function to get CGI parameters from string. -# Format is: name=url_encoded_value&name=url_encoded_value& ... &name=url_encoded_value -sub getcgi { - my $arg; - my $val; - my %cgi; - my $i = $_[0]; - $i =~ s/[\r\n]//g; - my @s = split('&',$i); - foreach my $l ( @s) { - ($arg,$val)=split('=',$l); - $cgi{$arg}=urldecode($val); - } - return %cgi; -} - -# Function for decoding URL-encoded text -sub urldecode { - my $t = $_[0]; - $t =~ s/\+/ /g; - $t =~ s/%([a-fA-F0-9]{2})/chr(hex($1))/eg; - return $t; -} - -# Function for URL-encoding -sub urlencode { - (my $t, my $all) = @_; - if ($all) { - $t =~ s/(.)/sprintf('%%%02hX',ord($1))/eg; - } - else { - $t =~ s/([^0-9A-Za-z.~\-_])/sprintf('%%%02hX',ord($1))/eg; - } - return $t; -} +###PERL_WWW_TAT_DATA_PATH: WWW_TAT_DATA_PATH = /botm/www/1190/mscha/tat-data +###PERL_WWW_TIME_DATA_PATH: WWW_TIME_DATA_PATH = /botm/www/1190/mscha/time-data +###PERL_WWW_TIME_DATA_PERIOD_PATH: WWW_TIME_DATA_PERIOD_PATH = /botm/www/1190/mscha/time-data-period # Function to find a frame and get its options -sub gettimeframe { +sub get_time_frame { (my $id, my $time) = @_; - my %frameinfo; + my %frame_info; my %fallback; - my $datafile; + my $fh; - my $mschaID; - my $aubronwoodID; + my $mscha_ID; + my $aubronwood_ID; my $geekwagonID; my $hash; my $timetext; my $filename; - my $firstline=1; + my $firstline = 1; my $found = ''; my @tab; @@ -463,48 +69,51 @@ sub gettimeframe { $id = lc($id); } - if ($id =~ /^([0-9]+[a-z]?)$/) { - $mschaID = $1; + if ($id =~ /^[0-9]+[a-z]?$/) { + $mscha_ID = $&; } - if ($id =~ /^ba([0-9]+?)$/) { - $aubronwoodID = $1; + if ($id =~ /^ba([0-9]+)$/) { + $aubronwood_ID = $1; } - if ($id =~ /^gw([0-9]+?)$/) { + if ($id =~ /^gw([0-9]+)$/) { $geekwagonID = $1; } - if ($id =~ /^([0-9a-f]+)$/) { - $hash = $1; + if ($id =~ /^[0-9a-f]+$/) { + $hash = $&; } - if ($id =~ /^([0-9]{8}_[0-9]{4})$/) { - $timetext = $1; + if ($id =~ /^[0-9]{8}_[0-9]{4}$/) { + $timetext = $&; } if ($id eq 'ung') { - my @timetab=gmtime($time); - $timetext=sprintf('2013%02d%02d_%02d%02d',$timetab[4]+1,$timetab[3],$timetab[2],$timetab[1]); + my @timetab = gmtime($time); + $timetext = sprintf( + '2013%02d%02d_%02d%02d', + $timetab[4]+1, $timetab[3], $timetab[2], $timetab[1] + ); } if ($id eq 'random') { - $aubronwoodID = int(rand(3102))+1; #aubronwood has best numbering for this purpose + $aubronwood_ID = int(rand(3102))+1; #aubronwood has best numbering for this purpose } - unless (open ($datafile, '<', time_data)) { - return %frameinfo; + unless (open_encoded ($fh, '<:encoding(utf8)', WWW_TIME_DATA_PATH())) { + return %frame_info; } if ($id eq 'randomsound') { my $soundcount = 0; my @soundtab; - while (defined(my $line = <$datafile>)) { - $line =~ s/(\r)?\n$//g; + while (defined(my $line = <$fh>)) { + $line =~ s/(\r)?\n$//gs; if ($firstline) { $firstline = ''; - $frameinfo{'match'} = ''; + $frame_info{'match'} = ''; next; } @@ -516,32 +125,32 @@ sub gettimeframe { } } if ($soundcount > 0) { - $mschaID = $soundtab[int(rand($soundcount))]; + $mscha_ID = $soundtab[int(rand($soundcount))]; } else { - $mschaID = '1'; + $mscha_ID = '1'; } - seek($datafile, 0, 0); + seek($fh, 0, 0); $firstline=1; } - while (defined(my $line = <$datafile>)) { + while (defined(my $line = <$fh>)) { $line =~ s/(\r)?\n$//g; if ($firstline) { $firstline = ''; - $frameinfo{'match'} = ''; + $frame_info{'match'} = ''; next; } @tab = split (/\t/, $line); if ($found) { - $frameinfo{'next'} = $tab[0]; + $frame_info{'next'} = $tab[0]; last; } if ($timetext ne '') { - if ($frameinfo{'match'} ne 'dateTime') { - $frameinfo{'match'} = 'dateTime'; + if ($frame_info{'match'} ne 'dateTime') { + $frame_info{'match'} = 'dateTime'; } else { my $toolate = ''; my $LYear = int(substr($tab[2], 0,4)); @@ -586,97 +195,97 @@ sub gettimeframe { } if ($toolate) { - $found=1; + $found = 1; next; } } } - $frameinfo{'prev'} = $frameinfo{'frameNo'}; - $frameinfo{'frameNo'} = $tab[0]; - $frameinfo{'apocryphal'} = $tab[1]; - $frameinfo{'dateTime'} = $tab[2]; - $frameinfo{'epoch'} = $tab[3]; - $frameinfo{'hash'} = $tab[4]; - $frameinfo{'downloadedUrl'} = $tab[5]; - $frameinfo{'xkcdUrl'} = $tab[6]; - $frameinfo{'diffUrl'} = $tab[7]; - $frameinfo{'gwFrameNo'} = $tab[8]; - $frameinfo{'baFrameNo'} = $tab[9]; - $frameinfo{'botmEnhance'} = $tab[10]; - $frameinfo{'alt'} = $tab[11]; - $frameinfo{'soundUrl'} = $tab[12]; + $frame_info{'prev' } = $frame_info{'frameNo'}; + $frame_info{'frameNo' } = $tab[0]; + $frame_info{'apocryphal' } = $tab[1]; + $frame_info{'dateTime' } = $tab[2]; + $frame_info{'epoch' } = $tab[3]; + $frame_info{'hash' } = $tab[4]; + $frame_info{'downloadedUrl'} = $tab[5]; + $frame_info{'xkcdUrl' } = $tab[6]; + $frame_info{'diffUrl' } = $tab[7]; + $frame_info{'gwFrameNo' } = $tab[8]; + $frame_info{'baFrameNo' } = $tab[9]; + $frame_info{'botmEnhance' } = $tab[10]; + $frame_info{'alt' } = $tab[11]; + $frame_info{'soundUrl' } = $tab[12]; - if($fallback{'match'} eq ''){ - %fallback = %frameinfo; - $fallback{'match'}='fallback'; - } elsif ($fallback{'next'} eq ''){ - $fallback{'next'} = $frameinfo{'frameNo'}; + if ($fallback{'match'} eq '') { + %fallback = %frame_info; + $fallback{'match'} = 'fallback'; + } elsif ($fallback{'next'} eq '') { + $fallback{'next'} = $frame_info{'frameNo'}; } - if ($mschaID ne '') { - if ($mschaID eq lc($frameinfo{'frameNo'})) { - $frameinfo{'match'}='frameNo'; - $found=1; + if ($mscha_ID ne '') { + if ($mscha_ID eq lc($frame_info{'frameNo'})) { + $frame_info{'match'} = 'frameNo'; + $found = 1; next; } } - if ($aubronwoodID ne '') { - if ($aubronwoodID eq $frameinfo{'baFrameNo'}) { + if ($aubronwood_ID ne '') { + if ($aubronwood_ID eq $frame_info{'baFrameNo'}) { if($id eq 'random') { - $frameinfo{'match'}='random'; + $frame_info{'match'} ='random'; } else { - $frameinfo{'match'}='baFrameNo'; + $frame_info{'match'} ='baFrameNo'; } - $found=1; + $found = 1; next; } } if ($geekwagonID ne '') { - if ($geekwagonID eq $frameinfo{'gwFrameNo'}) { - $frameinfo{'match'}='gwFrameNo'; - $found=1; + if ($geekwagonID eq $frame_info{'gwFrameNo'}) { + $frame_info{'match'} = 'gwFrameNo'; + $found = 1; next; } } if ($hash ne '') { - if ($hash eq lc($frameinfo{'hash'})) { - $frameinfo{'match'}='hash'; - $found=1; + if ($hash eq lc($frame_info{'hash'})) { + $frame_info{'match'} ='hash'; + $found = 1; next; } } - if ($frameinfo{'downloadedUrl'} =~ /\/([^\/\.]+)\./) { + if ($frame_info{'downloadedUrl'} =~ /\/([^\/\.]+)\./) { $filename = lc($1); if ($id eq $filename) { - $frameinfo{'match'}='downloadedUrl'; - $found=1; + $frame_info{'match'} = 'downloadedUrl'; + $found = 1; next; } } } - close ($datafile); + close ($fh); - if ($frameinfo{'match'} ne '') { - return %frameinfo; + if ($frame_info{'match'} ne '') { + return %frame_info; } else { return %fallback; } } # Function to find a TaT frame and get its options -sub gettatframe { +sub get_tat_frame { (my $id) = @_; - my %frameinfo; + my %frame_info; my %fallback; - my $datafile; + my $fh; - my $mschaID; + my $mscha_ID; my $randomID; my $hash; my $timetext; @@ -694,46 +303,46 @@ sub gettatframe { $id = lc($id); } - if ($id =~ /^([0-9]+([a-z]|½)?)$/) { - $mschaID = $1; + if ($id =~ /^[0-9]+([a-z]|½)?$/) { + $mscha_ID = $&; } - if ($hash =~ /^([0-9a-zA-Z\-\+]+)$/) { - $hash = $1; + if ($hash =~ /^[0-9a-zA-Z\-\+]+$/) { + $hash = $&; } else { $hash = ''; } - if ($id =~ /^([0-9]{8}_[0-9]{4})$/) { - $timetext = $1; + if ($id =~ /^[0-9]{8}_[0-9]{4}$/) { + $timetext = $&; } if ($id eq 'random') { $randomID = int(rand(2561)); } - unless (open ($datafile, '<', tat_data)) { - return %frameinfo; + unless (open_encoded ($fh, '<:encoding(utf8)', WWW_TAT_DATA_PATH())) { + return %frame_info; } - while (defined(my $line = <$datafile>)) { + while (defined(my $line = <$fh>)) { $line =~ s/(\r)?\n$//g; if ($firstline) { $firstline = ''; - $frameinfo{'match'} = ''; + $frame_info{'match'} = ''; next; } @tab = split (/\t/, $line); if ($found) { - $frameinfo{'next'} = $tab[0]; + $frame_info{'next'} = $tab[0]; last; } if ($timetext ne '') { - if ($frameinfo{'match'} ne 'dateTime') { - $frameinfo{'match'} = 'dateTime'; + if ($frame_info{'match'} ne 'dateTime') { + $frame_info{'match'} = 'dateTime'; } else { my $toolate = ''; my $LYear = int(substr($tab[1], 0,4)); @@ -778,103 +387,106 @@ sub gettatframe { } if ($toolate) { - $found=1; + $found = 1; next; } } } - $frameinfo{'prev'} = $frameinfo{'frameNo'}; - $frameinfo{'frameNo'} = $tab[0]; - $frameinfo{'dateTime'} = $tab[1]; - $frameinfo{'epoch'} = $tab[2]; - $frameinfo{'downloadedUrl'} = $tab[3]; - $frameinfo{'tatUrl'} = $tab[4]; - $frameinfo{'diffUrl'} = $tab[5]; - $frameinfo{'origName'} = $tab[6]; - $frameinfo{'botmName'} = $tab[7]; - $frameinfo{'botmFrameNo'} = $tab[8]; - $frameinfo{'botmEnhance'} = $tab[9]; - $frameinfo{'random'} = $tab[10]; - $frameinfo{'alt'} = $tab[11]; + $frame_info{'prev' } = $frame_info{'frameNo'}; + $frame_info{'frameNo' } = $tab[0]; + $frame_info{'dateTime' } = $tab[1]; + $frame_info{'epoch' } = $tab[2]; + $frame_info{'downloadedUrl'} = $tab[3]; + $frame_info{'tatUrl' } = $tab[4]; + $frame_info{'diffUrl' } = $tab[5]; + $frame_info{'origName ' } = $tab[6]; + $frame_info{'botmName' } = $tab[7]; + $frame_info{'botmFrameNo' } = $tab[8]; + $frame_info{'botmEnhance' } = $tab[9]; + $frame_info{'random' } = $tab[10]; + $frame_info{'alt' } = $tab[11]; - if($fallback{'match'} eq ''){ - %fallback = %frameinfo; - $fallback{'match'}='fallback'; - } elsif ($fallback{'next'} eq ''){ - $fallback{'next'} = $frameinfo{'frameNo'}; + if ($fallback{'match'} eq '') { + %fallback = %frame_info; + $fallback{'match'} ='fallback'; + } elsif ($fallback{'next'} eq '') { + $fallback{'next'} = $frame_info{'frameNo'}; } - if ($mschaID ne '') { - if ($mschaID eq lc($frameinfo{'frameNo'})) { - $frameinfo{'match'}='frameNo'; - $found=1; + if ($mscha_ID ne '') { + if ($mscha_ID eq lc($frame_info{'frameNo'})) { + $frame_info{'match'} = 'frameNo'; + $found = 1; next; } } if ($randomID ne '') { - if ($randomID eq lc($frameinfo{'random'})) { - $frameinfo{'match'}='random'; - $found=1; + if ($randomID eq lc($frame_info{'random'})) { + $frame_info{'match'} = 'random'; + $found = 1; next; } } - if ($frameinfo{'origName'} =~ /^([^\.]*)\./) { + if ($frame_info{'origName'} =~ /^([^\.]*)\./) { $filename = $1; if ($hash eq $filename) { - $frameinfo{'match'}='origName'; - $found=1; + $frame_info{'match'} = 'origName'; + $found = 1; next; } } - if ($frameinfo{'downloadedUrl'} =~ /\/([^\/\.]+)\./) { + if ($frame_info{'downloadedUrl'} =~ /\/([^\/\.]+)\./) { $filename = lc($1); if ($id eq $filename) { - $frameinfo{'match'}='downloadedUrl'; - $found=1; + $frame_info{'match'} = 'downloadedUrl'; + $found = 1; next; } } - if ($frameinfo{'tatUrl'} =~ /\/([^\/\.]+)\./) { + if ($frame_info{'tatUrl'} =~ /\/([^\/\.]+)\./) { $filename = lc($1); if ($id eq $filename) { - $frameinfo{'match'}='tatUrl'; - $found=1; + $frame_info{'match'} = 'tatUrl'; + $found = 1; next; } } } - close ($datafile); + close ($fh); - if ($frameinfo{'match'} ne '') { - return %frameinfo; + if ($frame_info{'match'} ne '') { + return %frame_info; } else { return %fallback; } } -sub printframeselection { +sub print_frame_selection { (my $id) = @_; - my $datafile; - my $firstline=1; + my $fh; + my $firstline = 1; my @tab; - my $class=''; - my $value=''; - my $name=''; - my $found=''; + my $class = ''; + my $value = ''; + my $name = ''; + my $_class; + my $_value; + my $_name; + my $found = ''; $id = int($id); - unless (open ($datafile, '<', time_data_period)) { + unless (open_encoded ($fh, '<:encoding(uft8)', WWW_TIME_DATA_PERIOD_PATH)) { return; } - while (defined(my $line = <$datafile>)) { + while (defined(my $line = <$fh>)) { $line =~ s/(\r)?\n$//g; if ($firstline) { $firstline = ''; @@ -883,24 +495,27 @@ sub printframeselection { @tab = split (/\t/, $line); if ($value ne '') { - print ''; + print ' value="'.$_value.'">'.$_name.''; } $class = $tab[0]; $value = $tab[1]; $name = $tab[2]; + $_class = html_entity_encode_dec($class); + $_value = html_entity_encode_dec($value); + $_name = html_entity_encode_dec($name); } - close ($datafile); + close ($fh); if ($value ne '') { - print ''; + print ' value="'.$_value.'">'.$_name.''; } } diff --git a/settings-debug.txt b/settings-debug.txt index d812ad9..fb15962 100644 --- a/settings-debug.txt +++ b/settings-debug.txt @@ -29,3 +29,11 @@ log_size_limit: 65536 logs_uncompressed: 2 logs_total: 10 oldlogs_schedule: #0 3 * * * + +scheme : http +website : 1190.bicyclesonthemoon.info + +tat_viewer : /aftertime/viewer +aubronwood : http://xkcd.aubronwood.com +geekwagon : http://geekwagon.net/projects/xkcd1190 + diff --git a/settings.txt b/settings.txt index a76ebf1..fd3fae3 100644 --- a/settings.txt +++ b/settings.txt @@ -40,11 +40,15 @@ _cgi_tat_view_2_path = @_PATH($cgi_path, viewaftertime.fcgi) _cgi_view_path = @_PATH($cgi_path, viewer ) _cgi_view_2_path = @_PATH($cgi_path, view.fcgi ) +_www_path = @_PATH($www_path, ) +_www_tat_data_data_path = @_PATH($www_path, tat_data ) +_www_time_data_path = @_PATH($www_path, time_data ) +_www_time_data_period_path = @_PATH($www_path, time_data_period) + _conf_path = @_PATH($conf_path, $name\.conf) _lib_path = @_PATH($lib_path,) _log_path = @_PATH($log_path,) -_www_path = @_PATH($www_path,) CONF_BIN = $_bin_path @@ -85,4 +89,11 @@ PERL_SET_PATH = \$ENV{'PATH'} = @_PERL_STR($path); PERL_EXPORT_VERSION = @_PERL_OUR_STR( VERSION, $_version) -# PERL_PATH_SEPARATOR = @_PERL_CONSTANT_STR( PATH_SEPARATOR, $_PATH_SEPARATOR) \ No newline at end of file +# PERL_PATH_SEPARATOR = @_PERL_CONSTANT_STR( PATH_SEPARATOR, $_PATH_SEPARATOR) + +PERL_WWW_TAT_DATA_PATH = @_PERL_CONSTANT_STR( WWW_TAT_DATA_PATH, $_www_tat_data_path ) +PERL_WWW_TIME_DATA_PATH = @_PERL_CONSTANT_STR( WWW_TIME_DATA_PATH, $_www_time_data_path ) +PERL_WWW_TIME_DATA_PERIOD_PATH = @_PERL_CONSTANT_STR( WWW_TIME_DATA_PERIOD_PATH, $_www_time_data_period_path) + +PERL_SCHEME = @_PERL_CONSTANT_STR( SCHEME , $scheme ) +PERL_WEBSITE = @_PERL_CONSTANT_STR( WEBSITE, $website) diff --git a/viewer.1.pl b/viewer.1.pl index 800fdc8..5c09bf5 100644 --- a/viewer.1.pl +++ b/viewer.1.pl @@ -1,68 +1,88 @@ -#!/usr/bin/perl +###RUN_PERL: #!/usr/bin/perl # # /mscha/viewer -# 07.04.2021 # mscha time viewer # -# Copyright (C) 2020-2021 Balthasar Szczepański +# Copyright (C) 2020, 2021, 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 -# published by the Free Software Foundation, either version 3 of the -# License, or (at your option) any later version. +# This program is free software: you can redistribute it and/or modify +# it under the terms of the GNU Affero General Public License as +# published by the Free Software Foundation, either version 3 of the +# License, or (at your option) any later version. # -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU Affero General Public License for more details. +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU Affero General Public License for more details. # -# You should have received a copy of the GNU Affero General Public License -# along with this program. If not, see . +# You should have received a copy of the GNU Affero General Public License +# along with this program. If not, see . use strict; +use utf8; +# use Encode::Locale ('decode_argv'); +use Encode ('encode', 'decode'); -#use warnings; -use lib '/eizm/lib/ottbackup/mscha/'; -use mscha_lib qw(failpage gethttpheader getcgi gettimeframe urlencode entityencode printframeselection); +###PERL_LIB: use lib /botm/lib/mscha +use botm_common ( + 'HTTP_STATUS', + 'fail_method', 'fail_content_type', + 'read_header_env', + 'url_encode', + 'url_query_decode', + 'http_entity_encode_dec', + 'merge_settings', + 'merge_url' +); +use mscha_lib ( + 'redirect', + 'get_time_frame', + 'print_frame_selection' +); + +###PERL_SCHEME: SCHEME = http +###PERL_WEBSITE: WEBSITE = 1190.bicyclesonthemoon.info + +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 %cgipost; -my %frameinfo; +my %cgi_post; +my %frame_info; my $method; my $frame; my $mode; my $embed; -my $embedUrl; 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'}); } } -$embed=lc($cgi{'embed'}); +$embed = lc($cgi{'embed'}); if ($ENV{'PATH_INFO'} =~ /^\/([^\/]+)(\/(.+))?$/) { $frame = $1; @@ -71,15 +91,17 @@ if ($ENV{'PATH_INFO'} =~ /^\/([^\/]+)(\/(.+))?$/) { $frame = '1'; $mode = ''; } -if ($cgi{'period'} ne '') { - $frame=$cgi{'period'}; + +if ($cgi{'frameNo'} ne '') { + $frame = $cgi{'frameNo'}; } -if ($cgi{'frame'} ne '') { - $frame=$cgi{'frame'}; +elsif ($cgi{'frame'} ne '') { + $frame = $cgi{'frame'}; } -if ($cgi{'frameNo'} ne '') { - $frame=$cgi{'frameNo'}; +elsif ($cgi{'period'} ne '') { + $frame = $cgi{'period'}; } + if ($cgi{'mode'} ne '') { $mode=lc($cgi{'mode'}); } @@ -87,51 +109,226 @@ if ($mode !~ /^(orig|diff)$/) { $mode = ''; } -%frameinfo = gettimeframe($frame,$time); +%frame_info = get_time_frame($frame, $time); -if (($mode eq 'diff') && ($frameinfo{'diffUrl'} eq '')) { +if (($mode eq 'diff') && ($frame_info{'diffUrl'} eq '')) { $mode = ''; } +my $website_full_url = merge_url( + { + 'scheme' => SCHEME(), + 'host' => WEBSITE() + } +); +my $embedUrl; + if ($mode eq 'orig') { - $embedUrl = $frameinfo{'downloadedUrl'}; -} elsif ($mode eq 'diff') { - $embedUrl = $frameinfo{'diffUrl'}; -} else { - $embedUrl = ($frameinfo{'xkcdUrl'} ne '')?$frameinfo{'xkcdUrl'}:$frameinfo{'downloadedUrl'}; + $embedUrl = $frame_info{'downloadedUrl'}; +} +elsif ($mode eq 'diff') { + $embedUrl = $frame_info{'diffUrl'}; +} +else { + $embedUrl = ($frame_info{'xkcdUrl'} ne '')?$frame_info{'xkcdUrl'}:$frame_info{'downloadedUrl'}; } if ($embedUrl !~ /^http/) { - $embedUrl = 'http://1190.bicyclesonthemoon.info'.$embedUrl; -} - -if ($frameinfo{'match'} !~ /^(frameNo|gwFrameNo|baFrameNo)$/) { - $frame = $frameinfo{'frameNo'}; -} - -my $url_frame = urlencode($frame); -my $url_amp_mode = ($mode ne '')?('&mode='.urlencode($mode)):''; -my $url_botmEnhance = urlencode($frameinfo{'botmEnhance'}); -my $url_frameNo = urlencode($frameinfo{'FrameNo'}); -my $url_gwFrameNo = urlencode($frameinfo{'gwFrameNo'}); -my $url_baFrameNo = urlencode($frameinfo{'baFrameNo'}); - -my $en_frame = entityencode($frame); -my $en_mode = entityencode($mode); -my $en_frameNo = entityencode($frameinfo{'frameNo'}); -my $en_gwFrameNo = entityencode($frameinfo{'gwFrameNo'}); -my $en_baFrameNo = entityencode($frameinfo{'baFrameNo'}); -my $en_next = entityencode($frameinfo{'next'}); -my $en_prev = entityencode($frameinfo{'prev'}); -my $en_diffUrl = entityencode($frameinfo{'diffUrl'}); -my $en_xkcdUrl = entityencode($frameinfo{'xkcdUrl'}); -my $en_downloadedUrl = entityencode($frameinfo{'downloadedUrl'}); -my $en_soundUrl = entityencode($frameinfo{'soundUrl'}); + $embedUrl = merge_url( + $website_full_url, + {'path' => $embedUrl} + ); +} + +if ($frame_info{'match'} !~ /^(frameNo|gwFrameNo|baFrameNo)$/) { + $frame = $frame_info{'frameNo'}; +} + +my %base_url_query = ( + 'frame' => $frame, + 'uri' => CGI_VIEW_PATH() +); +my $viewer_first_url = merge_url( + {'path' => CGI_VIEW_PATH()}, + {'path' => '1'} +); +my $viewer_prev_url = ($frame_info{'prev'} ne '') ? + merge_url( + {'path' => CGI_VIEW_PATH()}, + {'path' => $frame_info{'prev'}} + ); +my $viewer_next_url = ($frame_info{'prev'} ne '') ? + merge_url( + {'path' => CGI_VIEW_PATH()}, + {'path' => $frame_info{'prev'}} + ); +my $viewer_last_url = merge_url( + {'path' => CGI_VIEW_PATH()}, + {'path' => '3094'} +); +my $viewer_random_url = merge_url( + {'path' => CGI_VIEW_PATH()}, + {'path' => 'random'} +); +my $viewer_rsound_url = merge_url( + {'path' => CGI_VIEW_PATH()}, + {'path' => 'randomsound'} +); +if ($mode ne '') { + $base_url_query{'mode'} = $mode; + $viewer_first_url = merge_url( + {'path' => $viewer_first_url}, + {'path' => $mode} + ); + if ($viewer_prev_url ne '') { + $viewer_prev_url = merge_url( + {'path' => $viewer_prev_url}, + {'path' => $mode} + ); + } + if ($viewer_next_url ne '') { + $viewer_next_url = merge_url( + {'path' => $viewer_next_url}, + {'path' => $mode} + ); + } + $viewer_last_url = merge_url( + {'path' => $viewer_last_url}, + {'path' => $mode} + ); +} +my $base_url = merge_url( + { + 'path' => CGI_VIEW_2_PATH(), + 'query' => \%base_url_query + } +); + +my $viewer_xkcd_url = merge_url( + {'path' => CGI_VIEW_PATH()}, + {'path' => $frame_info{'frameNo'}} +); +my $viewer_orig_url = merge_url( + {'path' => $viewer_xkcd_url}, + {'path' => 'orig'} +); +my $viewer_diff_url = merge_url( + {'path' => $viewer_xkcd_url}, + {'path' => 'diff'} +); +my $geekwagon_url = ($frame_info{'gwFrameNo'} ne '') ? + merge_url( + GEEKWAGON_URL(), + {'query' => {'frame' => $frame_info{'gwFrameNo'}}} + ) : ''; +my $aubronwood_url = ($frame_info{'baFrameNo'} ne '') ? + merge_url( + AUBRONWOOD_URL(), + {'query' => { + 'i' => $frame_info{'baFrameNo'}, + 'playing' => '0' + }} + ) : ''; +my $moon_url = merge_url( + TAT_VIEWER_URL(), + {'query' => { + 'story' => 'time', + 'f' => $frame_info{'frameNo'} + }} +); +my $moon_enhance_url = ($frame_info{'botmEnhance'} ne '') ? + merge_url( + $moon_url, + { + 'query' => {'e' => $frame_info{'botmEnhance'}}, + 'append_query' => 1 + } + ) : ''; +my $frame_url = + ($mode eq 'diff') ? + $frame_info{'diffUrl'} : ( + (($mode ne 'orig') && ($frame_info{'xkcdUrl'} ne '')) ? + $frame_info{'xkcdUrl'} : + $frame_info{'downloadedUrl'} + ); +my $jumpUrl = merge_url( + {'path' => CGI_VIEW_PATH()}, + {'path' => '_FRAMENO_'} +); +if ($mode ne '') { + $jumpUrl = merge_url( + {'path' => $jumpUrl}, + {'path' => $mode} + ); +} + + +my $title2 = + (($frame_info{'match'} eq 'baFrameNo') ? (' (Book of Aubron: '.$frame_info{'baFrameNo'}.')') : ''). + (($frame_info{'match'} eq 'gwFrameNo') ? (' (Geekwagon: '.$frame_info{'gwFrameNo'}.')'):''); +my $title = 'xkcd Timeframe '.$frame_info{'frameNo'}.$title2 + +my $_website_full_url = html_entity_encode_dec($website_full_url); +my $_base_url = html_entity_encode_dec($base_url); +my $_viewer_first_url = html_entity_encode_dec($viewer_first_url); +my $_viewer_next_url = html_entity_encode_dec($viewer_next_url); +my $_viewer_last_url = html_entity_encode_dec($viewer_last_url); +my $_viewer_random_url= html_entity_encode_dec($viewer_random_url); +my $_viewer_rsound_url= html_entity_encode_dec($viewer_rsound_url); +my $_viewer_xkcd_url = html_entity_encode_dec($viewer_xkcd_url); +my $_viewer_orig_url = html_entity_encode_dec($viewer_orig_url); +my $_viewer_diff_url = html_entity_encode_dec($viewer_diff_url); +my $_geekwagon_url = html_entity_encode_dec($geekwagon_url); +my $_aubronwood_url = html_entity_encode_dec($aubronwood_url); +my $_moon_url = html_entity_encode_dec($moon_url); +my $_moon_enhance_url = html_entity_encode_dec($moon_enhance_url); +my $_frame_url = html_entity_encode_dec($frame_url); +my $_css_url = html_ebtity_encode_dec(CGI_CSS_PATH()); #/mscha/view1.css +my $_logo_url = html_ebtity_encode_dec(CGI_LOGO_PATH()); #/mscha/botmlogo2.spng +my $_icon_url = html_ebtity_encode_dec(CGI_ICON_PATH()); #/mscha/cuegan32.png +my $_jquery_url = html_ebtity_encode_dec(CGI_JQUERY_PATH()); #/mscha/js/1.11.0.jquery.min.js +my $_jquery_ui_url = html_ebtity_encode_dec(CGI_JQUERY_UI_PATH()); #/mscha/js/1.10.4.jquery-ui.min.js +my $_jquery_cook_url = html_ebtity_encode_dec(CGI_JQUERY_COOK_PATH()); #/mscha/js/jquery.cookie.js +my $_js_url = html_ebtity_encode_dec(CGI_VIEW_JS_PATH()); #/mscha/js/jquery.cookie.js +my $_title = html_ebtity_encode_dec($title); +my $_title2 = html_ebtity_encode_dec($title2); +my $_website = html_ebtity_encode_dec($WEBSITE()); +my $_jumpUrl = html_ebtity_encode_dec($jumpUrl); +my $_frameNo = html_entity_encode_dec($frame_info{'frameNo'}); +my $_alt = html_entity_encode_dec($frame_info{'alt'}); +my $_next = html_entity_encode_dec($frame_info{'next'}); +my $_prev = html_entity_encode_dec($frame_info{'prev'}); + +#my $_baFrameNo = html_entity_encode_dec($frame_info{'baFrameNo'}); +#my $_gwFrameNo = html_entity_encode_dec($frame_info{'gwFrameNo'}); + + +my $url_frame = url_encode($frame); +my $url_amp_mode = ($mode ne '')?('&mode='.url_encode($mode)):''; +my $url_botmEnhance = url_encode($frame_info{'botmEnhance'}); +my $url_frameNo = url_encode($frame_info{'FrameNo'}); +my $url_gwFrameNo = url_encode($frame_info{'gwFrameNo'}); +my $url_baFrameNo = url_encode($frame_info{'baFrameNo'}); + +my $en_frame = html_entity_encode_dec($frame); +my $en_mode = html_entity_encode_dec($mode); + + +my $en_diffUrl = html_entity_encode_dec($frame_info{'diffUrl'}); +my $en_xkcdUrl = html_entity_encode_dec($frame_info{'xkcdUrl'}); +my $en_downloadedUrl = html_entity_encode_dec($frame_info{'downloadedUrl'}); +my $en_soundUrl = html_entity_encode_dec($frame_info{'soundUrl'}); my $en_embedUrl = $embedUrl; -my $en_alt = entityencode($frameinfo{'alt'}); -my $en_sl_mode = ($mode ne '')?('/'.entityencode($mode)):''; -my $en_dateTime = entityencode(substr($frameinfo{'dateTime'},0,4).'-'.substr($frameinfo{'dateTime'},5,2).'-'.substr($frameinfo{'dateTime'},8,2).' '.substr($frameinfo{'dateTime'},11,2).':'.substr($frameinfo{'dateTime'},14,2)); -my $en_epoch = entityencode($frameinfo{'epoch'}); -my $en_hash = entityencode($frameinfo{'hash'}); + +my $en_sl_mode = ($mode ne '')?('/'.html_entity_encode_dec($mode)):''; +my $en_dateTime = html_entity_encode_dec( + substr($frame_info{'dateTime'}, 0, 4).'-'. + substr($frame_info{'dateTime'}, 5, 2).'-'. + substr($frame_info{'dateTime'}, 8, 2).' '. + substr($frame_info{'dateTime'},11, 2).':'. + substr($frame_info{'dateTime'},14, 2) +); +my $en_epoch = html_entity_encode_dec($frame_info{'epoch'}); +my $en_hash = html_entity_encode_dec($frame_info{'hash'}); print "Content-type: text/html\n"; print "\n"; @@ -141,90 +338,85 @@ if($method eq 'HEAD') { print ''."\n"; print ''."\n"; -print ''."\n"; -print ''."\n"; -print ''."\n"; -print ''."\n"; -print 'xkcd Timeframe '.$en_frameNo.(($frameinfo{'match'} eq 'baFrameNo')?(' (Book of Aubron: '.$en_baFrameNo.')'):'').(($frameinfo{'match'} eq 'gwFrameNo')?(' (Geekwagon: '.$en_gwFrameNo.')'):'').''."\n"; -print ''."\n"; -print ''."\n"; -if ($frameinfo{'next'} ne '') { - print ''."\n"; -} -print ''."\n"; -print ''."\n"; -print ''."\n"; -print ''."\n"; -print ''."\n"; -print ''."\n"; -print '1190.bicyclesonthemoon.info
Redundant copy of xkcd.mscha.org.'."\n"; -print '

xkcd Timeframe '.$en_frameNo.'

'."\n"; -if ($frameinfo{'match'} eq 'baFrameNo') { - print '

(Book of Aubron: '.$en_baFrameNo.')

'."\n"; +print ' '."\n"; +print ' '."\n"; +print ' '."\n"; +print ' '."\n"; +print ' xkcd Timeframe '.$_title.''."\n"; +print ' '."\n"; +print ' '."\n"; +if ($viewer_prev_url ne '') { + print ' '."\n"; + print ' '."\n"; } -if ($frameinfo{'match'} eq 'gwFrameNo') { - print '

(Geekwagon: '.$en_gwFrameNo.')

'."\n"; +if ($viewer_next_url ne '') { + print ' '."\n"; + print ' '."\n"; } -print ''."\n"; -print ''."\n"; +print ' '."\n"; +print ' '."\n"; +print ' '."\n"; +print ' '."\n"; +print ' '."\n"; +print ' '."\n"; +print ' '.$_website.'
Redundant copy of xkcd.mscha.org.'."\n"; +print '

xkcd Timeframe '.$_frameNo.'

'."\n"; +if ($title2 ne '') { + print '

'.$_title2.'

'."\n"; } -print '" class="comic" alt="Time" title="'.$en_alt.'">'."\n"; -print ''."\n"; -print '
'."\n"; +print " \n"; +print ' Time'."\n"; +print " \n"; +print '
'."\n"; if ($mode ne '') { - print 'xkcd'."\n"; + print ' xkcd'."\n"; } else { - print 'xkcd'."\n"; + print ' xkcd'."\n"; } -print '•'."\n"; +print ' •'."\n"; if ($mode ne 'orig') { - print 'original'."\n"; + print ' original'."\n"; } else { - print 'original'."\n"; + print ' original'."\n"; } -if ($frameinfo{'diffUrl'} ne '') { - print '•'."\n"; +if ($frame_info{'diffUrl'} ne '') { + print ' •'."\n"; if ($mode ne 'diff') { - print 'difference'."\n"; + print ' difference'."\n"; } else { - print 'difference'."\n"; + print ' difference'."\n"; } } -if ($frameinfo{'botmEnhance'} ne '') { - print '
'."\n"; - print 'ENHANCE'."\n"; +if ($moon_enhance_url ne '') { + print '
'."\n"; + print ' ENHANCE'."\n"; } -print '
'."\n"; -print "\n"; -print '
'."\n"; -print '<<1<<'."\n"; -if($frameinfo{'prev'} ne '') { - print ''."\n"; +print '
'."\n"; +print " \n"; +print '
'."\n"; +print ' <<1<<'."\n"; +if ($viewer_prev_url ne '') { + print ' '."\n"; } else { - print ''."\n"; + print ' '."\n"; } -if($frameinfo{'next'} ne '') { - print ''."\n"; +if($viewer_next_url{'next'} ne '') { + print ' '."\n"; } else { - print ''."\n"; + print ' '."\n"; } -print '>>3094>>'."\n"; -print '
'."\n"; -print 'Random'."\n"; -print 'with sound'."\n"; -print '
'."\n"; -print "\n"; -if ($frameinfo{'soundUrl'} ne '') { +print ' >>3094>>'."\n"; +print '
'."\n"; +print ' Random'."\n"; +print ' with sound'."\n"; +print '
'."\n"; +print " \n"; +if ($frame_info{'soundUrl'} ne '') { print '
'."\n"; print '