wesnoth/utils/weblist.pl

#!/usr/bin/perl

use wml;
use wml_net;
use CGI qw/:standard -no_xhtml/;
use Time::gmtime;
use strict;

my ($host,$port) = ('add-ons.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;