Permalink
Fetching contributors…
Cannot retrieve contributors at this time
executable file 259 lines (230 sloc) 7.25 KB
#!/usr/bin/perl -w
# This code is a part of Slash, and is released under the GPL.
# Copyright 1997-2005 by Open Source Technology Group. See README
# and COPYING for more information, or see http://slashcode.com/.
# $Id$
BEGIN {
{
require Silly::Werder;
Silly::Werder->import;
}
die "Installation of Silly::Werder is required for this util, sorry!\n"
if $@;
}
use strict;
use File::Basename;
use Getopt::Std;
use Slash;
use Slash::Utility;
use Benchmark;
use vars qw( $slashdb $werder $constants $junk $tagsdb );
(my $VERSION) = ' $Revision$ ' =~ /\$Revision:\s+([^\s]+)/;
my $PROGNAME = basename($0);
my %opts;
# Remember to doublecheck these match usage()!
usage('Options used incorrectly') unless getopts('hJu:va:', \%opts);
usage() if $opts{'h'};
version() if $opts{'v'};
$junk = $opts{'J'} ? 1 : 0;
$opts{'u'} ||= 'slash';
$opts{num_tags} = $ARGV[0] || 10;
usage('Invalid number of users')
if $opts{num_tags} !~ /^\d+$/ || $opts{num_tags} < 0;
createEnvironment($opts{u});
setCurrentSkin(determineCurrentSkin());
$slashdb = getCurrentDB();
$constants = getCurrentStatic();
$werder = new Silly::Werder;
my $kmax = $constants->{maxkarma};
my $kmin = $constants->{minkarma} + 10;
$kmin = $constants->{minkarma} if $kmin >= $kmax;
$tagsdb = getObject('Slash::Tags') || die "cannot instantiate Slash::Tags";
my $upvoteid = $tagsdb->getTagnameidCreate($constants->{tags_upvote_tagname} || 'nod');
my $downvoteid = $tagsdb->getTagnameidCreate($constants->{tags_downvote_tagname} || 'nix');
$werder->set_syllables_num(1, 3);
srand(12345);
my @commontags = ( );
for (1..10) { push @commontags, [ map { $werder->get_werd } 1..10 ] }
my @commonuids = ( );
for (1..10) { push @commonuids, [ map { _get_random_uid() } 1..10 ] }
srand;
# main program logic (in braces to offset nicely)
{
my $stories = $slashdb->getStoriesEssentials({ future_secs => 0, limit => 10, limit_extra => 0,
sectioncollapse => (rand(1) < 0.3) ? 1 : 0 });
my $priv_tagnames = $tagsdb->getPrivateTagnames();
my $firehose = getObject('Slash::FireHose');
my $minfhcolor = (rand(1) < 0.4 ? 5 : 7);
my($firehose_items, $firehose_results) =
$firehose->getFireHoseEssentials({ color => $minfhcolor });
my $tagnameid = 0;
my($stoid, $globjid) = (0, 0);
my $uid = 0;
for (1..$opts{num_tags}) {
if (rand(1) < 0.02) {
# Instead of adding a tag, deactivate an existing one.
my $tag = $tagsdb->sqlSelectHashref(
'*', 'tags', 'inactivated IS NULL',
'ORDER BY RAND() LIMIT 1');
if ($tag) {
my $count = $tagsdb->deactivateTag($tag);
print "tagid=$tag->{tagid} deactivated $count tagnameid=$tag->{tagnameid} uid=$tag->{uid} globjid=$tag->{globjid}\n";
}
} elsif (rand(1) < 0.4) {
# Tag a story
$stoid = $stories->[rand(@$stories)]{stoid} if !$stoid || rand(1) > 0.2;
$uid = _get_uid($tagsdb, $stoid);
$tagnameid = _get_tagnameid($tagsdb, $tagnameid, $stoid, $uid);
my $tagname = $tagsdb->getTagnameDataFromId($tagnameid)->{tagname};
my $is_private = $priv_tagnames->{$tagname};
my $tagid = $tagsdb->createTag({
uid => $uid,
tagnameid => $tagnameid,
table => 'stories',
id => $stoid,
private => $is_private,
});
print "tagid=$tagid tagnameid=$tagnameid uid=$uid stoid=$stoid\n";
} else {
# Tag a firehose item
$globjid = $firehose_items->[rand(@$firehose_items)]{globjid}
if !$globjid || rand(1) > 0.2;
$uid = $tagsdb->sqlSelect('uid', 'users_info',
"karma BETWEEN $kmin AND $kmax",
'ORDER BY RAND() LIMIT 1') if !$uid || rand(1) > 0.2;
$tagnameid = _get_tagnameid($tagsdb, $tagnameid, $globjid, $uid);
my $tagname = $tagsdb->getTagnameDataFromId($tagnameid)->{tagname};
my $is_private = $priv_tagnames->{$tagname};
my $tagid = $tagsdb->createTag({
uid => $uid,
tagnameid => $tagnameid,
globjid => $globjid,
private => $is_private,
});
print "tagid=$tagid tagnameid=$tagnameid uid=$uid globjid=$globjid\n";
}
}
}
# subroutines
sub _get_uid {
my($tagsdb, $taggedid) = @_;
my $uid = 0;
while (!$uid) {
if (rand(1) < 0.6) {
# random user who has tagged before
$uid = $tagsdb->sqlSelect('uid', 'tags', '',
'ORDER BY RAND() LIMIT 1');
} elsif (rand(1) < 0.95) {
# pick a set of 10 common uids for this taggedid.
# then pick 1 of those 10, odds for each one
# being 1/2, 1/4 ... 1/1024.
srand($taggedid);
my $cu_ar = $commonuids[rand(10)];
srand;
for my $i (0..$#$cu_ar) {
if (rand(1) > 0.5) {
$uid = $cu_ar->[$i];
last;
}
}
}
# if none, random user
$uid = 0 if isAnon($uid);
$uid ||= _get_random_uid();
}
return $uid;
}
{
my $alluids = undef;
sub _get_random_uid {
my $uid = 0;
if (!$alluids || !@$alluids) {
my $mon = substr($tagsdb->sqlSelect('DATE(NOW())'), 0, 7) . '-01 00:00:00';
$alluids = $tagsdb->sqlSelectColArrayref('uid', 'users_info',
"created_at < '$mon' AND karma BETWEEN $kmin AND $kmax");
$alluids = [ grep { !isAnon($_) } @$alluids ];
}
if (!$alluids || !@$alluids) {
$alluids = $tagsdb->sqlSelectColArrayref('uid', 'users_info',
"karma BETWEEN $kmin AND $kmax");
$alluids = [ grep { !isAnon($_) } @$alluids ];
}
return 0 if !$alluids || !@$alluids;
$uid = $alluids->[rand @$alluids];
return $uid;
}
}
sub _get_tagnameid {
my($tagsdb, $old_tagnameid, $taggedid, $uid) = @_;
my $retval = 0;
if ($old_tagnameid && rand(1) < 0.2) {
# same as before
$retval = $old_tagnameid;
} elsif (rand(1) < 0.4) {
# skip this if there aren't many tagnames yet
my $n_tagnames = $tagsdb->sqlCount('tagnames');
if ($n_tagnames >= 100) {
# random existing tagname
$retval = $tagsdb->sqlSelect('tagnameid', 'tagnames', '',
'ORDER BY RAND() LIMIT 1');
}
} elsif (rand(1) < 0.7) {
# up or down vote
my $bias = 0;
srand($uid); $bias += rand()*0.4 - 0.2;
srand($taggedid); $bias += rand()*0.4 - 0.2;
srand;
$retval = (rand()+$bias < 0.5) ? $upvoteid : $downvoteid;
} elsif (rand(1) < 0.9) {
# pick a set of 10 commontags for this taggedid.
# then pick 1 of those 10, odds for each one
# being 1/2, 1/4 ... 1/1024.
srand($taggedid);
my $ct_ar = $commontags[rand(10)];
srand;
for my $i (0..$#$ct_ar) {
if (rand(1) > 0.5) {
$retval = $tagsdb->createTagname($ct_ar->[$i]);
last;
}
}
$retval ||= $tagsdb->createTagname($ct_ar->[0]);
}
while (!$retval) {
# Wholly new random word
$retval = $tagsdb->createTagname($werder->get_werd);
}
if (rand(1) < 0.03) {
# Opposite of the tagname just picked
my $tagname = $tagsdb->getTagnameDataFromId($retval)->{tagname};
my $opp = $tagsdb->getOppositeTagname($tagname);
$retval = $tagsdb->createTagname($opp);
}
return $retval;
}
sub usage {
print "*** $_[0]\n" if $_[0];
# Remember to doublecheck these match getopts()!
print <<EOT;
Usage: $PROGNAME [OPTIONS] [#users]
This utility creates test users 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 code.
Main options:
-h Help (this message)
-v Version
-u Virtual user (default is "slash")
-a Additional user for testing
EOT
exit;
}
sub version {
print <<EOT;
$PROGNAME $VERSION
This code is a part of Slash, and is released under the GPL.
Copyright 1997-2005 by Open Source Technology Group. See README
and COPYING for more information, or see http://slashcode.com/.
EOT
exit;
}
__END__