createTestMods

#!/usr/bin/perl -w
# This code is a part of Slash, and is released under the GPL.
# Copyright 1997-2002 by Open Source Development Network. See README
# and COPYING for more information, or see http://slashcode.com/.
# $Id$

use strict;
use File::Basename;
use FindBin '$Bin';
use Getopt::Std;
use Slash;
use Slash::Utility;
use Benchmark;

use vars qw( $slashdb $constants );

(my $VERSION) = ' $Revision$ ' =~ /\$Revision:\s+([^\s]+)/;
my $PROGNAME = basename($0);
(my $PREFIX = $Bin) =~ s|/[^/]+/?$||;

my (%opts);
# Remember to doublecheck these match usage()!
usage('Options used incorrectly') unless getopts('hI:RrTu:U:v', \%opts);
usage() if ($opts{'h'} || !keys %opts);
version() if $opts{'v'};
# Parallel syntax checking for R/U and r/I.
for ([qw(R U)], [qw(r I)]) {
	if (exists $opts{$_->[0]}) {
		usage("Can't specify -$_->[1] when using -$_->[0]")
			if exists $opts{$_->[1]};
	} else {
		usage("Must specify either -$_->[0], or -$_->[1]")
			if ! exists $opts{$_->[1]};
		usage('Invalid UID specified')
			unless $_->[1] ne 'U' || $opts{$_->[1]} =~ /^\d+$/;
	}
}
	
$opts{'u'} ||= 'slash';
$opts{num_mods} = $ARGV[0] || 10;
usage('Invalid number of moderations') 
	if $opts{num_mods} !~ /^\d+$/ || $opts{num_mods} < 0;

createEnvironment($opts{u});
$slashdb = getCurrentDB();
$constants = getCurrentStatic();

# Story->Discussion lookup hash.
print "Loading stories...\n";
my $stories = $slashdb->sqlSelectAllHashref(
	'sid',
	'sid, discussion',
	'stories'
);

# CID->UID lookup hash.
print "Loading comment authors...\n";

# For chosing random discussions.
print "Loading discussions...\n";
my $discussions = [
	map { $_ = $_->[0][0] }
	$slashdb->sqlSelectAll(
		'sid, count(*) as c',
		'comments',
		'',
		'group by sid having c > 0'
	)
];

my(%comments, %comment_authors);

