[Perl + vB Related]

A lot of people on the vB forums seemed to need this:

Code:

#!/usr/bin/perl
# vBulletin Mass-Merge by SanTaClauS. Merges imported_% to %
# Get userfile with this query:
# SELECT username FROM user WHERE username LIKE 'imported_%';
#
# MD5PW and MD5PWU are being posted when you login at the board. So either sniff them or calculate them
# yourself (looking at the source code helps).
#
# Store them in ufiles.txt and set the variables!

use LWP::UserAgent;
use HTTP::Cookies;

my $ua = new LWP::UserAgent;
my $cookie_jar = HTTP::Cookies->new(
	file     => "/tmp/cookiejar.txt",
	autosave => 1,
);

# ADJUST THESE VARIABLES TO TASTE AND CORRECTNESS
# -----------------------------------------------
$USERNAME = 'admin';
$MD5PW = '';
$MD5PWU = '';
$HOST = 'http://localhost';
$DIR = '/';
$SITEURL = $HOST . $DIR;
$LOGINURL = $SITEURL . 'login.php?do=login';
$DOMERGURL = $SITEURL . 'admincp/usertools.php?do=domerge';
$MERGSURL = $SITEURL . 'admincp/usertools.php?do=merge';
$RDOMERGEURL = $SITEURL . 'admincp/usertools.php?do=reallydomerge';
$INDEXURL = $SITEURL . 'admincp/index.php';
# DON'T MODIFY ANYTHING BELOW THIS LINE

$ADMINHASH = "";

print ":: Opening userfile.\n";
open(ufile, "ufile.txt") || die("Could not open userfile!\n");
$users = <ufile>;

printf ":: Merging users!\n";

$ua->agent('Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1)');
$ua->timeout(300);
$ua->cookie_jar($cookie_jar);

my $response = $ua->get($INDEXURL);
if(!$response->is_success) {
	close(ufile);
	die("Could not GET the admin panel.\n");
}
$response = $ua->post($LOGINURL, { "logintype" => "cplogin",
				   "do" => "login",
				   "vb_login_md5password" => $MD5PW,
				   "vb_login_md5password_utf" => $MD5PWU,
				   "vb_login_username" => $USERNAME,
				   "cookieuser" => "1",
				   "vb_login_password" => "" });
if(!$response->is_success) {
	close(ufile);
	die("Could not send login request.\n");
}

my $resp;

$response = $ua->get($MERGSURL);
$resp = $response->content;
while($resp =~ m/<input type="hidden" name="(.*?)" value="(.*?)"/isg ) {
	if($1 eq "adminhash") {
		$ADMINHASH = $2;
		print ':: Retrieved adminhash: ' . $ADMINHASH . "\n";
	}
} 

my $sourceuserid;
my $destuserid;
while($users) {
	$impname = substr($users, 0, length($users)-1);
	$newname = substr($users, 9, length($users)-10);
	print ":: Merging $impname to $newname.\n";

	$response = $ua->post($DOMERGURL,
				{ "do" => "domerge",
				  "adminhash" => $ADMINHASH,
				  "sourceuser" => $impname,
				  "destuser" => $newname });
	if(!$response->is_success) {
		close(ufile);
		die("Could not send merge request for " . $newname . "\n");
	}
	$resp = $response->content;
        while($resp =~ m/<input type="hidden" name="(.*?)" value="(.*?)"/isg ) {
		if($1 eq "sourceuserid") {
			$sourceuserid = $2;
		}
		if($1 eq  "destuserid") {
			$destuserid = $2;
		}
	}
	print ":: Sourceuserid: ".$sourceuserid." Destuserid: ".$destuserid."\n";

	$response = $ua->post($RDOMERGEURL,
				{ "do" => "reallydomerge",
				  "adminhash" => $ADMINHASH,
				  "sourceuserid" => $sourceuserid,
				  "destuserid" => $destuserid });
	$users = <ufile>;
	print ":: Merge request for ".$newname." has been sent.\n";
}

print ":: MERGE DONE! Update User Titles and Ranks and Rebuild Thread Information counters now if you wish to remove traces of the imported users from last post information and to update the users new user title.\n";

close(ufile);

Impex mass merge is what it is. It's somewhat 110+ lines i believe.