#!/usr/bin/perl
package Elive::script::elive_lint_config;
use warnings; use strict;

use Getopt::Long;
use XML::Simple;
use Elive;
use Pod::Usage;

=head1 NAME

elive_lint_config

=head1 SYNOPSIS

    % cd /opt/ElluminateLive/manager/tomcat/webapps/mysite
    % elive_lint_config WEB-INF/resources/configuration.xml

=head1 DESCRIPTION

This script can be run on an elluminate server site configuration file to
perform some rough checks on the basic setup.

In particular, some adapter definitions may be missing. This seems to
depend on the sites vintage, manual edits, and the general upgrade history.

It may be useful to rerun this script after upgrading either Elluminate Live
or Elive, or creating new site instances.

=head1 SEE ALSO

    perldoc Elive
    http://search.cpan.org/dist/Elive

=cut

main(@ARGV) unless caller;

sub main {

    local(@ARGV) = @_;

    my $help;

    print "Elive ${Elive::VERSION} - Server Configuration Linter\n";

    GetOptions(
	'help|?' => \$help,
	)
	&& (($help && pod2usage(1)) || (my $config_file = shift @ARGV))
	&& (!@ARGV)
	or die pod2usage(1);

    print "Checking: $config_file\n";

    my %required_adapters = map {$_ => 1} (Elive->known_adapters);
    my %found;

    my $config = XMLin($config_file,
		       KeepRoot => 1,
		       ForceArray => 1,
	);

    my @errors;

    select STDERR; $| = 1;

#
# check and report on ldap status
#
    if (my @daos = _get_elems($config, qw/elm daofactory dao/)) {

	my ($ldap_dao) = grep {
	    my ($class) =_get_elems($_, 'class');
	    $class =~ m{ldapdao}i;
	    } @daos;

	if ($ldap_dao) {
	    print "Note: using LDAP for user management:\n\n";

	    my @arguments = _get_elems($ldap_dao, 'argument');

	    foreach my $argument (sort {$a->{name}[0] cmp $b->{name}[0]} @arguments) {
		    my $name = $argument->{name}[0];
		    my $value = $argument->{value}[0];
		    $value =~ s{.}{*}g
			if $name eq 'password';

		    printf("  %-14.14s: %s\n", $name, $value)
			if (defined $name && defined $value);
	    }

	    print "\n";
	}
    }

    my @adapters = _get_elems($config, qw/elm adapters adapter/);

    print "Adapters: ";

    if (my @default = map {_get_elems($_, 'default')} @adapters) {
	#
	# elluminate v 9.5
	#
	@adapters = @default;

	my ($command_adapter)
	    = (grep {my ($class) = _get_elems($_, 'class');
		     $class =~ m{CommandAdapter}}
	       @adapters);

	die "assuming elm 9.5, but unable to find elements of class =~ /CommandAdapter/"
	    unless $command_adapter;

	my @commands = _get_elems($command_adapter, 'commands');

	die "assumming elm 9.5, but unable to find 'commands' elements"
	    unless @commands;

	my ($command, @_guff) = map {_get_elems($_, 'command')} @commands;

	die "assumming elm 9.5, but unable to find 'command' element"
	    unless $command;

	my @command_keys = sort keys %$command;
	print "[$_]" for @command_keys;

	@found{@command_keys} = undef;
    }
    else {
	#
	# elluminate v9.0 - 9.1
	#
	my ($command_adapter)
	    = (grep {my ($class) = _get_elems($_, 'class');
		     $class =~ m{CommandAdapter}}
	       @adapters);

	die "Unable to locate adapter commands"
	    unless $command_adapter;

	my @commands = _get_elems($command_adapter, 'argument');
	
	foreach (sort {$a->[0] cmp $b->[0]}
		 map {[$_->{name}[0], $_->{value}[0]]}
		 @commands) {

	    my ($name, $value) = @$_;
	    next unless $name =~ s{^command\:}{};
	    next unless exists $required_adapters{$name};
	    print "[$name]";

	    if (exists $found{$name}) {
		push(@errors, "Duplicate entries for command: $name");
		next;
	    }
	    else {
		$found{$name} = undef;
	    }

	    unless ($value) {
		push(@errors, "Could not find a value for adapter command: $name");
		next;
	    }

	}
    }

    my @missing = sort grep {!exists $found{$_}} (keys %required_adapters);

    foreach (@missing) {
	push(@errors, "missing adapter command: $_");
    }

    die join("\n", '',@errors)
	if @errors;

    print "\nNo errors found\n";
}

sub _get_elems {
    my $struct = shift;
    my $tag = shift;

    my $elem = $struct->{$tag};

    my @got = ref($elem) eq 'ARRAY' ? @$elem
	: defined $elem? ($elem) : ();

    return @_
	? map {_get_elems($_, @_)} @got
	: @got;
}
