#!/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 );

(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_users} = $ARGV[0] || 10;
usage('Invalid number of users') 
	if $opts{num_users} !~ /^\d+$/ || $opts{num_users} < 0;

createEnvironment($opts{u});
setCurrentSkin(determineCurrentSkin());
$slashdb = getCurrentDB();
$constants = getCurrentStatic();
$werder = new Silly::Werder;

# main program logic (in braces to offset nicely)
{
	my $kmin = $constants->{minkarma} || -25;
	my $kmax = $constants->{maxkarma};
	my $zoo = getObject('Slash::Zoo');

	for (1..$opts{num_users}) {
		$werder->set_syllables_num(2, 4);
		$werder->set_werds_num(1, 3);
		my $username = $werder->sentence;
		$username =~ s{\W+$}{};
		$username =~ s{\b(\w)}{\U$1}g if rand(1) < 0.5;
		$username =~ s{\b(\w)}{\L$1}g if rand(1) < 0.2;

		# Insert more junk chars into username.
		my $junk_nc = $constants->{nick_chars};
		$junk_nc =~ tr/a-zA-Z//d;
		my $jnc_l = length($junk_nc);
		while ($junk_nc && rand(1) < 0.4
			&& length($username) < $constants->{nick_maxlen}) {
			my $l = length($username);
			my $loc = int(rand($l)+1);
			my $ch = substr($junk_nc, int(rand($jnc_l)), 1);
			$username = substr($username, 0, $loc)
				. $ch
				. substr($username, $loc);
		}

		$username = nickFix($username);
		my $matchname = nick2matchname($username);

		$werder->set_syllables_num(1, 2);
		$werder->set_werds_num(3, 5);
		my $email = $werder->sentence;
		$email =~ s{\W+$}{};
		$email =~ s{\s+}{\@};
		$email =~ s{\s+}{.}g;
		my $uid = $slashdb->createUser($matchname, $email, $username);
		next unless $uid;

		my $karma = int(rand(1+$kmax-$kmin)+$kmin);
		my $hr = { karma => $karma };
		my $emaildisplay = int(rand(3));
		$hr->{emaildisplay} = $emaildisplay if $emaildisplay != 0 or rand(1) < 0.3;
		if ($emaildisplay == 0) {
			$hr->{fakeemail} = '';
		} elsif ($emaildisplay == 1) {
			$hr->{fakeemail} = getArmoredEmail($uid);
		} else {
			$hr->{fakeemail} = $email;
		}
		$werder->set_syllables_num(1, 3);
		$werder->set_werds_num(2, 6);
		my $sig = "";
		$sig = make_werds(5+int(rand(20)), 0.2) if int(rand(2));
		$sig = strip_html(substr($sig, 0, 120));
		$sig = balanceTags($sig, { deep_nesting => 1 });
		$sig = addDomainTags($sig);
		if (length($sig) <= 160) {
			$hr->{sig} = $sig;
		}
		my $domaintags = rand(1) < 0.5 ? 2 : int(rand(3));
		$hr->{domaintags} = $domaintags if $domaintags != 2;
		$slashdb->setUser($uid, $hr);

		if ($zoo && $opts{'a'}) {
			print "Setting $opts{'a'}\n";
			if ((rand() * 10)%2) {
				$zoo->setFriend($opts{'a'}, $uid);
			} else {
				$zoo->setFoe($opts{'a'}, $uid);
			}
		}

		print "New user: $username (User #$uid) ($email)";
		if ($zoo && rand(1) < 0.3) {
			my $uids = $slashdb->sqlSelectColArrayref('uid', 'users');
			my $ac_uid = getCurrentAnonymousCoward('uid');
			$uids = [ grep { $_ != $ac_uid } @$uids ];
			my $zooness = rand(2)*rand(2);
			my %friends = ( );
			my %foes = ( );
			my $num = int($zooness*rand(4)*rand(8));
			for (1..$num) {
				my $new_uid = $uids->[rand @$uids];
				$friends{$new_uid} = 1;
			}
			$num = int($zooness*rand(3)*rand(5));
			for (1..$num) {
				my $new_uid = $uids->[rand @$uids];
				$foes{$new_uid} = 1 unless $friends{$new_uid};
			}
			for my $new_uid (keys %friends) {
				$zoo->setFriend($uid, $new_uid);
			}
			for my $new_uid (keys %foes) {
				$zoo->setFoe($uid, $new_uid);
			}
			print " " . scalar(keys %friends) . " friends,";
			print " " . scalar(keys %foes) . " foes";
		}
		print "\n";
	}
}

