#!/usr/bin/perl
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?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/);
    my @classes = map {_get_elems($_, 'class')} @adapters;

    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');

    print "Adapters: ";

    foreach my $command (@commands) {

	my $name = $command->{name}[0];
	my $value = $command->{value}[0];

	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 $expected_value = 'com.elluminate.adapter.command.'.ucfirst($name).'Command';
	unless ($value eq $expected_value) {
	    push (@errors, "command: $name\n    Expected value: $expected_value\n    Actual value: $value");
	}
    }

    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};
    die "unable to get: $tag"
	unless ($elem);

    my @got = @$elem;

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