#!/usr/bin/perl
#
# Convert an ejabberd database dump to jive messengers roster import format.
# Usage:
#   1. ejabberdctl <node> dump filename       <- dumps mnesia db to a file
#   2. cat filename | ejdtojive.pl > jiveimport.xml
#   3. use jive's web interface to import jiveimport.xml, is a plugin
#
# By Daniel Henninger <jadestorm@nc.rr.com>
# Not the prettiest code in the world.  =)
#

use Data::Dumper;
use Encode;

my @A;
my $n = 0;

$/ = ".\n";
while (<>) {
	s/\.$//;

	s/"([^"]+)"/hide_problem_chars($1)/eg;

	s/\|/,/g;
	s/{/\[/g;
	s/}/\]/g;

	s/([\[\]{},\s]+)([^\[\]{},\s"]+)/$1"$2"/g;
	#s/\001/ /g;

	eval "\$A[$n] = $_";
	print "(( $@ ))(( $_ ))\n" if $@;

	$n++;
}

my $users;
my $uc = 0;
my %userstoid = ();
my %rostercnt = ();
foreach my $A (@A) {
	if ($A->[0] eq "passwd") {
		$users->[$uc]->{Username} = &fix_problem_chars(&fix_array_name($A->[1]->[0]));
		$users->[$uc]->{Password} = &fix_problem_chars($A->[2]);
		$users->[$uc]->{Email} = "";
		$users->[$uc]->{Name} = "";
		$userstoid{$A->[1]->[0]} = $uc;
		$rostercnt{$A->[1]->[0]} = 0;
		$uc++;
	}
	elsif ($A->[0] eq "roster") {
		my $item;
		if (ref($A->[3]->[0]) ne "ARRAY") {
			$item->{jid} = &fix_array_name($A->[3]->[0]).'@'.$A->[3]->[1];
		}
		else {
			$item->{jid} = $A->[3]->[1];
		}
		$item->{askstatus} = &convert_ask_status($A->[6]);
		$item->{recvstatus} = &convert_recv_status($A->[6]);
		$item->{substatus} = &convert_sub_status($A->[5]);
		if (ref($A->[4]) ne "ARRAY") {
			$item->{name} = &fix_problem_chars($A->[4]);
		}
		else {
			$item->{name} = "";
		}
		$item->{Group} = &fix_problem_chars($A->[7]->[0]);
		$ui = $userstoid{$A->[2]->[0]};
		$rc = $rostercnt{$A->[2]->[0]};
		$users->[$ui]->{Roster}->[$rc] = $item;
		$rostercnt{$A->[2]->[0]}++;
		#print "Roster [".$A->[2]->[0]."]: ".$A->[3]->[0].'@'.$A->[3]->[1]." (".($A->[4]).") in ".($A->[7]->[0] || "**NONE**").": ".$A->[5]." ".$A->[6]."\n";
	}
	elsif ($A->[0] eq "vcard") {
		$ui = $userstoid{$A->[1]->[0]};
		foreach my $e (@{$A->[2]->[3]}) {
			if ($e->[1] eq "FN") {
				$users->[$ui]->{Name} = &fix_problem_chars($e->[3]->[0]->[1]);
			}
			elsif ($e->[1] eq "EMAIL") {
				foreach my $em (@{$e->[3]}) {
					#print STDERR Dumper($em);
					my $addr = &fix_problem_chars($em->[3]->[0]->[1]);
					#print STDERR $addr."\n";
					if ($addr =~ /\@/) {
						$users->[$ui]->{Email} = $addr;
					}
				}
			}
		}
	}
}

print <<HEAD;
<?xml version="1.0" encoding="UTF-8"?>

<Wildfire>
HEAD

foreach my $u (@{$users}) {
	print <<USERHEAD;
  <User>
    <Username>$u->{Username}</Username>
    <Password>$u->{Password}</Password>
    <Email>$u->{Email}</Email>
    <Name>$u->{Name}</Name>
    <CreationDate>0</CreationDate>
    <ModifiedDate>0</ModifiedDate>
USERHEAD

	if (scalar $u->{Roster} == 0) {
		print <<NOROSTER;
    <Roster/>
NOROSTER
	}
	else {
		print <<ROSTERHEAD;
    <Roster>
ROSTERHEAD

		foreach my $r (@{$u->{Roster}}) {
			my $namefield = $r->{name} ne "" ? ' name="'.$r->{name}.'"' : "";
			print <<ROSTERITEMHEAD;
      <Item jid="$r->{jid}" askstatus="$r->{askstatus}" recvstatus="$r->{recvstatus}" substatus="$r->{substatus}"$namefield>
ROSTERITEMHEAD

			if ($r->{Group} ne "") {
				print <<ROSTERGROUP;
         <Group>$r->{Group}</Group>
ROSTERGROUP
			}
			else {
				print <<ROSTERGROUP;
         <Group/>
ROSTERGROUP
			}

			print <<ROSTERITEMTAIL;
      </Item>
ROSTERITEMTAIL
		}

		print <<ROSTERTAIL;
    </Roster>
ROSTERTAIL
	}
	foreach my $r (@{$u->{Roster}}) {
	}

	print <<USERTAIL;
  </User>
USERTAIL
}

print <<TAIL;
</Wildfire>
TAIL

exit 0;





sub fix_array_name {
	my $name = shift;
	my $retname = "";
	if (ref($name) eq 'ARRAY') {
		print STDERR Dumper($name);
		foreach my $c (@{$name}) {
			$retname .= sprintf("%c", $c);
		}
		$retname = Encode::decode_utf8($retname);
	}
	else {
		$retname = $name;
	}
	return $retname;
}

sub hide_problem_chars {
	my $a = shift;
	my $starta = $a;
	#$a =~ s/ /\001/g;
	#$a =~ s/\[/\002/g;
	#$a =~ s/\]/\003/g;
	#$a =~ s/\,/\004/g;
	#$a =~ s/\|/\005/g;
	$a =~ s/ /\001SPACE\001/g;
	$a =~ s/\[/\001LEFTBRACKET\001/g;
	$a =~ s/\]/\001RIGHTBRACKET\001/g;
	$a =~ s/\,/\001COMMA\001/g;
	$a =~ s/\|/\001PIPE\001/g;
	$a =~ s/\@/\001AMPERSAND\001/g;
	$a =~ s/\$/\001DOLLARSIGN\001/g;
	#if ($a ne $starta) { print STDERR "CHANGE: $starta => $a\n"; }
	return '"' . $a . '"';
}

sub fix_problem_chars {
	my $a = shift;
	my $starta = $a;
	#$a =~ s/\001/ /g;
	#$a =~ s/\002/[/g;
	#$a =~ s/\003/]/g;
	#$a =~ s/\004/,/g;
	#$a =~ s/\005/|/g;
	$a =~ s/\001SPACE\001/ /g;
	$a =~ s/\001LEFTBRACKET\001/[/g;
	$a =~ s/\001RIGHTBRACKET\001/]/g;
	$a =~ s/\001COMMA\001/,/g;
	$a =~ s/\001PIPE\001/|/g;
	$a =~ s/\001AMPERSAND\001/\@/g;
	$a =~ s/\001DOLLARSIGN\001/\$/g;
	#if ($a ne $starta) { print STDERR "RESTORE: $starta => $a\n"; }
	#return '"' . $a . '"';
	return $a;
}

sub convert_sub_status {
	my ($code) = @_;

	if ($code eq "remove") { return -1; }
	elsif ($code eq "none") { return 0; }
	elsif ($code eq "to") { return 1; }
	elsif ($code eq "from") { return 2; }
	elsif ($code eq "both") { return 3; }
	else { return 0; }
}

sub convert_recv_status {
	my ($code) = @_;

	if ($code eq "none") { return -1; }
	elsif ($code eq "subscribe") { return 1; }
	elsif ($code eq "unsubscribe") { return 2; }
	else { return -1; }
}

sub convert_ask_status {
	my ($code) = @_;

	if ($code eq "none") { return -1; }
	elsif ($code eq "out") { return 0; }
	else { return -1; }
}