# subroutines

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 $min_syl = int(rand(3)+1);
	$werder->set_syllables_num($min_syl, $min_syl + int(rand(4)+1));
	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
		http://www.google.com/search?q=cache:h58W7o4qU-w:www.space.com/sciencefiction/tv/futurama_gore_000516_wg.html+Futurama+Fry&hl=en
		http://dmoz.org/Regional/Europe/United_Kingdom/Wales/Isle_of_Anglesey/Llanfairpwllgwyngyllgogerychwyrndrobwllllantysiliogogogoch/
		www.google.com                  bad_link b.a.d l.i.n.k . .. ... ....
		mailto:jamie@slashdot.org       mailto:pater@slashdot.org
	);
	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{};
	my $last_p_werd_num = 0;
        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 > 0.9) {
			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/ / /;
		if (rand($werds) > 30
			and rand($cur_werds - $last_p_werd_num) > 20) {
			$comment .= "<P>";
			$last_p_werd_num = $cur_werds;
		}
        }
        $comment .= "</$tag>" if $tag;
        $comment =~ s{</(\w+)>\s+<\1>}{ }g;
        $comment =~ s/^\s*(.+)\s*$/$1/;
        $comment =~ s/^\s+//; $comment =~ s/\s+$//;
	if ($link_prob and $junk) {
		my @fragments = (
			"<a", "href=", 'href="', '"', "'", ">", '>">', " > >",
			"<", " < ", " <<", ">>", " < < <", "< < ", "<? ", "&lt;<",
			".", "..", "../", "/..", "/../../..", " ", "  ", " \r ",
			" \n ", "\n ", "\n\n", "\r\n\r", "\n\r\n", "\t \t", "\t",
			"<i>", "</ i >", "<i >", "< /i >", "< i>", "< / i>",
			"<i", "</i", "i>", "/i>", "/i/", "i/i", " // ", " / ",
			"%2e", "%2f", "%3c", "%3e", "&lt;", "&gt;", "&amp;", "&",
			"&amp", "&amp ", "&&", "&gt ;", "&#000;", "&#127;", "&#amp;",
			"&#120;", "&#040;", "&#x30;", "&12345;", "&#2345;", "&999 ",
			"&lt;<%3c", "&gt;>%3e", "%3e&lt; ", "><", "<>", "<><>",
			"%25%", "%25", "&#046;", "&#26;", "& &", "<&> <", ">&<",
			'<a hReF="/', '<A href = "//', '<A HREF=http://',
			'<a href=""http://', '<a HREF="news:', '<a href="ftp:',
			"<a\thref=\"/", '<a href="///', "<a\rhref=\"http:",
			"<A\nHREF=\"http:", "<A\nHREF=http:", "<A\nHREF=\"http",
			'<a href="ftp://ab:xz@', '<a href="ww~w\@foo.com/',
			'<a href="@bar.com/', '<a href="http://@bar.com/',
			'<a href="news:a:b@', '<a href="news:a:b:c:d@foo.com',
			'<a href="ftp://aaa@foo.com', '<a href="http://bbb@bar',
			'<a href="http://ab:xz@', '<a href="http://www@',
			'<a href="ftp://www@www/', '<a href="news:new@new/',
			'<a href="http://@', '<a href="http://:bar@', '%5c',
			'<a href=http://foo:bar@', '<a href=http://@', '%7f',
			'<a href="http://foo.com%20%20%20%20%20%20%20@',
			"<A\nhref=\"HTTP://", "<!-- script ", "<script ",
			'< a href="', '" <script="', "<script>", "<script",
			"script>", "/script>", "href=", ' href="', ' HREF="',
			'<img src="', "<img ", "</img>", "</hr>", "<!-- ",
			"<!- - ", "<!--", "<! ", "<!", "!>", "-->", " -->",
			"<a href=\"\r\n", "foo.com", "bar.com", "test.cx",
			"&#".int(rand(256)).";", "&#".int(rand(256)).";",
			"&#".int(rand(256)).";", "&#".int(rand(256)).";",
			"&#".int(rand(256)).";", "&#".int(rand(256)).";",
			"&#".int(rand(256)).";", "&#".int(rand(256)).";",
		);
		for (1..$werds) {
			my $offset = int(rand(length($comment))+1);
			my $done = 0;
			while (!$done) {
				my $fragment = $fragments[rand @fragments];
				substr($comment, $offset, 0) = $fragment;
				$done = 1 if rand(1) < 0.8;
			}
		}
	}
        $comment;
}

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__
