#!/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 -t 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 <logLevels>	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($opts{s});
check_objects($opts{c});


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();
}


=head1 NAME

remove-mk2-orphans - remove end-user accounts and searchable/category realms not associated with a library

=head1 SYNOPSIS

remove-mk2-orphans
[
C<-n>
]
[
C<-v>
]
[
C<-l>
I<logLevels>
]
[
C<-t>
I<torusURL>
]
[
C<-a>
I<adminRealm>
]
[
C<-u>
I<userRealm>
]
[
C<-s>
I<searchablePrefix>
]
[
C<-c>
I<categoryPrefix>
]

=head1 DESCRIPTION

When MKAdmin deletes the last administrator associated with a library,
it is intended to remove all that library's end-user records, its
searchable realm and its the category realm.  However, stale records
do occasionally survive for one reason or another. These can cause
problems -- especially end-user records with credentials that lay in
wait to authenticate users onto libraries that no longer exist.

C<remove-mk2-orphans>
finds such abandoned end-users, searchable realms and category realms
and deletes them (unless the
C<-n>
option is in force).

=head1 OPTIONS

=over 4

=item C<-n>

Do not perform the removal operations -- merely note what I<would> be
done. Like C<make -n>.

=item C<-v>

Emit verbose commentary. Be warned, it really I<is> verbose. Probably
of interest only to people developing or debugging the program.

=item C<-l> I<logLevels>

Set the logging level to the specified combination of levels. Level
names should be comma-separated, as in C<torus,torusop>.

Default: C<torus>

=item C<-t> I<torusURL>

Set the Torus base URL, specifying where the work is to be done. The
default points to a Torus on a development machine, which will be
inaccessible to most users. This is deliberate: by failing safe, we
avoid inadvertently changing a live Torus with dry runs. All real uses
of C<remove-mk2-orphans> will need to provide a C<-t> option.

Default: C<http://x.newmk2.indexdata.com/torus2/>

=item C<-a> I<adminRealm>

Set the name of the realm containing adminstrative users.
There is generally no need to change this from the default.

Default: C<admin.admin>

=item C<-u> I<userRealm>

Set the name of the realm containing end-user records.
There is generally no need to change this from the default.

Default: C<identity.USERS>

=item C<-s> I<searchablePrefix>

Set the prefix used to make the names of searchable realms when
combined with the identityId of an administrator record.
There is generally no need to change this from the default.

Default: C<searchable>

=item C<-c> I<categoryPrefix>

Set the prefix used to make the names of category realms when combined
with the identityId of an administrator record.
There is generally no need to change this from the default.

Default: C<cat>

=back

=head1 EXAMPLES

An example invocation:

 $ remove-mk2-orphans -n -t http://x.dbc.indexdata.com/torus2/

Show what would be done if removing orphan end-user records and
searchable/category realms from the local copy of the DBC torus.

=head1 AUTHOR

Copyright (C) 2014 by Index Data Aps E<lt>info@indexdata.comE<gt>

=cut
