#!/usr/bin/perl
##############################################################################
# AutoJUD v0.3
# 
# See LICENSE file for licensing information.
#
# This program, when run, searches each user set up on the jabber server,
# extracts the relevant information, and builds the information required 
# for the Jabber User Directory.
#
# By running this regularly (eg. by using cron), you can always maintain a 
# complete list of registered Jabber users.
##############################################################################

# Modified by Chris Wilkes (cwilkes@pobox.com)

use File::Copy;
use XML::Simple;
use POSIX qw/strftime/;
use strict;

my ($servername, $userdir, $juddir, $judfile, $judbackup,
	$verbose, $filesref, $jabberdir, $judtempfile, $userref, $retcode);

$verbose = 1;

$jabberdir  = "/usr/local/jabber";
$userdir    = "$jabberdir/spool";

$servername = shift || lookforserver($userdir);
$userdir .= "/$servername";
die "User.xml directory '$userdir' doesn't exist\n" unless (-d $userdir);

$juddir     = "$jabberdir/spool/jud";

$judfile    = "global.xdb";
$judbackup  = "global.xdb.backup";

$judfile    = "$juddir/$judfile";
$judbackup  = "$juddir/$judbackup";

$filesref   = findfiles($userdir);
$verbose && print STDERR "Found " . (scalar @$filesref) . " entries\n";

$userref = readin($filesref);
$verbose && print STDERR "Read in " . (scalar @$userref) . " entries from files\n";

$judtempfile = writeout($userref, $judfile);

$verbose && print STDERR "Backing up $judfile to $judbackup\n";
$retcode = copy($judfile, $judbackup);
unless ($retcode) {
	print STDERR "Error backing up $judfile to $judbackup\n";
	die;
}

$verbose && print STDERR "Copying $judtempfile to $judfile\n";
$retcode = copy($judtempfile, $judfile);
unless ($retcode) {
	print STDERR "Error copying $judtempfile to $judfile\n";
	die;
}

sub findfiles() {
	my $userdir = shift;
	my @files;
	$verbose && print STDERR "Looking to '$userdir' for user.xml files\n";
	opendir(USERS, $userdir) || die "can't opendir $userdir: $!";
		@files = map { "$userdir/$_" } grep { /\.xml$/ } readdir (USERS);
	close USERS;
	return \@files;
}

sub writeout() {
	my ($userref, $judfile) = @_;
	my ($date, $judtempfile);
	$date = strftime "%Y%m%d-%H%M%S", localtime;
	$judtempfile = "$judfile.$date";
	open (FOO, ">$judtempfile");
		print FOO "<xdb><foo xdbns='jabber:jud:users' xmlns='jabber:jud:users'>\n";
		foreach (@$userref) {
			print FOO "" . (join "\n", @{$_}) . "\n";
		}
		print FOO "</foo></xdb>\n";
	close FOO;
	return $judtempfile;
}

sub readin() {
	my $files = shift;
	my @users;
	foreach my $file (@$files) {
		my ($xml, $vcard, $username, $jid, @body, $entries);
		($username) = ($file =~ /([^\/]+)\.xml$/);
		$verbose && print STDERR "Found user '$username'\n";
		$jid = "$username\@$servername";
		push @body, "<item jid='$jid'>";
		push @body, "\t<key/>";
		$xml = XMLin($file);
		foreach my $key (qw(VCARD vcard vCard)) {
			if ($xml->{$key}) {
				$vcard = $xml->{$key};
				$verbose && print STDERR "\t'$key' for vCard\n";
				last;
			}
		}
		unless (defined($vcard)) {
			$verbose && print STDERR "\tNo vCard info found\n";
			push @body, "</item>";
			push @users, \@body;
			next;
		}
		my $entries = {
		  'name'   => $vcard->{'FN'},
		  'first'  => $vcard->{'N'}->{'GIVEN'},
		  'last'   => $vcard->{'N'}->{'FAMILY'},
		  'nick'   => $vcard->{'NICKNAME'},
		  'email'  => $vcard->{'EMAIL'}
		};
		foreach my $key (keys %{$entries}) {
			$verbose && print STDERR "\tlooking for '$key' ... ";
			my $value = $entries->{$key};
			if (defined($value)) {
				$verbose && print STDERR "found '$value'\n";
				push @body, "\t<$key>$value</$key>";
			} else {
				$verbose && print STDERR "not found\n";
				push @body, "\t<$key/>";
			}
		}
		push @body, "</item>";
		push @users, \@body;
	}
	return \@users;
}

sub lookforserver() {
	my $dir = shift;
	my @dirs;
	opendir (FOO, $dir) || die "Directory '$dir' isn't readable, looking for servername\n";
		@dirs = grep { -d "$dir/$_" && !/^(\.|jud$)/  } readdir(FOO);
	close FOO;
	die "Not just one directory under '$dir' (@dirs) -- must explicity pass me one\n"
	  unless (scalar(@dirs) == 1);
	return $dirs[0];
}