#!/usr/bin/perl

use strict;

# This is bsgen - bullshit generator for your corporate-wide messages.
# Script by Karel Kubat <karel@kubat.nl>. The original data file was
# sent to me by EvR / [BOFH]Basilisk, who also greatly enhanced the data
# to produce even more bs.
# 
# Version info
# 1.00 - first version
# 1.01 - Used alternatives are not selected a second time.

my $DEBUG = 0;			# set to 1 for more verbosity
my $DATAFILE = 'bsgen.data';	# data to read
my $WIDTH = 77;			# formatting width
my $col = 0;			# actual output column

# Main starts here. Load the data file, and generate from tag 'start'.
# Then print all chached output.
load_data ($DATAFILE);
generate_tag ('start', undef);
print_output();

# Load a datafile
my %data;
my %lastdata;
sub load_data ($) {
    my $f = shift;

    # Open the file, process line by line.
    msg ("Reading data file: '$f'\n");
    open (my $if, $f) or die ("Cannot read $f: $!\n");
    my $lineno = 0;
    while (my $line = <$if>) {
	$lineno++;

	# Ignore comment lines and empty lines
	next if ($line =~ /^\#/) or ($line =~ /^\s*$/);
	
	# Lines must consist of TAG;TEXT[\n]
	chomp ($line);
	my ($tag, $txt) = split (/;/, $line, 2);
	die ("Malformed line $lineno '$line'\n")
	  if ($tag eq '' or $txt eq '');

	# Enter into hold.
	my @opts;
	@opts = @{ $data{$tag} } if ($data{$tag});
	push (@opts, $txt);
	$data{$tag} = \@opts;
    }
}

# Generate the text given a tag
sub generate_tag ($$) {
    my ($tag, $reuse) = @_;
    my $line;

    if ($reuse) {
	# We're reusing a previously randomized tag. 
	msg ("Reusing text for tag: '$tag'\n");

	$line = $lastdata{$tag} or generate_tag ($tag, undef);
    } else {
	# Request to randomize a tag.
	msg ("Generating text for tag: '$tag'\n");

	# Tag must be in the data.
	die ("Request to generate for unknown or depleted tag '$tag'\n")
	  unless ($data{$tag});
	my @opts = @{ $data{$tag} };

	# Pick one of the alternatives. Remove the alternative from the list,
	# and put back the list.
	my $index = int(rand($#opts + 1));
	$line = $opts[$index];
	my @newopts;
	for my $i (0..$#opts) {
	    push (@newopts, $opts[$i]) if ($i != $index);
	}
	if ($#newopts >= 0) {
	    $data{$tag} = \@newopts;
	} else {
	    $data{$tag} = undef;
	}

	# Remember the last usage of this tag, incase of @tag later on
	$lastdata{$tag} = $line;
    }
    
    # Generate that line
    generate_line ($line);
}

# Generate one line. Expand enclosed tags.
sub generate_line ($) {
    my $line = shift;

    msg ("Generating text for line: '$line'\n");
    # Eat up the line char by char.
    while (length($line)) {
	my $ch = substr ($line, 0, 1);
	$line = substr ($line, 1);

	# If the char is a $ then we expect a new tag for the randomizer.
	# If the char is a @ then we expect a tag for reuse.
	# Else output it.
	if ($ch eq '$') {
	    my $tag = $line;
	    $tag =~ s/[^a-z].*//;
	    $line =~ s/^$tag//;
	    msg ("Embedded tag '\$$tag', remainder '$line'\n");
	    generate_tag ($tag, undef);
	} elsif ($ch eq '@') {
	    my $tag = $line;
	    $tag =~ s/[^a-z].*//;
	    $line =~ s/^$tag//;
	    msg ("Embedded tag '\@$tag', remainder '$line'\n");
	    generate_tag ($tag, 1);
	} else {
	    store_output ($ch);
	}
    }
}

# Store a character (or string) for later output.
my $output = '';
sub store_output ($) {
    my $s = shift;
    $output .= $s;
}

sub print_output() {
    msg ("Printing output now.\n",
	 "Hold so far: '$output'\n");

    # $output is now one big string. Split up into words and reformat.
    while (length($output)) {
	# If we're at a space, print it. Else we must be at a word, print that.
	if ($output =~ /^\s/) {
	    print_space (substr($output, 0, 1));
	    $output = substr($output, 1);
	} else {
	    my $part = $output;
	    $part =~ s/\s.*//;
	    $output =~ s/^[^\s]+//;
	    print_part ($part);
	}
    }
}

# Print a space
sub print_space ($) {
    my $sp = shift;
    
    # Avoid spaces at start of the line. Otherwise print.
    return if ($col == 0);
    print ($sp);
    if (++$col >= $WIDTH) {
	$col = 0;
	print ("\n");
    }
}

# Print a text part.
sub print_part ($) {
    my $str = shift;

    # The word may have \ in it to indicate newlines.
    my @parts = split (/\\/, $str, -1);
    
    for my $i (0..$#parts) {
	my $part = $parts[$i];
	if ($col + length($part) >= $WIDTH) {
	    print ("\n$part");
	    $col = length($part);
	} else {
	    print ($part);
	    $col += length($part);
	}
	# More parts to follow? Must be because there was a \.
	if ($i < $#parts) {
	    print ("\n");
	    $col = 0;
	}
    }
}

# Verbose messaging (for development debugging)
sub msg {
    print STDERR (@_) if ($DEBUG);
}