#!/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__
