Skip to content
Fetching contributors…
Cannot retrieve contributors at this time
executable file 371 lines (323 sloc) 10.5 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$
# Based on jamie's createTestStories. Any bugs are probably HIS fault
# but I'll take the heat for them, because he's a really cool guy.
# - Cliff
BEGIN {
eval {
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 Data::Dumper;
use Date::Manip qw( UnixDate ParseDateString );
use Slash;
use Slash::Utility;
use Benchmark;
use vars qw( $slashdb $werder $constants $gSkin );
(my $VERSION) = ' $Revision$ ' =~ /\$Revision:\s+([^\s]+)/;
my $PROGNAME = basename($0);
my (%opts, %family_tree);
# Remember to doublecheck these match usage()!
usage('Options used incorrectly') unless getopts('hvDU:u:S:W:', \%opts);
usage() if $opts{'h'};
version() if $opts{'v'};
$opts{'u'} ||= 'slash';
$opts{num_subs} = $ARGV[0] || 10;
usage('Invalid number of submissions')
if $opts{num_subs} !~ /^\d+$/ || $opts{num_subs} < 0;
# Optional. Used later.
eval { require Time::HiRes };
my $shortDelay = 0;
$shortDelay = 1 if $INC{'Time/HiRes.pm'} && Time::HiRes->can('usleep');
createEnvironment($opts{u});
setCurrentSkin(determineCurrentSkin());
$slashdb = getCurrentDB();
$werder = new Silly::Werder;
$werder->set_syllables_num(2, 6);
$constants = getCurrentStatic();
$gSkin = getCurrentSkin();
my $user;
if (exists $opts{'U'}) {
$opts{'U'} = $slashdb->getUserUID($opts{'U'})
unless $opts{'U'} =~ /^\d+$/;
die "Invalid user given by -U switch!"
unless ($user = $slashdb->getUser($opts{'U'}));
}
# main program logic (in braces to offset nicely)
{
my $max_uid = $slashdb->countUsers({ max => 1});
my $min_uid = $slashdb->sqlSelect('MIN(uid)', 'users');
my $user_name = $user->{nickname} if $opts{'U'};
$opts{'w'} =~ /(\d+)?\-(\d+)?/ if $opts{'w'};
my($min_weight, $max_weight) = ($1, $2);
$min_weight ||= 0;
$max_weight ||= 99;
my $rootdir = $gSkin->{rootdir};
my $t0 = new Benchmark;
my $count = $opts{num_subs};
while ($count) {
# Let's have a little fun with this...
my $subject = make_werds(1 + rand 8);
$subject =~ s/\W+$// if rand(1) < 0.9;
$subject =~ s/<[^>]+>//g;
$subject =~ s/\b(\w)/\U$1/g if rand(1) < 0.4;
my $story = make_werds(10 + rand(30));
my $odds = rand(1);
if ($odds < 0.1) {
$story .= make_werds(10 + (rand 20) * (rand 50), 0.1);
$story =~ s{([.?!] )}{
$1 . ((rand(1) < 0.2) ? "<P>" : "")
}xge if $odds < 0.05;
}
$story .= typical_remark() if rand(1) < 0.05;
my $submitter= $opts{'U'} ||
getRandomUserID($min_uid, $max_uid);
my $time = UnixDate(
ParseDateString('epoch ' . get_time(-1)),
"'%Y-%m-%d %H:%M:%S'"
);
my $tid = getRandomTopicID();
my $section = $opts{'S'} || getRandomSkin();
my $name = make_werds(1);
$name =~ s/[.?!]$//;
$name = $user_name || sprintf 'Random %s User', $name;
my $weight = $min_weight + rand($max_weight - $min_weight);
my $comment;
$comment = typical_remark() if rand(1) > 0.87;
$comment =~ s/^ // if $comment;
my $submission = {
name => $name,
uid => $submitter,
tid => $tid,
'time' => $time,
subj => $subject,
primaryskid => $section,
story => $story,
weight => $weight,
comment => $comment,
};
print Dumper($submission), "\n\n" if $opts{'D'};
# Create the submission, but use the time we give rather than
# the API imposed default.
my $subid = $slashdb->createSubmission($submission);
print $subid ? <<C : <<F;
($count) Submission created: '$subject', $section, $time, $weight
C
($count) Submission creation failed!!
F
$count--;
# Slight delay or subids may collide.
if ($INC{'Time/HiRes.pm'} && Time::HiRes->can('usleep')) {
Time::HiRes::usleep(50000) if $count;
} else {
sleep 1 if $count;
}
}
my $t1 = new Benchmark;
print "$opts{num_subs} submissions created in: ",
timestr(timediff($t1, $t0), 'noc'),"\n";
}
# subroutines
sub get_time {
my($direction) = @_;
my($min, $max);
my $now = time;
if (!$direction) {
$min = $now - 86400 * 7;
$max = $now + 86400 * 7;
} elsif ($direction < 0) {
$min = $now + 86400 * $direction;
$max = $now;
} else {
$min = $now;
$max = $now + 86400 * $direction;
}
return int(rand($max-$min)) + $min;
}
sub getRandomTopicID {
# Yes, inefficient. I do not care.
my $tids = $slashdb->sqlSelectAll('tid', 'topics');
my @tids = map { $_->[0] } @$tids;
my $rand_tid = @tids[ rand @tids ];
return $rand_tid;
}
sub getRandomSkin {
# Yes, inefficient. I do not care.
my $sections = $slashdb->sqlSelectAll(
'skid', 'skins', '', 'ORDER BY RAND()'
);
my @sections = map { $_->[0] } @$sections;
my $num = rand @sections;
$num = 0 if rand(1) < 1/3;
my $rand_section = $sections[$num];
return $rand_section;
}
sub getRandomUserID {
my($min_uid, $max_uid) = @_;
my $rand_uid = $slashdb->sqlSelect(
'uid', 'users',
"uid BETWEEN $min_uid AND $max_uid",
'ORDER BY RAND() LIMIT 1'
);
return $rand_uid;
}
sub make_werds {
my($werds, $link_prob) = @_;
$werds = int($werds);
$link_prob ||= 0;
if ($werds > 40) {
$werder->set_werds_num(5,20);
} elsif ($werds > 20) {
$werder->set_werds_num(3,10);
} else {
$werder->set_werds_num($werds, $werds);
}
my @links = qw(
http://slashdot.org/ http://www.brunching.com/
http://www.newsforge.com http://ostg.com
http://whitehouse.gov http://www.whitehouse.gov/
http://us.imdb.com/ http://www.kernel.org
http://ic.ac.uk http://cr.yp.to/
http://www.verizonreallyreallyreallysucks.com/
ftp://ftp.kernel.org/
ftp://ftp.gnu.org/gnu/Licenses/COPYING-2.0
news:news.admin.net-abuse.email
gopher://ccat.sas.upenn.edu:3333/11/Fiction/
http://List-Etiquette.com/about/
http://slashdot.org/features/99/03/31/0137221.shtml
http://www.nap.edu/readingroom/books/newpath/chap2.html
http://www.forthnet.gr/forthnet/isoc/short.history.of.internet
http://www.freenix.fr/unix/linux/HOWTO/French-HOWTO.html
http://www.linux.org.mx/
http://www.linux.net.mx/linux.php
http://www.linux.org.uk/diary/
http://hepwww.ph.qmw.ac.uk/HEPpc/
http://www.w3.org
http://peipa.essex.ac.uk/tp-linux/
http://www.crosswinds.net/~tvquotes/futurama/2.html
www.google.com bad_link
b.a.d l.i.n.k . .. ... ....
mailto:jamie@slashdot.org mailto:pater@slashdot.org
mailto:cliff@slashdot.org mailto:pudge@slashdot.org
http://www.google.com/search?q=cache:h58W7o4qU-w:www.space.com/sciencefiction/tv/futurama_gore_000516_wg.html+Futurama+Fry&amp;hl=en
http://dmoz.org/Regional/Europe/United_Kingdom/Wales/Isle_of_Anglesey/Llanfairpwllgwyngyllgogerychwyrndrobwllllantysiliogogogoch/
);
push @links, 'http://directory.google.com/Top/Arts/Literature/Authors/C/Carroll,_Lewis/Works/Hunting_of_the_Snark,_The/';
my $comment;
my $cur_werds = 0;
my $tag = "";
my $quote = q{};
while ($cur_werds < $werds) {
my $new_werds = '';
if (int(rand(6))==0 or $werds < $cur_werds * 1.1) {
if (int(rand(2))) {
$new_werds = $werder->question;
} else {
$new_werds = $werder->exclaimation; # Dave, you spelled this word wrong
}
} else {
$new_werds = $werder->sentence;
}
if ($link_prob && rand(1) < $link_prob) {
my @new_werds = split / /, $new_werds;
if ($#new_werds > 2) {
my $a_href = q{<a href="} . $links[rand @links] . q{">} . (rand(1)<0.1?" ":"");
my $close_a = (rand(1)<0.1?" ":"") . "</a>";
my $insert_start = int(rand($#new_werds-2));
my $insert_end = $insert_start + int(rand(4))+1;
$insert_end = $#new_werds - 1 if $insert_end > $#new_werds - 1;
$new_werds = join(" ",
@new_werds[0..$insert_start-1],
$a_href . $new_werds[$insert_start],
@new_werds[$insert_start+1..$insert_end-1],
$new_werds[$insert_end] . $close_a,
@new_werds[$insert_end+1..$#new_werds]
);
}
}
if ($cur_werds and !$tag and rand > $cur_werds/$werds+0.3) {
if (rand(1) < 0.95) { $tag = "i" }
else { $tag = "b" }
if (rand(1) < 0.50) { $quote = int(rand(3)) ? q{'} : q{"} };
$new_werds = "<$tag>$quote$new_werds";
}
if ($tag and rand(1) < 0.5) {
$new_werds = "$new_werds$quote</$tag>";
$tag = ""; $quote = q{};
}
$comment .= " $new_werds";
$comment =~ s{\s+}{ }g;
$cur_werds = $comment =~ tr/ / /;
}
$comment .= "</$tag>" if $tag;
$comment =~ s{</(\w+)>\s+<\1>}{ }g;
$comment =~ s/^\s*(.+)\s*$/$1/;
$comment =~ s/^\s+//; $comment =~ s/\s+$//;
$comment;
}
sub typical_remark {
my @t = (
"What do you think?",
"This totally sucks.",
"That's too bad.",
"This sucks. Hope they change their mind.",
"<b>Sweet!</b>",
"Ahahahaha!",
"What a relief.",
"This is just dumb.",
"This is so lame.",
"Some people just don't get it.",
"Why don't they just go open-source?",
"That's free as in beer.",
"That's free as in speech.",
"Dude, just apt-get.",
"I wouldn't know, I use Debian.",
"Someone make a .deb of this.",
);
return " " . $t[rand @t];
}
sub usage {
print "*** $_[0]\n" if $_[0];
# Remember to doublecheck these match getopts()!
print <<EOT;
Usage: $PROGNAME [OPTIONS] [#submissions]
This utility creates test submissions 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 submission system.
Main options:
-h Help (this message)
-v Version
-u Virtual user (default is "slash")
Submission options:
-U User ID to submit as. Default is a random UID.
-S Section to submit to. Program will NOT check for input
validity!
-W Weight range, specify as "[lownum],[highnum]". If "lownum" is
omitted, then 0 is used. If "highnum" is ommitted then 99
is used. Therefore, if this option is not specified, a
random weight from 0 to 99 (floating point) will be chosen.
At least one number and the comma MUST be present.
Debugging options:
-D Dump submission data before insert.
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__
Something went wrong with that request. Please try again.