aboutsummaryrefslogtreecommitdiff
path: root/lib/MasterWebInterface/Util
diff options
context:
space:
mode:
Diffstat (limited to 'lib/MasterWebInterface/Util')
-rwxr-xr-xlib/MasterWebInterface/Util/AddressFormat.pm54
-rwxr-xr-xlib/MasterWebInterface/Util/BrowseHTML.pm201
-rwxr-xr-xlib/MasterWebInterface/Util/Layout.pm116
-rwxr-xr-xlib/MasterWebInterface/Util/Misc.pm43
4 files changed, 414 insertions, 0 deletions
diff --git a/lib/MasterWebInterface/Util/AddressFormat.pm b/lib/MasterWebInterface/Util/AddressFormat.pm
new file mode 100755
index 0000000..68cf82c
--- /dev/null
+++ b/lib/MasterWebInterface/Util/AddressFormat.pm
@@ -0,0 +1,54 @@
+package MasterWebInterface::Util::AddressFormat;
+use strict;
+use warnings;
+use TUWF ':html';
+use Exporter 'import';
+our @EXPORT = qw| from_addr_str
+ to_ipv4_str |;
+
+################################################################################
+# parse incoming addresses to IPv6 type used by MasterServer-Qt5 and port
+# parses IPv4 to ::ffff:0.0.0.0 and port
+# this is only a semi-sanity check -- invalid values (like port > 65535)
+# are ignored since they will simply not be found in the database.
+################################################################################
+sub from_addr_str {
+ my ($self, $str_addr) = @_;
+ my ($ip, $port);
+
+ # ::ffff:127.0.0.1:7778
+ if ($str_addr =~ /^::ffff:\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}:\d{1,5}$/)
+ {
+ # ipv4 in ipv6 format is already in the correct format
+ return ($ip, $port) = $str_addr =~ m/^(::ffff:\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}):(\d{1,5})$/;
+ }
+
+ # ipv6 (without leading ::) and trailing :7778 / port
+ if ($str_addr =~ /^\w{4}:\w{4}:\w{4}:\w{4}:\w{4}:\w{4}:\w{4}:\w{4}:\d{1,5}$/)
+ {
+ # ipv6 already in the correct format
+ return ($ip, $port) = $str_addr =~ m/^(\w{4}:\w{4}:\w{4}:\w{4}:\w{4}:\w{4}:\w{4}:\w{4}):(\d{1,5})$/;
+ }
+
+ # ipv4 (127.0.0.1:7778)
+ if ($str_addr =~ /^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}:\d{1,5}$/)
+ {
+ # rewrite to ::ffff:127.0.0.1
+ ($ip, $port) = $str_addr =~ m/^(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}):(\d{1,5})$/;
+ return ("::ffff:".$ip, $port);
+ }
+
+ # failure
+ return ("0.0.0.0", 0);
+}
+
+# write ::ffff:0.0.0.0 to 0.0.0.0 format if possible
+# return ipv6 addresses untouched
+sub to_ipv4_str
+{
+ my ($self, $str_addr) = @_;
+ $str_addr =~ s/^::ffff://;
+ return $str_addr;
+}
+
+1;
diff --git a/lib/MasterWebInterface/Util/BrowseHTML.pm b/lib/MasterWebInterface/Util/BrowseHTML.pm
new file mode 100755
index 0000000..f32e088
--- /dev/null
+++ b/lib/MasterWebInterface/Util/BrowseHTML.pm
@@ -0,0 +1,201 @@
+package MasterWebInterface::Util::BrowseHTML;
+use strict;
+use warnings;
+use utf8;
+use TUWF ':html', 'xml_escape';
+use Exporter 'import';
+use POSIX 'ceil';
+our @EXPORT = qw| htmlSearchBox htmlBrowse htmlBrowseNavigate |;
+
+# generates a search box, arguments:
+# title => games/ (game) servers
+# action => form action
+# sel => g or s selected
+# fq => form query string
+sub htmlSearchBox
+{
+ my($self, %opt) = @_;
+
+ div class => 'mainbox';
+ div class => "header";
+ h1 "Browse $opt{title}";
+ p class => "alttitle", "An overview of games titles and servers that are currently online.";
+ end;
+
+ # search box
+ form action => $opt{action}, 'accept-charset' => 'UTF-8', method => 'get';
+ fieldset class => 'search';
+ a href => '/g', $opt{sel} eq 'g' ? (class => 'sel') : (), 'Games';
+ a href => '/s', $opt{sel} eq 's' ? (class => 'sel') : (), 'Servers';
+ #a href => '/json', $opt{sel} eq 'j' ? (class => 'sel') : (), 'Json API';
+ input type => 'text', name => 'q', id => 'q', class => 'text',
+ value => $opt{fq} || 'search...';
+ input type => 'submit', class => 'submit', value => 'submit';
+ end 'fieldset';
+
+ div class => "dropdown";
+ a href => "#", onclick => "toggleAdvanced()";
+ txt "advanced search ";
+ lit "\x{25BE}";
+ end;
+ end;
+
+ fieldset id => 'advancedsearch';
+ #input type => 'text', name => 'aq', class => 'text', value => '';
+ #input type => 'submit', class => 'submit', value => 'submit';
+ txt "Patience, young one. With time, advanced search options will become available to you.";
+ end;
+ end;
+
+ end 'div'; # mainbox
+}
+
+# generates a browse box, arguments:
+# items => arrayref with the list items
+# options => hashref containing at least the keys s (sort key), o (order) and p (page)
+# nextpage => whether there's a next page or not
+# sorturl => base URL to append the sort options to (if there are any sortable columns)
+# pageurl => base URL to append the page option to
+# class => classname of the mainbox
+# header =>
+# can be either an arrayref or subroutine reference,
+# in the case of a subroutine, it will be called when the header should be written,
+# in the case of an arrayref, the array should contain the header items. Each item
+# can again be either an arrayref or subroutine ref. The arrayref would consist of
+# two elements: the name of the header, and the name of the sorting column if it can
+# be sorted
+# row => subroutine ref, which is called for each item in $list, arguments will be
+# $self, $item_number (starting from 0), $item_value
+# footer => subroutine ref, called after all rows have been processed
+# Mostly written by Yorhel --> https://g.blicky.net/vndb.git/tree/COPYING
+sub htmlBrowse
+{
+ my($self, %opt) = @_;
+
+ # get options
+ $opt{sorturl} .= $opt{sorturl} =~ /\?/ ? ';' : '?' if $opt{sorturl};
+
+ # top navigation
+ $self->htmlBrowseNavigate($opt{pageurl}, $opt{options}{p}, $opt{nextpage}, 't') if $opt{pageurl};
+
+ div class => 'mainbox browse'.($opt{class} ? ' '.$opt{class} : '');
+ table class => 'stripe';
+
+ # header
+ thead;
+ Tr;
+ if(ref $opt{header} eq 'CODE')
+ {
+ $opt{header}->($self);
+ }
+ else
+ {
+ for(0..$#{$opt{header}})
+ {
+ if(ref $opt{header}[$_] eq 'CODE')
+ {
+ $opt{header}[$_]->($self, $_+1);
+ }
+ elsif ($opt{simple})
+ {
+ td class => $opt{header}[$_][3]||'tc'.($_+1), $opt{header}[$_][2] ? (colspan => $opt{header}[$_][2]) : ();
+ if($opt{header}[$_][1])
+ {
+ lit qq|<a href="$opt{sorturl}o=d;s=$opt{header}[$_][1]">$opt{header}[$_][0]</a>|;
+ }
+ else
+ {
+ txt $opt{header}[$_][0];
+ }
+ end;
+ }
+ else
+ {
+ td class => $opt{header}[$_][3]||'tc'.($_+1), $opt{header}[$_][2] ? (colspan => $opt{header}[$_][2]) : ();
+ if ( $opt{options}{s} eq $opt{header}[$_][1] )
+ { # active sort
+ if ( $opt{options}{o} eq 'a' )
+ {
+ a href => "$opt{sorturl}o=d;s=$opt{header}[$_][1]";
+ lit $opt{header}[$_][0];
+ lit " \x{25B4}";
+ end;
+ }
+ else
+ { # eq 'd'
+ a href => "$opt{sorturl}o=a;s=$opt{header}[$_][1]";
+ lit $opt{header}[$_][0];
+ lit " \x{25BE}";
+ end;
+ }
+ }
+ else
+ { # passive sort options
+ a href => "$opt{sorturl}o=d;s=$opt{header}[$_][1]";
+ lit $opt{header}[$_][0];
+ end;
+ }
+ end;
+ }
+ }
+ }
+ end;
+ end 'thead';
+
+ # footer
+ if($opt{footer})
+ {
+ tfoot;
+ $opt{footer}->($self);
+ end;
+ }
+
+ # rows
+ $opt{row}->($self, $_+1, $opt{items}[$_]) for 0..$#{$opt{items}};
+
+ end 'table';
+ end 'div';
+
+ # bottom navigation
+ $self->htmlBrowseNavigate($opt{pageurl}, $opt{options}{p}, $opt{nextpage}, 'b') if $opt{pageurl};
+}
+
+
+# creates next/previous buttons (tabs), if needed
+# Arguments: page url, current page (1..n), nextpage (0/1 or [$total, $perpage]), alignment (t/b), noappend (0/1)
+# Mostly written by Yorhel --> https://g.blicky.net/vndb.git/tree/COPYING
+sub htmlBrowseNavigate {
+ my($self, $url, $p, $np, $al, $na) = @_;
+ my($cnt, $pp) = ref($np) ? @$np : ($p+$np, 1);
+ return if $p == 1 && $cnt <= $pp;
+
+ $url .= $url =~ /\?/ ? ';p=' : '?p=' unless $na;
+
+ my $tab = sub {
+ my($left, $page, $label) = @_;
+ li $left ? (class => 'left') : ();
+ a href => $url.$page; lit $label; end;
+ end;
+ };
+ my $ell = sub {
+ li class => 'ellipsis'.(shift() ? ' left' : '');
+ b '⋯';
+ end;
+ };
+ my $nc = 5; # max. number of buttons on each side
+
+ ul class => 'maintabs browsetabs ' . ($al eq 't' ? 'notfirst' : 'bottom');
+ $p > $nc and ref $np and $tab->(1, 1, '&laquo; first');
+ $p > $nc and ref $np and $ell->(1);
+ $p > $_ and ref $np and $tab->(1, $p-$_, $p-$_) for (reverse 1..($nc>$p-1?$p-1:$nc-1));
+ $p > 1 and $tab->(1, $p-1, '&lsaquo; previous');
+
+ my $l = ceil($cnt/$pp)-$p+1;
+ $l > $nc and $tab->(0, $l+$p-1, ('last').' &raquo;');
+ $l > $nc and $ell->(0);
+ $l > $_ and $tab->(0, $p+$_, $p+$_) for (reverse 1..($nc>$l-1?$l-1:$nc-1));
+ $l > 1 and $tab->(0, $p+1, ('next').' &rsaquo;');
+ end 'ul';
+}
+
+1;
diff --git a/lib/MasterWebInterface/Util/Layout.pm b/lib/MasterWebInterface/Util/Layout.pm
new file mode 100755
index 0000000..bf401c2
--- /dev/null
+++ b/lib/MasterWebInterface/Util/Layout.pm
@@ -0,0 +1,116 @@
+package MasterWebInterface::Util::Layout;
+use strict;
+use warnings;
+use TUWF ':html';
+use Exporter 'import';
+our @EXPORT = qw| htmlHeader htmlFooter |;
+
+################################################################################
+# page header
+# options: title, noindex
+################################################################################
+sub htmlHeader
+{
+ my($self, %o) = @_;
+
+ # CSS override: allow passing of style from GET --> ?style=classic
+ my $style = $self->{style};
+ if (my $overrideStyle = $self->reqParam("style") )
+ {
+ # default to custom style if specified option doesn't exist
+ $style = ( -e "$self->{root}/s/style/$overrideStyle" ) ? $overrideStyle : "basic";
+ }
+
+ html lang => "en";
+ head;
+ title "$o{title} :: $self->{site_name} masterserver";
+ Link type => 'image/x-icon', rel => 'shortcut icon', href => "/favicon.ico";
+ Link type => "text/css", rel => 'stylesheet', href => "/style/$style/style.css", media => "all";
+ if ( $o{noindex} )
+ {
+ meta name => 'robots', content => 'noindex,nofollow,nosnippet,noodp,noarchive,noimageindex';end;
+ }
+ end 'head';
+
+ body;
+
+ my $topbar = $self->reqParam("topbar");
+ if ($topbar && lc $topbar eq "true" )
+ {
+ # games, servers, search bar
+ div class => 'nav';
+ # search box
+ form action => "/g", 'accept-charset' => 'UTF-8', method => 'get';
+ fieldset class => 'search';
+ p id => 'searchtabs';
+ a href => '/g', class => 'sel', 'Games';
+ a href => '/s', 'Servers';
+ input type => 'text', name => 'q', id => 'q', class => 'text', value => '';
+ input type => 'submit', class => 'submit', value => '', style => "display:none";
+ end;
+ a style => "font-size:x-small", href => "#", "advanced search";
+ end 'fieldset';
+ end;
+ end;
+ }
+
+ div id => "body";
+
+ # start the page content with a header logo box
+ div class => "titlebox";
+ end;
+
+ my $overrideStyle = $self->reqParam("style");
+ if ($overrideStyle) {
+ # debug feature: force list of styles on floaty-box
+ div class => "mainbox",
+ style => "position:absolute; left: 20px; top: 20px; width:200px";
+
+ div class => "header";
+ h1 "Development";
+ p class => "alttitle";
+ txt "This site is under development. Find ";
+ a href => "http://333networks.com", "333networks.com here!";
+ br;
+ txt "Use the list below to test different house styles.";
+ end;
+ end;
+
+ ul style => "margin: 3px 20px 10pt 40px";
+ opendir(DIR, "$self->{root}/s/style") or die $!;
+ while (my $file = readdir(DIR))
+ {
+ next if ($file =~ m/^\./);
+ li;
+ a href => "?style=$file", $file;
+ end;
+ }
+ closedir(DIR);
+ end;
+ end;
+ }
+}
+
+################################################################################
+# page footer
+# options: last_edited
+################################################################################
+sub htmlFooter
+{
+ my ($self, %o) = @_;
+
+ br style => "clear:both";
+
+ div id => 'footer';
+ txt "$self->{site_name} | Powered by ";
+ a href => "http://333networks.com", "333networks";
+ txt " | ";
+ txt $o{last_edited} || "2021";
+ end;
+ end 'div'; # body
+ script type => 'text/javascript', src => "/masterscript.js", '';
+ end 'body';
+ end 'html';
+}
+
+1;
diff --git a/lib/MasterWebInterface/Util/Misc.pm b/lib/MasterWebInterface/Util/Misc.pm
new file mode 100755
index 0000000..f2979ea
--- /dev/null
+++ b/lib/MasterWebInterface/Util/Misc.pm
@@ -0,0 +1,43 @@
+package MasterWebInterface::Util::Misc;
+use strict;
+use warnings;
+use TUWF ':html';
+use POSIX 'strftime';
+use Exporter 'import';
+use Geography::Countries;
+use Unicode::Normalize 'NFKD';
+our @EXPORT = qw| date_new timeformat countryflag |;
+
+# time formatting for when a server was added
+sub date_new
+{
+ my ($s, $d) = @_;
+ return (strftime "%a %H:%M", gmtime $d); # no seconds
+}
+
+# time formatting for when a server was added / last updated
+sub timeformat
+{
+ my ($self, $time) = @_;
+ my @t = gmtime($time);
+ my $r = "";
+
+ # parse into d HH:mm:SS format
+ if ($t[7]){$r .= $t[7]."d "}
+ if ($t[2]){$r .= ($t[2] > 9) ? $t[2].":" : "0".$t[2].":" }
+ if ($t[1]){$r .= ($t[1] > 9) ? $t[1].":" : "0".$t[1].":" } else {$r .= "00:";}
+ if ($t[0]){$r .= ($t[0] > 9) ? $t[0] : "0".$t[0] } else {$r .= "00";}
+
+ return $r;
+}
+
+# returns flag, country name
+sub countryflag
+{
+ my ($self, $c) = @_;
+ my $flag = ($c ? lc $c : 'earth');
+ my $coun = $c ? ( $c eq 'EU' ? 'Europe' : country $c ) : 'Earth' ;
+ return $flag, $coun;
+}
+
+1;
generated by cgit v1.2.3 (git 2.25.1) at 2026-03-13 18:20:50 +0000