#!/usr/bin/perl -w

use strict;
use warnings;

use Data::Dumper; $Data::Dumper::Indent = 1;
use IO::Dir;
use XML::Simple;
use LWP;
use LWP::Simple;

use lib '../lib';
use Masterkey::Admin::Dummy;
use Masterkey::Admin::Torus;


# Explicit invocation:
#	$ remove-mk2-orphans -b http://x.newmk2.indexdata.com/torus2/ -a admin.admin -u identity.USERS -s searchable -c cat
# Using defaults:
#	$ remove-mk2-orphans

use Getopt::Std;

my %opts = (
    n => 0,
    v => 0,
    l => "torus",
    t => 'http://x.newmk2.indexdata.com/torus2/',
    a => 'admin.admin',
    u => 'identity.USERS',
    's' => 'searchable',
    c => 'cat',
);

if (!getopts('nvl:t:a:u:s:c:', \%opts) || @ARGV != 0) {
    print STDERR "\
Usage: $0 [options]
	-n		No action: show what WOULD be done
	-v		Verbose mode [default: off]
	-l <levels>	Set logging levels (e.g. 'torusop,torus') [$opts{l}]
	-t <torusURL>	Torus2 base URL [$opts{t}]
	-a <adminRealm>	Realm containing admin users [$opts{a}]
	-u <userRealm>	Realm containing end-users [$opts{u}]
	-s <sPrefix>	Prefix of realms containing searchables [$opts{s}]
	-c <cPrefix>	Prefix of realms containing categories [$opts{c}]
";
    exit 1;
}

print Dumper(\%opts) if $opts{v};


my $admin = new Masterkey::Admin::Dummy(logprefix => $0, loglevel => $opts{l});
my $torus = new Masterkey::Admin::Torus($admin, $opts{t});


{
    # Check end-users
    my %realms = find_realms($torus, $opts{a});
    print map { "$_=" . $realms{$_}->[0] . ": '" . $realms{$_}->[1] . "'\n"  } sort keys %realms if $opts{v};
    my $rs = $torus->records($opts{u}, "cql.allRecords=1 sortby displayName");
    print Dumper($rs) if $opts{v};

    foreach (my $i = 0; $i < $rs->count(); $i++) {
	my $rec = $rs->record($i) or die;
	my $realm = $rec->field("identityId");
	my $name = $rec->displayName();
	if (defined $realms{$realm}) {
	    # This end-user is associated with an administrator
	    $realms{$realm}->[0]++;
	} elsif ($opts{n}) {
	    print "delete end-user '$name' ($realm)\n";
	} else {
	    $rec->delete();
	}
    }

    foreach my $realm (sort keys %realms) {
	if ($realms{$realm}->[0] == 0) {
	    my $name = $realms{$realm}->[1];
	    print "NOTE: no end-users for realm '$realm' ($name)\n";
	}
    }
}


check_objects("searchable");
check_objects("cat");


sub check_objects {
    my($type) = @_;

    my %realms = find_realms($torus, $opts{a});
    my $regexp = "^$type\\.";
    my @existingRealms = list_realms($torus, $regexp);
    #print join("", map { "$_\n" } @existingRealms);
    foreach my $existingRealm (@existingRealms) {
	$existingRealm =~ s/$regexp//;
	if (defined $realms{$existingRealm}) {
	    # This existing realm is associated with an administrator
	    $realms{$existingRealm}->[0]++;
	} elsif ($opts{n}) {
	    print "delete $type realm '$existingRealm'\n";
	} else {
	    delete_realm($torus, "$type.$existingRealm");
	}
    }

    foreach my $realm (sort keys %realms) {
	if ($realms{$realm}->[0] == 0) {
	    my $name = $realms{$realm}->[1];
	    print "NOTE: no $type realm for '$realm' ($name)\n";
	}
    }
}


# Returns a mapping of realm-name to a two-element array:
#	0: count of occurrences, initially zero.
#	1: displayName
#
sub find_realms {
    my($torus, $adminRealm) = @_;

    my $rs = $torus->records($adminRealm, "cql.allRecords=1 sortby displayName");
    #print Dumper($rs) if $opts{v};
    my %realms = ();
    foreach (my $i = 0; $i < $rs->count(); $i++) {
	my $rec = $rs->record($i) or die;
	my $realm = $rec->field("identityId");
	$realms{$realm} = [ 0, $rec->displayName() ];
    }
    return %realms;
}


### The remaining functions should arguably be part of the Torus.pm API
sub list_realms {
    my($torus, $regexp) = @_;

    my $url = $torus->ws();
    my $xml = get($url) or die "can't fetch '$url'";
    my $ref = XMLin($xml);
    return sort grep { /$regexp/ } keys %{$ref->{realm}};
}


sub delete_realm {
    my($torus, $name) = @_;

    # Annoyingly, there is now LWP::Simple API for HTTP DELETE.
    my $ua = new LWP::UserAgent();
    my $uri = $torus->ws() . "$name/";
    my $res = $ua->request(new HTTP::Request(DELETE => $uri))
	or die "no response for DELETE from '$uri'\n";
    $res->is_success()
	or die "DELETE from $uri: ", $res->status_line();
}
