mirror of
https://github.com/wesnoth/wesnoth
synced 2025-04-24 17:36:24 +00:00
32588979cc
...it will sometimes pick up the same language twice for a given campaign. (Currently Invasion of Eliador has this issue with sv.) This isn't a problem on the campaign server side. However it looks bad on the web page. So I now have the campaign list suppressing duplicate langauges. I also fixed a bug where the languages weren't sorted the intended way.
273 lines
9.1 KiB
Perl
Executable File
273 lines
9.1 KiB
Perl
Executable File
#!/usr/bin/perl
|
|
|
|
use wml;
|
|
use wml_net;
|
|
use CGI qw/:standard -no_xhtml/;
|
|
use Time::gmtime;
|
|
use strict;
|
|
|
|
my ($host,$port) = ('campaigns.wesnoth.org', 15002);
|
|
|
|
my $style = 'http://www.wesnoth.org/mw/skins/glamdrol/main.css';
|
|
|
|
my $socket = eval {&wml_net::connect($host,$port)};
|
|
if ($@ ne '') {
|
|
print header, start_html(-style=>{'src'=>$style},
|
|
-title=>'Error accessing the campaign server.');
|
|
print div({id=>'header'}, div({id=>'logo'}, a({href=>'http://www.wesnoth.org/'},
|
|
img({alt=>'Wesnoth logo',
|
|
src=>'http://wesnoth.org/mw/skins/glamdrol/wesnoth-logo.jpg'}))));
|
|
print p(escapeHTML($@)), end_html;
|
|
exit;
|
|
}
|
|
|
|
if (!defined($socket)) {
|
|
print header, start_html(-style=>{'src'=>$style},
|
|
-title=>'Error connecting to the campaign server.');
|
|
print div({id=>'header'}, div({id=>'logo'}, a({href=>'http://www.wesnoth.org/'},
|
|
img({alt=>'Wesnoth logo',
|
|
src=>'http://wesnoth.org/mw/skins/glamdrol/wesnoth-logo.jpg'}))));
|
|
print p('Error connecting to the campaign server.'), end_html;
|
|
exit;
|
|
}
|
|
|
|
eval {
|
|
&wml_net::write_packet($socket,&wml::read_text('
|
|
[request_campaign_list]
|
|
[/request_campaign_list]'));
|
|
};
|
|
if ($@ ne '') {
|
|
print header, start_html(-style=>{'src'=>$style},
|
|
-title=>'Error accessing the campaign server.');
|
|
print div({id=>'header'}, div({id=>'logo'}, a({href=>'http://www.wesnoth.org/'},
|
|
img({alt=>'Wesnoth logo',
|
|
src=>'http://wesnoth.org/mw/skins/glamdrol/wesnoth-logo.jpg'}))));
|
|
print p(escapeHTML($@)), end_html;
|
|
exit;
|
|
}
|
|
|
|
my $response = eval {&wml_net::read_packet($socket)};
|
|
if ($@ ne '') {
|
|
print header, start_html(-style=>{'src'=>$style},
|
|
-title=>'Error accessing the campaign server.');
|
|
print div({id=>'header'}, div({id=>'logo'}, a({href=>'http://www.wesnoth.org/'},
|
|
img({alt=>'Wesnoth logo',
|
|
src=>'http://wesnoth.org/mw/skins/glamdrol/wesnoth-logo.jpg'}))));
|
|
print p(escapeHTML($@)), end_html;
|
|
exit;
|
|
}
|
|
|
|
if (!defined($response)) {
|
|
print header, start_html(-style=>{'src'=>$style},
|
|
-title=>'Error accessing the campaign server.');
|
|
print div({id=>'header'}, div({id=>'logo'}, a({href=>'http://www.wesnoth.org/'},
|
|
img({alt=>'Wesnoth logo',
|
|
src=>'http://wesnoth.org/mw/skins/glamdrol/wesnoth-logo.jpg'}))));
|
|
print p('Error accessing the campaign server.'), end_html;
|
|
exit;
|
|
}
|
|
|
|
if (my $error = &wml::has_child($response, 'error')) {
|
|
print header, start_html(-style=>{'src'=>$style},
|
|
-title=>'Error accessing the campaign server.');
|
|
print div({id=>'header'}, div({id=>'logo'}, a({href=>'http://www.wesnoth.org/'},
|
|
img({alt=>'Wesnoth logo',
|
|
src=>'http://wesnoth.org/mw/skins/glamdrol/wesnoth-logo.jpg'}))));
|
|
print p($error->{'attr'}->{'message'}), end_html;
|
|
exit;
|
|
}
|
|
|
|
my $campaign_list = &wml::has_child($response, 'campaigns');
|
|
if (!$campaign_list) {
|
|
print header, start_html(-style=>{'src'=>$style},
|
|
-title=>'Error retrieving campaign list.');
|
|
print div({id=>'header'}, div({id=>'logo'}, a({href=>'http://www.wesnoth.org/'},
|
|
img({alt=>'Wesnoth logo',
|
|
src=>'http://wesnoth.org/mw/skins/glamdrol/wesnoth-logo.jpg'}))));
|
|
print p('No', em('campaigns'), 'data returned.'), end_html;
|
|
exit;
|
|
}
|
|
|
|
print header, start_html(-style=>{'src'=>$style},
|
|
-title=>'Wesnoth campaigns available for download.');
|
|
|
|
print div({id=>'header'}, div({id=>'logo'}, a({href=>'http://www.wesnoth.org/'},
|
|
img({alt=>'Wesnoth logo',
|
|
src=>'http://wesnoth.org/mw/skins/glamdrol/wesnoth-logo.jpg'}))));
|
|
|
|
my @campaigns = &wml::get_children($campaign_list,'campaign');
|
|
|
|
my $myurl = url(-relative=>1);
|
|
|
|
my $sort = 'timestamp_down';
|
|
if (defined(param('sort'))) {
|
|
if (scalar(@{[param('sort')]}) != 1) {
|
|
print p('Mutplie sort columns ignored.');
|
|
}
|
|
else {
|
|
$sort = param('sort');
|
|
}
|
|
}
|
|
|
|
my $title_sort = 'title_up';
|
|
my $version_sort = 'version_down';
|
|
my $author_sort = 'author_up';
|
|
my $timestamp_sort = 'timestamp_down';
|
|
my $size_sort = 'size_up';
|
|
my $downloads_sort = 'downloads_down';
|
|
$title_sort = 'title_down' if $sort eq 'title_up';
|
|
$version_sort = 'version_up' if $sort eq 'version_down';
|
|
$author_sort = 'author_down' if $sort eq 'author_up';
|
|
$timestamp_sort = 'timestamp_up' if $sort eq 'timestamp_down';
|
|
$size_sort = 'size_down' if $sort eq 'size_up';
|
|
$downloads_sort = 'downloads_up' if $sort eq 'downloads_down';
|
|
|
|
print p('Windows users may want to install',
|
|
a({href=>'http://www.7-zip.org/'}, '7-zip'),
|
|
"to handle tar gzipped archives (campaign downloads are in this format).",
|
|
'This is a', a({href=>'http://www.debian.org/intro/free'}, 'free'),
|
|
'and zero cost program that will handle a variety of archive formats.');
|
|
print p('Column headings are linked to alternate sort orders.');
|
|
print p('Campaign titles are linked to tar gzipped archives of the respective campaigns.');
|
|
print p('The downloaded campaign archives should be extracted in ~/.wesnoth/data/campaigns/ on *nix systems.',
|
|
a({href=>'mailto:bruno@wolff.to'}, 'I'),
|
|
'would appreciate people telling me what the corresponding directory is for other operating systems.');
|
|
|
|
my @rows = ();
|
|
foreach my $campaign (@campaigns) {
|
|
foreach my $field ('icon', 'name', 'title', 'version', 'author', 'timestamp',
|
|
'description', 'size', 'downloads') {
|
|
$campaign->{'attr'}->{$field} =~ s/\001[^\003]*\003//g;
|
|
$campaign->{'attr'}->{$field} =~ s/[\001-\037\177-\237]/ /g;
|
|
}
|
|
$campaign->{'attr'}->{'name'} =~ s;\s|/|\\;;g;
|
|
my $title = $campaign->{'attr'}->{'name'};
|
|
$title =~ s/_/ /g;
|
|
$campaign->{'attr'}->{'title'} = $title
|
|
if $campaign->{'attr'}->{'title'} =~ m/^\s*$/;
|
|
}
|
|
|
|
my @sorted = ();
|
|
if ($sort eq 'title_down') {
|
|
@sorted = sort {uc($b->{'attr'}->{'title'}) cmp uc($a->{'attr'}->{'title'})}
|
|
@campaigns;
|
|
}
|
|
elsif ($sort eq 'title_up') {
|
|
@sorted = sort {uc($a->{'attr'}->{'title'}) cmp uc($b->{'attr'}->{'title'})}
|
|
@campaigns;
|
|
}
|
|
elsif ($sort eq 'version_down') {
|
|
@sorted = sort {uc($b->{'attr'}->{'version'}) cmp uc($a->{'attr'}->{'version'})}
|
|
@campaigns;
|
|
}
|
|
elsif ($sort eq 'version_up') {
|
|
@sorted = sort {uc($a->{'attr'}->{'version'}) cmp uc($b->{'attr'}->{'version'})}
|
|
@campaigns;
|
|
}
|
|
elsif ($sort eq 'author_down') {
|
|
@sorted = sort {uc($b->{'attr'}->{'author'}) cmp uc($a->{'attr'}->{'author'})}
|
|
@campaigns;
|
|
}
|
|
elsif ($sort eq 'author_up') {
|
|
@sorted = sort {uc($a->{'attr'}->{'author'}) cmp uc($b->{'attr'}->{'author'})}
|
|
@campaigns;
|
|
}
|
|
elsif ($sort eq 'timestamp_down') {
|
|
@sorted = sort {$b->{'attr'}->{'timestamp'} <=> $a->{'attr'}->{'timestamp'}}
|
|
@campaigns;
|
|
}
|
|
elsif ($sort eq 'timestamp_up') {
|
|
@sorted = sort {$a->{'attr'}->{'timestamp'} <=> $b->{'attr'}->{'timestamp'}}
|
|
@campaigns;
|
|
}
|
|
elsif ($sort eq 'size_down') {
|
|
@sorted = sort {$b->{'attr'}->{'size'} <=> $a->{'attr'}->{'size'}}
|
|
@campaigns;
|
|
}
|
|
elsif ($sort eq 'size_up') {
|
|
@sorted = sort {$a->{'attr'}->{'size'} <=> $b->{'attr'}->{'size'}}
|
|
@campaigns;
|
|
}
|
|
elsif ($sort eq 'downloads_down') {
|
|
@sorted = sort {$b->{'attr'}->{'downloads'} <=> $a->{'attr'}->{'downloads'}}
|
|
@campaigns;
|
|
}
|
|
elsif ($sort eq 'downloads_up') {
|
|
@sorted = sort {$a->{'attr'}->{'downloads'} <=> $b->{'attr'}->{'downloads'}}
|
|
@campaigns;
|
|
}
|
|
else {
|
|
@sorted = @campaigns;
|
|
}
|
|
|
|
foreach my $campaign (@sorted) {
|
|
my @row = ();
|
|
my $iname = $campaign->{'attr'}->{'icon'};
|
|
if ($iname !~ m/^\s*$/) {
|
|
$iname =~ s;^.*(/|\\);;;
|
|
$iname =~ s/\..*$//;
|
|
$iname =~ s/-|_/ /g;
|
|
push @row, img({src=>'images/'.$campaign->{'attr'}->{'icon'},
|
|
alt=>$iname});
|
|
}
|
|
else {
|
|
push @row, 'No icon provided';
|
|
}
|
|
push @row, a({href=>($campaign->{'attr'}->{'name'}).'.tgz'},
|
|
escapeHTML($campaign->{'attr'}->{'title'}));
|
|
push @row, escapeHTML($campaign->{'attr'}->{'version'});
|
|
my $trans = '';
|
|
my $first = 1;
|
|
my $last = '';
|
|
my @lang = &wml::get_children($campaign,'translation');
|
|
foreach my $lang (sort {$a->{'attr'}->{'language'} cmp
|
|
$b->{'attr'}->{'language'}} @lang) {
|
|
if (!$first) {
|
|
$first = 0;
|
|
$trans = $lang->{'attr'}->{'language'};
|
|
$last = $trans;
|
|
}
|
|
else {
|
|
$trans .= ' ';
|
|
if ($last ne $lang->{'attr'}->{'language'}) {
|
|
$trans .= $lang->{'attr'}->{'language'};
|
|
$last = $lang->{'attr'}->{'language'};
|
|
}
|
|
}
|
|
}
|
|
$trans =~ s/\001[^\003]*\003//g;
|
|
$trans =~ s/[\001-\037\177-\237]/ /g;
|
|
push @row, escapeHTML($trans);
|
|
push @row, escapeHTML($campaign->{'attr'}->{'author'});
|
|
if ($campaign->{'attr'}->{'timestamp'} =~ m/^\d+$/) {
|
|
push @row, escapeHTML(gmctime($campaign->{'attr'}->{'timestamp'}) . ' GMT');
|
|
}
|
|
else {
|
|
push @row, 'Unknown';
|
|
}
|
|
push @row, escapeHTML($campaign->{'attr'}->{'description'});
|
|
my $size = $campaign->{'attr'}->{'size'};
|
|
$size += 512;
|
|
$size -= $size % 1024;
|
|
$size /= 1024;
|
|
push @row, escapeHTML("$size KB");
|
|
push @row, escapeHTML($campaign->{'attr'}->{'downloads'});
|
|
push @rows, td(\@row);
|
|
}
|
|
|
|
print table({frame=>'border',rules=>'all'},
|
|
col, col({align=>'char'}), col, col,
|
|
thead(Tr(th(['Icon',
|
|
a({href=>$myurl . '?sort=' . $title_sort}, 'Title'),
|
|
a({href=>$myurl . '?sort=' . $version_sort}, 'Version'),
|
|
'Translations',
|
|
a({href=>$myurl . '?sort=' . $author_sort}, 'Author'),
|
|
a({href=>$myurl . '?sort=' . $timestamp_sort}, 'Last Updated'),
|
|
'Description',
|
|
a({href=>$myurl . '?sort=' . $size_sort}, 'Size'),
|
|
a({href=>$myurl . '?sort=' . $downloads_sort}, 'Downloads')]))),
|
|
tbody(Tr(\@rows))
|
|
);
|
|
|
|
print end_html;
|