# main program logic (in braces to offset nicely)
{
	print "Generating moderations...\n";
	my $story_id = $opts{I} || '';
	my $discussion_id;
	if ($story_id =~ /^\d+$/) {
		$discussion_id = $story_id;
	} else {
		$discussion_id = $stories->{$discussion_id}{discussion}
	}

	my $t0 = new Benchmark;
	my $count = $opts{num_mods};
	while ($count) {
		my $did = (exists $opts{r}) ?
			$discussions->[rand $#{$discussions} + 1] : 
			$discussion_id;

		if (!exists $comments{$did}) {
			$comments{$did} = [
				map { $_ = $_->[0] }
				@{$slashdb->sqlSelectAll(
				 	'cid', 'comments', "sid=$did"
				)}
			];

			$comment_authors{$did} = $slashdb->sqlSelectAllHashref(
				'cid',
				'sid, cid, uid',	
				'comments',
				"sid=$did"
			);
		}
		
	 	# Determine the moderator.
		my $uid = ($opts{R}) ? 
				getRandomUserID($comment_authors{$did}) :
				$opts{U};

		# Moderators will usually moderate in batches. For now, we 
		# will use random batches up to a tenth of the specified 
		# value.
		#
		# Here's the catch. Any random moderator picked, cannot be
		# a comment creator, and vice versa!
		my $batchsize = ($opts{num_mods} / 10) || 1;
		my $batch = int(rand $batchsize) + 1;
		$batch = $count if $batch > $count;
		my @cidbatch = ();
		while ($batch--) {
			my @val = (-1, +1);

			# CAREFUL!
			$count--;
			LOOP: while (@cidbatch < @{$comments{$did}}) {
				my $rcid = $comments{$did}->[
					rand $#{$comments{$did}} + 1
				];
				for (@cidbatch) {
					next LOOP if $_ == $rcid;
				}
				push @cidbatch, $rcid;
				#{local $"='|';print STDERR "C: [@cidbatch]\n"}
				last;
			}

			my $cid = $cidbatch[-1];
			my $comment = {
				sid => $did,
				cid => $cid,
				uid => $comment_authors{$did}->{$cid}{uid},
			};

			my($modval, $reason, $active);
			$reason = int(rand $#{$constants->{reasons}}) + 1;
			$modval = ($reason > $constants->{badreasons}) ?
				1 : -1;
			$modval = -1 if $reason == 8;
			$modval = 1 if $reason == 9;
			$slashdb->setModeratorLog(
				$comment,
				$uid,
				$modval,
				$reason,
				($active = (rand(100) > 95) ? 0 : 1),
			);
			die if $DBI::errstr;

			printf <<EOT, $comment->{cid}, $comment->{uid}, $modval;
M($count): Mod=$uid, CID=%s, CUid=%s, R=$reason, V=%s, A=$active
EOT

		}
	}
	my $t1 = new Benchmark;
	print "$opts{num_mods} moderations created in: ",
        	timestr(timediff($t1, $t0), 'noc'),"\n";
}

# subroutines

# CLOSURE!
# Yes. I am getting a little silly with these. But it's nice not having.
# them clutter scope elsewhere, when they are only needed here.
{
my($min_uid, $max_uid);
my(%exception_list);
sub getRandomUserID {
	my ($key,$val) = each %{$_[0]};
	if (!exists $exception_list{$val->{sid}}) {
		LOOP:
		for my $cid (keys %{$_[0]}) {
			for (@{$exception_list{$val->{sid}}}) {
				next LOOP if $_ == $_[0]->{$cid}{uid};
			}
			push @{$exception_list{$val->{sid}}},
			     $_[0]->{$cid}{uid};
		}
		@{$exception_list{$val->{sid}}} =
			sort {$a <=> $b} @{$exception_list{$val->{sid}}};

#		{
#			local $"=',';
#		 	printf STDERR <<EOT;
#E ($val->{sid}): @{$exception_list{$val->{sid}}}
#EOT
#
#		}
	}
	$max_uid ||= $slashdb->getLastUser();
	$min_uid ||= $slashdb->sqlSelect('MIN(uid)', 'users');
	my $ret = $min_uid + int(rand($max_uid - $min_uid + 1));  
	for (@{$exception_list{$val->{sid}}}) {
		return getRandomUserID(@_) if $_ == $ret;
	}
        return $ret;
} }


sub usage {
	print "*** $_[0]\n" if $_[0];
	# Remember to doublecheck these match getopts()!
	print <<EOT;

Usage: $PROGNAME [OPTIONS] [#moderations]

This utility creates test moderations for a given Slash site. This program is for
testing purposes, only, particularly for those ambitious Slash users out there
who want to try their hand at modifying the comment or moderation systems.

This program is *not* designed to work for large sites, just small test sites
that have been recently installed.

DO NOT USE THIS ON A PRODUCTION SITE.

You have been warned. :)

Main options:
	-h	Help (this message)
	-v	Version
	-u	Virtual user (default is "slash")

Identity options (specify one): 
	-U	User to moderate as. Not for use with -R
	-R	Moderate as random users. Not for use with -U

	-r	Moderate over random stories. Not for use with -I
	-I	Story ID to be moderated. Not for use with -r

EOT
	exit;
}


sub version {
	print <<EOT;

$PROGNAME $VERSION

This code is a part of Slash, and is released under the GPL.
Copyright 1997-2002 by Open Source Development Network. See README
and COPYING for more information, or see http://slashcode.com/.

EOT
	exit;
}

__END__