j2to1 script

#!/usr/bin/perl
#
# Jabberd2 to 1 migration script, version 0.3
#
# This script pulls data out of a Jabberd2 database and creates a Jabberd1
# spool directory based off what it finds.  It is built around a MySQL-based
# Jabberd2 database, but may work with a Postgres one as well.
#
# Daniel Henninger <JID: daniel@jabber.vorpalcloud.org>
#
# Instructions:
#   1. Edit the variables in the section marked Configuration.  Configure
#      with a username/password that can read the jabber spool database.
#   2. Run this script with a single argument containing the spool directory
#      path you wish to create.  Note that this directory should not exist.
#
# Perl Module Requirements:
#   XML-Simple
#   DBI/DBD-mysql (or DBD-whatever other db, postgres?)
#
# Changes:
#   0.3: Fixed group conversion via patch from Jacek Konieczny (Jajcus).
#   0.2: Added pulling of "name" field from rosters.
#

### Configuration Start ###
my $dbtype	= "mysql";
my $dbhost	= "localhost";
my $dbdatabase	= "jabberd2";
my $dbusername	= "jabberd2";
my $dbpassword	= "password";
### Configuration End ###

use strict;
use DBI;
use XML::Simple;

my $spooldir = $ARGV[0];
die "Usage: j2to1.pl <spool dir to create>" if (!defined $spooldir);
mkdir($spooldir) || die "Unable to create spool dir.";

my $DBSERVER	= "DBI:$dbtype:database=$dbdatabase;host=$dbhost";
my $DBUSER	= $dbusername;
my $DBPASS	= $dbpassword;

my $dbh = DBI->connect($DBSERVER, $DBUSER, $DBPASS);
die("Failed to connect to database.") if (!$dbh);

my $sth = $dbh->prepare("SELECT * FROM authreg");
$sth->execute;
while (my $r = $sth->fetchrow_hashref) {
	my $id = $r->{username};
	my $realm = $r->{realm};
	my $jid = $id . "@" . $realm;
	print "Converting $jid...\n";

	my $xdb;
	$xdb->{password}->{xmlns} = "jabber:iq:auth";
	$xdb->{password}->{xdbns} = "jabber:iq:auth";
	$xdb->{password}->{content} = $r->{password};
	# The primary purpose of this script was migration to ejabberd,
	# which does not like zerok, so byebye.
	#$xdb->{zerok}->{xmlns} = "jabber:iq:auth:0k";
	#$xdb->{zerok}->{xdbns} = "jabber:iq:auth:0k";
	#$xdb->{zerok}->{token}->{content} = $r->{token};
	#$xdb->{zerok}->{sequence}->{content} = $r->{sequence};
	#$xdb->{zerok}->{hash}->{content} = $r->{hash};
	$xdb->{query}->[0]->{xmlns} = "jabber:iq:roster";
	$xdb->{query}->[0]->{xdbns} = "jabber:iq:roster";

	my $asth = $dbh->prepare("SELECT `roster-items`.jid,`roster-items`.name,`roster-items`.`to`,`roster-items`.`from`,`roster-items`.ask,`roster-groups`.`group` FROM `roster-items` LEFT JOIN `roster-groups` ON (`roster-items`.jid = `roster-groups`.jid and `roster-items`.`collection-owner` = `roster-groups`.`collection-owner`) WHERE `roster-items`.`collection-owner` = '$jid' ORDER BY `group`,jid");
	$asth->execute;
	my $cnt = 0;
	while (my $ar = $asth->fetchrow_hashref) {
		$xdb->{query}->[0]->{item}->[$cnt]->{jid} = $ar->{jid};
		$xdb->{query}->[0]->{item}->[$cnt]->{subscription} =
			( $ar->{to} && $ar->{from} ? "both" :
			( $ar->{to} ? "to" :
			( $ar->{from} ? "from" :
			"none" )));
		if (defined($ar->{name})) {
			$xdb->{query}->[0]->{item}->[$cnt]->{name} = $ar->{name};
		}
		if (defined($ar->{group})) {
			$xdb->{query}->[0]->{item}->[$cnt]->{group}->{content} = $ar->{group};
		}
		if ($ar->{ask}) {
			$xdb->{query}->[0]->{item}->[$cnt]->{ask} = 'subscribe';
		}
		$cnt++;
	}

	my $asth = $dbh->prepare("SELECT * FROM vcard WHERE `collection-owner` = '$jid'");
	$asth->execute;
	my $vr = $asth->fetchrow_hashref;
	if (defined $vr) {
		$xdb->{vCard}->{xmlns} = 'vcard-temp';
		$xdb->{vCard}->{xdbns} = 'vcard-temp';
		$xdb->{vCard}->{version} = '3.0';
		$xdb->{vCard}->{prodid} = '-//HandGen//NONSGML vGen v1.0//EN';
		$xdb->{vCard}->{FN}->{content} = $vr->{fn};
		$xdb->{vCard}->{NICKNAME}->{content} = $vr->{nickname};
		$xdb->{vCard}->{EMAIL}->{content} = $vr->{email};
		$xdb->{vCard}->{BDAY}->{content} = $vr->{bday};
		$xdb->{vCard}->{URL}->{content} = $vr->{url};
		$xdb->{vCard}->{TEL}->{content} = $vr->{tel};
		$xdb->{vCard}->{DESC}->{content} = $vr->{desc};
		$xdb->{vCard}->{N}->{GIVEN}->[0]->{content} = $vr->{'n-given'};
		$xdb->{vCard}->{N}->{FAMILY}->[0]->{content} = $vr->{'n-family'};
		$xdb->{vCard}->{ORG}->{ORGNAME}->[0]->{content} = $vr->{'org-orgname'};
		$xdb->{vCard}->{ORG}->{ORGUNIT}->[0]->{content} = $vr->{'org-orgunit'};
		$xdb->{vCard}->{TITLE}->{content} = $vr->{title};
		$xdb->{vCard}->{ROLE}->{content} = $vr->{role};
		$xdb->{vCard}->{ADR}->{STREET}->[0]->{content} = $vr->{'adr-street'};
		$xdb->{vCard}->{ADR}->{EXTADD}->[0]->{content} = $vr->{'adr-extadd'};
		$xdb->{vCard}->{ADR}->{LOCALITY}->[0]->{content} = $vr->{'adr-locality'};
		$xdb->{vCard}->{ADR}->{REGION}->[0]->{content} = $vr->{'adr-region'};
		$xdb->{vCard}->{ADR}->{PCODE}->[0]->{content} = $vr->{'adr-pcode'};
		$xdb->{vCard}->{ADR}->{COUNTRY}->[0]->{content} = $vr->{'adr-country'};
	}

	my $asth = $dbh->prepare("SELECT time FROM logout WHERE `collection-owner` = '$jid'");
	$asth->execute;
	my $lr = $asth->fetchrow_hashref;
	if (defined $lr) {
		$xdb->{query}->[1]->{xmlns} = 'jabber:iq:last';
		$xdb->{query}->[1]->{xdbns} = 'jabber:iq:last';
		$xdb->{query}->[1]->{last} = $lr->{time};
	}

	# Theoretically we should pull offline message as well.
	# Haven't gotten to that yet.  ;)

	mkdir("$spooldir/$realm") if (! -d "$spooldir/$realm");
	open(SPOOLFILE, "> $spooldir/$realm/${id}.xml") || die "Unable to create spool file.";
	print SPOOLFILE XMLout($xdb, RootName => "xdb");
	close(SPOOLFILE);
}

$dbh->disconnect;

exit 0;