jabber-migrate

#!/usr/bin/perl -w
use strict;
use Net::Jabber;
use FindBin;
use Data::Dumper;
my $usage = "Usage:
	$FindBin::Script [--tls] export <JID> <password> [<server>] [<port>] >roster.txt
	$FindBin::Script [--tls] import <JID> <password> [<server>] [<port>] <roster.txt";

sub get_client($$$$$$) {
	my ($username, $domain, $password, $server, $port, $tls) = @_;
	my $client = new Net::Jabber::Client();
	my $status = $client->Connect( hostname=>$server, port=>$port, tls=>$tls );
	if( not defined $status ) {
		warn "Jabber connect error: $!\n";
		warn "Try --tls option\n" if not $tls;
		exit 1;
	}
	my @result = $client->AuthSend(
		username => $username,
		password => $password,
		resource => "jabbermigrate" );
	if( $result[0] ne "ok" ) {
		die "Jabber auth error: @result\n";
	}
	return $client;
}

sub export_roster($) {
	my $client = shift;
	my %roster = $client->RosterGet();
	print Data::Dumper->Dump([\%roster], ["roster"]);
}

sub import_roster($) {
	my $client = shift;
	my %old_roster = $client->RosterGet();
	my $roster;
	eval join( "", <> ); # this is supposed to change $roster variable
	die $@ if $@;
	foreach my $jid (keys %$roster) {
		$roster->{$jid}{"jid"} = $jid; # for RosterAdd
		if( exists $old_roster{$jid} ) {
			print "$jid already exists, skipping.\n";
		} else {
			print "Adding $jid.\n";
			$client->RosterAdd( %{$roster->{$jid}} );
		}
	}
}

sub main() {
	my $tls = 0;
	if( @ARGV and "--tls" eq $ARGV[0] ) {
		$tls = 1;
		shift @ARGV;
	}
	die "$usage\n" unless @ARGV >= 3 and @ARGV <= 5;
	my ($command, $jid, $password, $server, $port) = @ARGV;
	@ARGV = (); # to make <> read stdin
	$command =~ /^(import|export)$/ or die "Unknown command: $command\n$usage\n";
	my ($username, $domain);
	if( $jid =~ /^([\w\-\.]+)@([\w\-\.]+)$/ ) {
		($username, $domain) = ($1, $2);
		$server = $domain unless defined $server;
	} else {
		 die "Bad JID: $jid\n";
	}
	$port = 5222 unless defined $port;
	my $client = get_client( $username, $domain, $password, $server, $port, $tls );
	if( $command eq "export" ) {
		export_roster( $client );
	} elsif( $command eq "import" ) {
		import_roster( $client );
	} else {
		die; # we cannot be here
	}
}

main;