autocreate xml user files script

#!/usr/bin/perl

#jabber-contact-mix.pl - autocreate xml user files. 
#-----------------------------------------------------------------
#Copyright 2005 Ignacio Barrientos <chipi@criptonita.com>
#
#This perl script read users from $list_file and make relationship
#with everybody in the list, except used with void roster flag set.
#
#Script working on EBHI (http://www.ebhi.es)
#
#Based on Joe Hortsmann's Jabber User Setup script 
#
#This program is free software; you can redistribute it or modify
#it under the terms of the GNU General Public License
#-----------------------------------------------------------------

# user list file format:
# login<tab>Real Name<tab>Group<tab>Password<tab>Void roster(boolean)
#


$host = "192.168.0.7";
$spool_path = "/usuarios/jabber/$host";
$list_file = "/usuarios/backup/jabber/userlist.txt";


##########
#main routine

main();

exit;

##########
sub read_list {

open INPUT, $list_file or die "Error opening list";
chomp (@userlist = <INPUT>);
close INPUT;

}

##########
sub create_roster {

	$out = "<query xmlns='jabber:iq:roster' xdbns='jabber:iq:roster'>";

	&read_list;

	if (!( $_[1] == 1 ))
	{

	foreach $username (@userlist)
	{
		@local_user_data = split(/\t/,$username);

		if ( ($_[0] ne $local_user_data[0]) && ($local_user_data[4] == 0) )
		{
			$out = "$out<item jid='$local_user_data[0]\@$host' name='$local_user_data[1]' subscription='both'><group>$local_user_data[2]</group></item>";
		}

	}

	}

	$out = "$out</query>";

	return $out;			
}

##########
sub create_xml {

	$login = $_[0];
	$name = $_[1];
	$password = $_[2];
	$void = $_[3];

	$roster = create_roster($login,$void);

	$out = "<xdb><password xmlns='jabber:iq:auth' xdbns='jabber:iq:auth'>$password</password><query xmlns='jabber:iq:register' xdbns='jabber:iq:register'><username>$login</username><password xmlns='jabber:iq:auth'>$password</password></query>$roster<vCard xmlns='vcard-temp' prodid='-//HandGen//NONSGML vGen v1.0//EN' version='2.0' xdbns='vcard-temp'><FN>$name</FN></vCard></xdb>";

	return $out;

}

sub main {

	&read_list;

	foreach $username (@userlist) {
		@user_data = split(/\t/,$username);

		$data = create_xml($user_data[0], $user_data[1], $user_data[3], $user_data[4]);

		open XML,">$spool_path/$user_data[0].xml" or die "Cannot open $spool_path/$user_data[0].xml for write :$!";

		print XML "$data";

		close XML;

	}
}