wesnoth/utils/campaigns_client.pl

#!/usr/bin/perl
#
# List and download campaigns from the Wesnoth command server.

use wml;
use wml_net;
use strict;

my $command = 'ls';
my $download = '';
my $download_to = '';
my ($host,$port) = ("campaigns.wesnoth.org",15003);
my @fields = ('name','title','author','size','version','filename','downloads');

while(@ARGV) {
	my $arg = shift @ARGV;
	if($arg eq '--host') {
		$host = shift @ARGV;
	} elsif($arg eq '--port') {
		$port = shift @ARGV;
	} elsif($arg eq '--help') {
		print "Wesnoth Campaigns Client. Connects to the Wesnoth campaign server and performs various operations.
Format: $0 [<options>] <command> [<parameters>]
Commands:
	ls (default): lists the campaigns stored on the server. The fields to be displayed for each campaign may be given as a parameter, as a list of comma-separated values. Valid fields are name, title, author, size, version, filename, and downloads
	terms: queries the server for terms under which it may be used
	download <campaign name> [<path>]: downloads the given campaign into the directory given by the path. The files and directories created in the process will be printed to standard out.
Options:
	--host: the host to connect to (defaults to campaigns.wesnoth.org)
	--port: the port to connect to (defaults to 15003, the dev version campaign server)
	--help: displays this text and exits
";
	exit;
	} elsif($arg eq 'ls') {
		$command = 'ls';
		my $fields = shift @ARGV;
		if($fields) {
			@fields = split /,/, $fields;
		}
	} elsif($arg eq 'terms') {
		$command = 'terms';
	} elsif($arg eq 'download') {
		$command = 'download';
		$download = shift @ARGV or die "download option must include a campaign to download";
		$download_to = shift @ARGV or '.';
	} else {
		die "Unknown argument '$arg'";
	}
}

my $socket = &wml_net::connect($host,$port);

if($command eq 'ls') {
	&wml_net::write_packet($socket,&wml::read_text('
[request_campaign_list]
[/request_campaign_list]'));
	my $response = &wml_net::read_packet($socket);
	&check_error($response);

	my $campaign_list = &wml::has_child($response,'campaigns') or die "Unrecognized response to request for campaigns";
	my @campaigns = &wml::get_children($campaign_list,'campaign');
	foreach my $campaign (@campaigns) {
		my $first = 1;
		foreach my $field (@fields) {
			print "|" unless $first;
			$first = 0;
			my $value = $campaign->{'attr'}->{$field};
			$value =~ s/\n/ /g;
			$value =~ s/\r//g;
			print $value;
		}

		print "\n";
	}
	
	exit;
} elsif($command eq 'terms') {
	&wml_net::write_packet($socket,&wml::read_text('
[request_terms]
[/request_terms]'));
	my $response = &wml_net::read_packet($socket);
	&check_error($response);
	print &extract_message($response);
	exit;
} elsif($command eq 'download') {
	mkdir $download_to;
	&wml_net::write_packet($socket,&wml::read_text("
[request_campaign]
name=\"$download\"
[/request_campaign]"));
	my $response = &wml_net::read_packet($socket);
	&check_error($response);

	print &unarchive_dir($response,$download_to);
	exit;
}

sub check_error
{
	my ($doc) = @_;
	if(my $error = &wml::has_child($doc,'error')) {
		my $msg = $error->{'attr'}->{'message'};
		die "Server responded with error: $msg";
	}
}

sub extract_message
{
	my ($doc) = @_;
	if(my $error = &wml::has_child($doc,'message')) {
		return $error->{'attr'}->{'message'};
	}

	return "";
}

sub unarchive_dir
{
	my $log = '';
	my ($doc,$dest) = @_;
	my $name = $doc->{'attr'}->{'name'};
	my $path = "$dest/$name";
	mkdir $path;
	$log .= "$path\n";
	foreach my $dir (&wml::get_children($doc,'dir')) {
		$log .= &unarchive_dir($dir,$path);
	}

	foreach my $file (&wml::get_children($doc,'file')) {
		my $filename = "$path/" . $file->{'attr'}->{'name'};
		open FILE, ">$filename";
		binmode(FILE);
		my @chars = split //, $file->{'attr'}->{'contents'};
		while(@chars) {
			my $char = shift @chars;
			if(1 == ord $char) {
				$char = chr(ord(shift @chars) - 1);
			}

			print FILE $char;
		}
		close FILE;

		$log .= "$filename\n";
	}

	return $log;
}

my $doc = &wml_net::read_packet($socket);
die "Expected login" unless &wml::has_child($doc,'mustlogin');

&wml_net::write_packet($socket,&wml::read_text("
[login]
	username=monitor
[/login]"));

print &wml::write_text(&wml_net::read_packet($socket));
print &wml::write_text(&wml_net::read_packet($socket));

close $socket;